unrep1.pas

主要介绍超市管理系统的后台系统,后台程序是系统初始化和系统维护最常使用的一部分程序,主要任务是建产基本数据,进出货盘点和打印报表.后台程序主要负责的都是管理上的功能,当后台建立完整的数据后,前台才能顺

            IF COPY(NAME,1,2) = 'QD' THEN
               BEGIN
               S := FMREP1.Components[N];
               WITH S AS TQRDBTEXT DO
               BEGIN
               NAME      := T.ReadString(NAME,'NAME'     ,Name);
               PARENT  := QRBand_TITLE;
               IF T.ReadString (NAME,'PARENT' ,PARENT.Name) = 'QRBand_DETAIL' THEN PARENT  := QRBand_DETAIL;
               DATAFIELD := T.ReadString(NAME,'DATAFIELD',DATAFIELD);

               FONT.Size  := T.ReadInteger(NAME,'FONTSIZE'   ,FONT.SIZE);

               LEFT   := T.ReadInteger(NAME,'LEFT'   ,LEFT);
               TOP    := T.ReadInteger(NAME,'TOP'    ,TOP);
               HEIGHT := T.ReadInteger(NAME,'HEIGHT' ,HEIGHT);
               WIDTH  := T.ReadInteger(NAME,'WIDTH'  ,WIDTH);
               END;
               END;
            //=======================================================
            // LABEL ================================================
            IF COPY(NAME,1,2) = 'SP' THEN
               BEGIN
               S := FMREP1.Components[N];
               WITH S AS TQRSHAPE DO
               BEGIN
               NAME  := T.ReadString(NAME,'NAME'   ,Name);
               PARENT  := QRBand_TITLE;
               IF T.ReadString (NAME,'PARENT' ,PARENT.Name) = 'QRBand_DETAIL' THEN PARENT  := QRBand_DETAIL;

               LEFT   := T.ReadInteger(NAME,'LEFT'   ,LEFT);
               TOP    := T.ReadInteger(NAME,'TOP'    ,TOP);
               HEIGHT := T.ReadInteger(NAME,'HEIGHT' ,HEIGHT);
               WIDTH  := T.ReadInteger(NAME,'WIDTH'  ,WIDTH);

//               T_STR  := T.ReadString(NAME,'SHAPE'  ,VARTOSTR(SHAPE));
               IF T_STR ='0' THEN SHAPE := qrsRectangle;
               IF T_STR ='1' THEN SHAPE := qrsCircle;
               IF T_STR ='2' THEN SHAPE := qrsVertLine;
               IF T_STR ='3' THEN SHAPE := qrsHorLine;
               IF T_STR ='4' THEN SHAPE := qrsTopAndBottom;
               IF T_STR ='5' THEN SHAPE := qrsRightAndLeft;
               END;
               END;
            //=======================================================
            END;

       END;



FINALLY
   T.Free;
END;


IS_CHANGED(FALSE);   //更改过
END;

PROCEDURE TFMREP1.FREE_ALL_LB;
VAR N : INTEGER;
    FREE_OK : BOOLEAN;
BEGIN
IS_CHANGED(TRUE);   //更改过

FREE_OK := FALSE;
WHILE FREE_OK = FALSE DO
   BEGIN

   FOR N := 0 TO FMREP1.ComponentCount-1 DO
       WITH FMREP1.Components[N] DO
            IF ((COPY(NAME,1,2) = 'LB') OR (COPY(NAME,1,2) = 'QD') )AND
            (FMREP1.FindComponent(NAME) <> NIL ) THEN
            BEGIN
            FREE;          //FREE 后, ComponentCount 会改变, 所以要重新来
            BREAK;
            END;

   //重新找, 是否还有LABEL对象
   FOR N := 0 TO FMREP1.ComponentCount-1 DO
      BEGIN
       WITH FMREP1.Components[N] DO
            IF ((COPY(NAME,1,2) = 'LB') OR (COPY(NAME,1,2) = 'QD') )AND
            (FMREP1.FindComponent(NAME) <> NIL ) THEN
            BEGIN
            FREE_OK := FALSE;
            BREAK;
            END ELSE
            BEGIN
            FREE_OK := TRUE;
            END;
      END;

   END;

END;






















procedure TFMREP1.VRITUAL_LBMouseDown(Sender: TObject;  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
IS_CHANGED(TRUE);   //更改过
   WITH SENDER AS TQRLBEDIT DO
      BEGIN
      ED_OBJ_NAME.TEXT     := NAME;
      ED_OBJ_CAPTION.TEXT  := CAPTION;
      ED_OBJ_FONTSIZE.Value:= FONT.Size;

      ED_OBJ_TOP.Value     := TOP;
      ED_OBJ_LEFT.Value    := LEFT;
      ED_OBJ_HEIGHT.Value  := HEIGHT;
      ED_OBJ_WIDTH.Value   := WIDTH;
      END;

//   FMLBDSL.PAGE_C.TabVisible := FALSE;
//   FMLBDSL.ShowModal;

end;

procedure TFMREP1.VRITUAL_QDMouseDown(Sender: TObject; Button: TMouseButton;  Shift: TShiftState; X, Y: Integer);
begin
IS_CHANGED(TRUE);   //更改过
   WITH SENDER AS TQRQDEDIT DO
      BEGIN
      ED_OBJ_NAME.TEXT     := NAME;
      ED_OBJ_FIELD.Text    := DATAFIELD;

      ED_OBJ_FONTSIZE.Value:= FONT.Size;
      

      ED_OBJ_TOP.Value     := TOP;
      ED_OBJ_LEFT.Value    := LEFT;
      ED_OBJ_HEIGHT.Value  := HEIGHT;
      ED_OBJ_WIDTH.Value   := WIDTH;
      END;
//   FMLBDSL.PAGE_C.TabVisible := FALSE;
//   FMLBDSL.ShowModal;
end;

procedure TFMREP1.VRITUAL_SPMouseDown(Sender: TObject; Button: TMouseButton;  Shift: TShiftState; X, Y: Integer);
begin
IS_CHANGED(TRUE);   //更改过
   WITH SENDER AS TQRSPEDIT DO
      BEGIN
      ED_OBJ_NAME.TEXT     := NAME;

      ED_OBJ_TOP.Value     := TOP;
      ED_OBJ_LEFT.Value    := LEFT;
      ED_OBJ_HEIGHT.Value  := HEIGHT;
      ED_OBJ_WIDTH.Value   := WIDTH;

//      ED_OBJ_SHAPE.ItemIndex := STRTOINTDEF(VARTOSTR(SHAPE),0);
      END;
//   FMLBDSL.PAGE_C.TabVisible := FALSE;
//   FMLBDSL.ShowModal;
end;



























//=  SYS  ===========================================================================
procedure TFMREP1.FormCreate(Sender: TObject);
BEGIN
//  LBTITLE.Caption     := ;
  XLB_USER_RBPST.Caption := _USER_CORP_RBPST ;
  XLB_USER_NAME .Caption := _USER_CORP_NAME  ;
  XLB_USER_NO   .Caption := _USER_CORP_NO    ;
  XLB_USER_TEL  .Caption := _USER_CORP_TEL   ;
  XLB_USER_FAX  .Caption := _USER_CORP_FAX   ;
  XLB_USER_ADDR .Caption := _USER_CORP_ADDR  ;

  XLB_DAT1.Caption := '日期：' + EDATE_TO_CDATE(DATETOSTR(DATE));





//取出 TALBLE
ED_PAGE_TABLE.Items.Clear;
Session.GetTableNames('MAIN', '', FALSE,false,ED_PAGE_TABLE.Items);







//IF Application.FindComponent('FMREP1L')=nil then Application.CreateForm(TFMREP1L,FMREP1L );

LB_CNT := 1;
QD_CNT := 1;
QR_NAME := ExtractFilePath(Application.EXEName)+'/ini/QREP1.ini';
QR_TABLE_LIST := 'BGDS';  // 列出的TABLE

IF FileExists(QR_NAME) = FALSE THEN FILE_CREATE(QR_NAME);

//取出 TALBLE
//FMREP1.D_ED7.Items.Clear;
//Session.GetTableNames('MAIN', '', FALSE,false,FMREP1.D_ED8.Items);

IS_CHANGED(FALSE);   //更改过


//P_EDH.VALUE := QRLB.Height / 80;
//P_EDW.VALUE := QRLB.WIDTH  / 80;
CB_COL  .ItemIndex := 0;
end;


procedure TFMREP1.FormShow(Sender: TObject);
begin


IF ED_PAGE_TABLE.TEXT <> '' THEN
   BEGIN
   ED_OBJ_FIELD.Items.Clear;
   IF ED_PAGE_TABLE.TEXT <>'' THEN ED_OBJ_FIELD.Items.TEXT := DB_QUERY_FIELDLIST(ED_PAGE_TABLE.TEXT);

   QUERY.SQL.CLEAR;
   QUERY.SQL.ADD('SELECT * FROM ' + ED_PAGE_TABLE.TEXT );
   QUERY.CLOSE;
   QUERY.OPEN;
   END ELSE BEGIN
   END;


PAGE_A.SHOW;
LOAD_INI;
end;


procedure TFMREP1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
IF QR_CHANGED = TRUE THEN //更改过
   Case MessageDlg('是否确定存储已更改的标签资料?',mtConfirmation,[mbYes,mbNo],0) of
        mrYES :SAVE_INI;end;

//FMREP1L.Release;
FMREP1.Release;
end;






















































procedure TFMREP1.BTNQUTClick(Sender: TObject);
begin
CLOSE;
end;

procedure TFMREP1.BTN_QRLBClick(Sender: TObject);
begin
CREATE_LB;
end;

procedure TFMREP1.BTN_QRQDClick(Sender: TObject);
begin
CREATE_QD;
end;

procedure TFMREP1.BTNCLRClick(Sender: TObject);
begin
FREE_ALL_LB;
end;

procedure TFMREP1.BTN_QRSPVClick(Sender: TObject);
begin
CREATE_SP('qrsVertLine');
end;
procedure TFMREP1.BTN_QRSPHClick(Sender: TObject);
begin
CREATE_SP('qrsHorLine');
end;
procedure TFMREP1.BTN_QRSPRClick(Sender: TObject);
begin
CREATE_SP('qrsRectangle');
end;

procedure TFMREP1.BTNSAVClick(Sender: TObject);
begin
IS_CHANGED(FALSE);   //更改过
SAVE_INI;

end;

procedure TFMREP1.DsnSwitch1Click(Sender: TObject);
begin
IS_CHANGED(TRUE);   //更改过
end;

procedure TFMREP1.BTNPRNClick(Sender: TObject);
begin
//QuickRep.Print;
QuickRep.Preview;
end;

procedure TFMREP1.ED_PAGE_TABLEChange(Sender: TObject);
begin
ED_OBJ_FIELD.Items.Clear;
IF ED_PAGE_TABLE.TEXT <>'' THEN ED_OBJ_FIELD.Items.TEXT := DB_QUERY_FIELDLIST(ED_PAGE_TABLE.TEXT);

end;



procedure TFMREP1.BTN_OBJ_APPLYClick(Sender: TObject);
VAR S : TOBJECT;  //暂存对象
    N , ID : INTEGER;
begin
   IF FMREP1.FindComponent('S') = NIL THEN S := TOBJECT.Create;

   FOR N := 0 TO FMREP1.ComponentCount-1 DO
       BEGIN
       WITH FMREP1.Components[N] DO
            BEGIN
            // LABEL ================================================
            IF (UPPERCASE(COPY(NAME,1,2)) = 'LB') AND
               (NAME = ED_OBJ_NAME.Text )         THEN
               BEGIN
               S := FMREP1.Components[N];
               WITH S AS TQRLBEDIT DO
                 BEGIN
                 CAPTION := ED_OBJ_CAPTION.Text  ;
                 FONT.Size := ED_OBJ_FONTSIZE.Value;

                 TOP     := STRTOINTDEF(ED_OBJ_TOP    .TEXT, 1) ;
                 LEFT    := STRTOINTDEF(ED_OBJ_LEFT   .TEXT, 1) ;
                 HEIGHT  := STRTOINTDEF(ED_OBJ_HEIGHT .TEXT, 1) ;
                 WIDTH   := STRTOINTDEF(ED_OBJ_WIDTH  .TEXT, 1) ;

                 Refresh;
                 END;
               END;
            // ======================================================

            // LABEL ================================================
            IF (UPPERCASE(COPY(NAME,1,2)) = 'QD') AND
               (NAME = ED_OBJ_NAME.Text )         THEN
               BEGIN
               S := FMREP1.Components[N];
               WITH S AS TQRQDEDIT DO
                 BEGIN
                 FONT.Size := ED_OBJ_FONTSIZE.Value;

                 TOP     := STRTOINTDEF(ED_OBJ_TOP    .TEXT, 1) ;
                 LEFT    := STRTOINTDEF(ED_OBJ_LEFT   .TEXT, 1) ;
                 HEIGHT  := STRTOINTDEF(ED_OBJ_HEIGHT .TEXT, 1) ;
                 WIDTH   := STRTOINTDEF(ED_OBJ_WIDTH  .TEXT, 1) ;

                 DATAFIELD  := ED_OBJ_FIELD.TEXT ;
                 Refresh;
                 END;
               END;
            // ======================================================

            // LABEL ================================================
            IF (UPPERCASE(COPY(NAME,1,2)) = 'SP') AND
               (NAME = ED_OBJ_NAME.Text )         THEN
               BEGIN
               S := FMREP1.Components[N];
               WITH S AS TQRSPEDIT DO
                 BEGIN
                 TOP     := STRTOINTDEF(ED_OBJ_TOP    .TEXT, 1) ;
                 LEFT    := STRTOINTDEF(ED_OBJ_LEFT   .TEXT, 1) ;
                 HEIGHT  := STRTOINTDEF(ED_OBJ_HEIGHT .TEXT, 1) ;
                 WIDTH   := STRTOINTDEF(ED_OBJ_WIDTH  .TEXT, 1) ;

                 Refresh;
                 END;
               END;
            // ======================================================






            END;
       END;
end;



















procedure TFMREP1.BTN_PAGE_APPLYClick(Sender: TObject);
begin
QuickRep.Page.Width        := ED_PAGE_WIDTH.Value;
QuickRep.Page.Length       := ED_PAGE_LENGTH.Value;
QuickRep.Page.TopMargin    := ED_PAGE_TOPMARGIN.Value;
QuickRep.Page.BottomMargin := ED_PAGE_BOTTOMMARGIN.Value;
QuickRep.Page.LeftMargin   := ED_PAGE_LEFTMARGIN.Value;
QuickRep.Page.RightMargin  := ED_PAGE_RIGHTMARGIN.Value;

XLB_TITLE.Caption := ED_PAGE_TITLE.Text;

end;

procedure TFMREP1.ED_OBJ_NAMEChange(Sender: TObject);
begin
IS_CHANGED(TRUE);   //更改过
end;

end.