unitstandard1.pas

是分布式粮库程序,是采用Delphi实现的

begin
  OutRect.Left := 0;
  OutRect.Top := AmountPrinted;
  OutRect.Bottom := OutRect.top + LineHeight;
  with Printer.Canvas do
    for i := 0 to Items.Count-1 do
    begin
      Inches := longint(Items.Objects[i])*0.01;
      OutRect.Right := OutRect.Left + round(PixelsInInchX*Inches);
      if not Printer.Aborted then
         TextRect(OutRect, OutRect.left, OutRect.Top, Items[i]);
      OutRect.Left := OutRect.Right;
    end;
  AmountPrinted := AmountPrinted + LineHeight; //TenthsOfInchPixelsY*2;
end;

procedure TFrmStandard1.PrintColumnNames;
var
  ColNames: TStringList;
  i: integer;
begin
  ColNames := TStringList.Create;
  Try
    Printer.Canvas.Font.Style := [fsBold, fsUnderline];
    for i := 0 to DBGrid1.Columns.Count-1 do
      ColNames.AddObject(DBgrid1.Columns[i].Title.Caption, pointer(DBGrid1.Columns[i].Width));
    PrintLine(ColNames);
    Printer.Canvas.Font.Style := [];
  finally
    ColNames.Free;
  end;
end;


procedure TFrmStandard1.BBtnClmnFntClick(Sender: TObject);
begin
  inherited;
  FontDialog.Font.Assign(EdtClmn.Font);
  if FontDialog.Execute then
    EdtClmn.Font.Assign(FontDialog.Font);
    
end;

procedure TFrmStandard1.BtnTitleFntClick(Sender: TObject);
begin
  inherited;
  if EdtTitle.Text<>'' then
  begin
    FontDialog.Font.Assign(EdtTitle.Font);
    if FontDialog.Execute then
      EdtTitle.Font.Assign(FontDialog.Font);
  end;
end;

procedure TFrmStandard1.BtnPgHdrFntClick(Sender: TObject);
begin
  inherited;
  if EdtPgHdr.Text<>'' then
    begin
    FontDialog.Font.Assign(EdtPgHdr.Font);
    if FontDialog.Execute then
      EdtPgHdr.Font.Assign(FontDialog.Font);
    end;
end;

procedure TFrmStandard1.BBtnFldDtFntClick(Sender: TObject);
begin
  inherited;
  FontDialog.Font.Assign(EdtFldDt.Font);
    if FontDialog.Execute then
      EdtFldDt.Font.Assign(FontDialog.Font);

end;

procedure TFrmStandard1.BBtnPgFtFntClick(Sender: TObject);
begin
  inherited;
  FontDialog.Font.Assign(EdtPgFt.Font);
    if FontDialog.Execute then
      EdtPgFt.Font.Assign(FontDialog.Font);
end;

procedure TFrmStandard1.BBtnSumClick(Sender: TObject);
begin
  inherited;
  FontDialog.Font.Assign(EdtSum.Font);
    if FontDialog.Execute then
      EdtSum.Font.Assign(FontDialog.Font);
end;

procedure TFrmStandard1.FormShow(Sender: TObject);
begin
  inherited;
  EdtTable.Visible:=false;
end;

procedure TFrmStandard1.BitBtnNewClick(Sender: TObject);
begin
  inherited;
  with DBGrid1.DataSource.DataSet do
  begin
    if Modified then
    begin
      ShowMessage('先保存改动后增加。');
      exit;
    end
    else
    begin
      DBGrid1.DataSource.DataSet.Edit ;
      DBGrid1.DataSource.DataSet.Append ;
      DBEditKey.Enabled:=true;
      LblKey.Enabled:=true;
      DBEditKey.SetFocus;
    end;
  end;
end;

procedure TFrmStandard1.BitBtnRefreshClick(Sender: TObject);
begin
  inherited;
  with DBGrid1.DataSource.DataSet do
  begin
    Active := false;
    Active := true;
    DBEditKey.Enabled:=false;
    //LblKey.Enabled:=false;
  end;
end;

procedure TFrmStandard1.BitBtnDeleteClick(Sender: TObject);
begin
  inherited;
  //if messagedlg('是否要删除？',mtcustom,[mbyes,mbno],0)=mryes then
  if Application.MessageBox('是否要删除？','程序执行确认',MB_YesNo+MB_IconQuestion+MB_ApplModal)=IdYes then
    begin
      DBGrid1.DataSource.DataSet.delete;
      if DtMdl.Database1 .InTransaction then
        DtMdl.Database1.Rollback ;
      DtMdl.Database1.StartTransaction;
      try
        QrySQL.ApplyUpdates;
        DtMdl.Database1.Commit;
      except
        DtMdl.Database1.Rollback;
      raise;
        ShowMessage('数据提交失败，请仔细检查后重试！');
      end;
      QrySQL.CommitUpdates; {on success, clear the cache};
    end;
end;

procedure TFrmStandard1.BitBtnSaveClick(Sender: TObject);
begin
  inherited;
  if DtMdl.Database1 .InTransaction then
    DtMdl.Database1.Rollback ;
  DtMdl.Database1.StartTransaction;
  try
    QrySQL.ApplyUpdates;
    DtMdl.Database1.Commit;
    DBEditKey.Enabled:=false;
    //LblKey.Enabled:=false;
  except
    DtMdl.Database1.Rollback;
  raise;
    ShowMessage('数据提交失败，请仔细检查后重试！');
  end;
  QrySQL.CommitUpdates; {on success, clear the cache}
end;

procedure TFrmStandard1.BitBtnCancelClick(Sender: TObject);
begin
  inherited;
  if (DBGrid1.DataSource.DataSet Is TQuery) then
    (DBGrid1.DataSource.DataSet As TQuery).CancelUpdates;
  DBEditKey.Enabled:=false;
  //LblKey.Enabled:=false;
end;

procedure TFrmStandard1.BitBtnPrintClick(Sender: TObject);
var
  Items: TStringList;
  i: integer;
begin
  inherited;
  Items := TStringList.Create;
  Try
    PixelsInInchX := GetDeviceCaps(Printer.Handle,LOGPIXELSX);
    TenthsOfInchPixelsY := GetDeviceCaps(Printer.Handle,LOGPIXELSY) div 10;
    AmountPrinted := 0;
    //FrmStandard1.Enabled := false;
    try
      Printer.BeginDoc;
      FrmPrinting:=TFrmPrinting.Create(application);
      FrmPrinting.show;
      Application.ProcessMessages;
      LineHeight := round(Printer.Canvas.TextHeight('X'))+TenthsOfInchPixelsY;
      //if EdtHeaderFont.text<>'' then
        //PrintHeader;
      printColumnNames;
      QrySQL.First;
      while (not QrySQL.Eof) or Printer.Aborted do
      begin
        Application.ProcessMessages;
        for i:=0 to DBGrid1.Columns.Count-1 do
          begin
          if QrySQL.fieldByName(DBGrid1.Columns[i].FieldName).DataType = ftString then
            begin
            Items.AddObject(QrySQL.fieldByName(DBGrid1.Columns[i].FieldName).AsString, pointer(DBGrid1.Columns[i].Width));
            Continue;
            end;
          if QrySQL.fieldByName(DBGrid1.Columns[i].FieldName).DataType = ftInteger then
            begin
            Items.AddObject(IntToStr(QrySQL.fieldByName(DBGrid1.Columns[i].FieldName).AsInteger), pointer(DBGrid1.Columns[i].Width));
            Continue;
            end;
          if QrySQL.fieldByName(DBGrid1.Columns[i].FieldName).DataType = ftFloat then
            Items.AddObject(FloatToStr(QrySQL.fieldByName(DBGrid1.Columns[i].FieldName).AsFloat), pointer(DBGrid1.Columns[i].Width))
          else
            Items.AddObject('', pointer(DBGrid1.Columns[i].Width));
          end;
        printLine(Items);
        if AmountPrinted + LineHeight > Printer.PageHeight then
        begin
          AmountPrinted := 0;
          if not Printer.Aborted then
            Printer.NewPage;
          //PrintHeader;
          PrintColumnNames;
        end;
        Items.Clear;
        QrySQL.Next;
      end;
      FrmPrinting.Hide;
      FrmPrinting.Free;
      if not printer.Aborted then
        printer.EndDoc;
    finally
      //FrmStandard1.Enabled := true;
    end;
  finally
    Items.Free;
  end;
end;

procedure TFrmStandard1.BitBtnPreviewClick(Sender: TObject);
var
  i,lft: integer;
begin
  inherited;
  CrntFldInf := TStringList.Create;
  CrntFieldNames := TStringList.Create;
  CrntFieldCount := DBGrid1.Columns.Count;
  {if CrntFieldCount>16 then
    begin
      showMessage('要打印的字段不能超出16个，请重新选择要打印的字段！');
      exit;
    end;}

  for i:=0 to CrntFieldCount-1 do
    begin
    CrntFldInf.AddObject(DBGrid1.Columns[i].Title.Caption, pointer(DBGrid1.Columns[i].Width));
    CrntFieldNames.Add(DBGrid1.Columns[i].FieldName);
    end;

  FrmRprtTable:=TFrmRprtTable.Create(application);
  try
    FrmRprtTable.PageHeaderBand1.Font.Assign(EdtPgHdr.Font);
    FrmRprtTable.TitleBand1.Font.Assign(EdtTitle.Font);
    FrmRprtTable.ColumnHeaderBand1.Font.Assign(EdtClmn.Font);
    FrmRprtTable.DetailBand1.Font.Assign(EdtFldDt.Font);
    FrmRprtTable.SummaryBand1.Font.Assign(EdtSum.Font);
    FrmRprtTable.PageFooterBand1.Font.Assign(EdtPgFt.Font);
    FrmRprtTable.PageHeaderBand1.Size.Height := StrToInt(EdtPgHdrHgt.Text);
    FrmRprtTable.TitleBand1.Size.Height := StrToInt(EdtTitleHgt.Text);
    FrmRprtTable.ColumnHeaderBand1.Size.Height := StrToInt(EdtClmnHgt.Text);
    FrmRprtTable.DetailBand1.Size.Height := StrToInt(EdtFldDtHgt.Text);
    FrmRprtTable.SummaryBand1.Size.Height := StrToInt(EdtSumHgt.Text);
    FrmRprtTable.PageFooterBand1.Size.Height := StrToInt(EdtPgFtHgt.Text);
    lft:=16;
    FrmRprtTable.QRLblPgHdr.Caption:=EdtPgHdr.Text;
    FrmRprtTable.QRLblTitle.Caption:=EdtTitle.Text;
    FrmRprtTable.QRLblTitle.Left := (FrmRprtTable.TitleBand1.Width - FrmRprtTable.QRLblTitle.Width) div 2;
    FrmRprtTable.QRLblTitle.Top := (FrmRprtTable.TitleBand1.Height+FrmRprtTable.QRLblTitle.Font.Height) div 2;
    with FrmRprtTable do
    for i:=0 to CrntFieldCount-1 do
      begin
      QRLblList[i] := TQRLabel.Create(ColumnHeaderBand1);
      QRLblList[i].Parent := ColumnHeaderBand1;
      QRlblList[i].Caption := CrntFldInf.Strings[i];
      QRlblList[i].Visible := true;
      QRLblList[i].Left := lft;
      QRLblList[i].Top := (ColumnHeaderBand1.Height+ColumnHeaderBand1.Font.Height) div 2;
      QRDBTextList[i] := TQRDBText.Create(DetailBand1);
      QRDBTextList[i].Parent := DetailBand1;
      QRDBTextList[i].DataSet := QryRprtTbl;
      QRDBTextList[i].DataField := CrntFieldNames.Strings[i];
      QRDBTextList[i].Visible := true;
      QRDBTextList[i].Left:=lft;
      QRDBTextList[i].Top := (DetailBand1.Font.Height+DetailBand1.Height) div 2;
      lft:=lft+longint(CrntFldInf.Objects[i]);
      end;
    FrmRprtTable.Show;
    FrmRprtTable.QuickRep1.Preview;
    //FrmRprtTable.QuickRep1.QRPrinter.Free; //这句是否可不要，
    //FrmRprtTable.QuickRep1.QRPrinter := nil; //这句是否可不要，
  finally
    for i:=0 to CrntFieldCount-1 do
      begin
      FrmRprtTable.QRDBTextList[i].free;
      FrmRprtTable.QRLblList[i].free;
      end;
    FrmRprtTable.free;
    CrntFldInf.Free;
    CrntFieldNames.Free;
  end
end;

procedure TFrmStandard1.BitBtnOKClick(Sender: TObject);
var
  SQLSlt,SQLWhr,SQLOrd,SQL1,SQL2,SQL3 : string;
  //i: integer;
  sFld1, sFld2, sFld3 : string;
  sOpr1, sOpr2, sOpr3 : string;
  sVal1, sVal2, sVal3 : string;
  sLog1, sLog2 : string;
  sOrdFld1,sOrdFld2,sOrdFld3: string;
begin
  inherited;

  SQLSlt := 'select * from '+ Trim(EdtTable.Text);
  { where 子句程序 }
  SQLWhr := '';
  SQLOrd := '';
  if CboxField1.Itemindex=-1 then
    sFld1:=''
  else
    sFld1 := Dbgrid1.Columns[CboxField1.Itemindex].FieldName;
  if CboxField2.Itemindex=-1 then
    sFld2:=''
  else
    sFld2 := Dbgrid1.Columns[CboxField2.Itemindex].FieldName;
  if CboxField3.Itemindex=-1 then
    sFld3:=''
  else
    sFld3 := Dbgrid1.Columns[CboxField3.Itemindex].FieldName;
  sOpr1 := CboxOperator1.Items[CboxOperator1.ItemIndex];
  sOpr2 := CboxOperator2.Items[CboxOperator2.ItemIndex];
  sOpr3 := CboxOperator3.Items[CboxOperator3.ItemIndex];
  sVal1 := EdtFieldValue1.Text;
  sVal2 := EdtFieldValue2.Text;
  sVal3 := EdtFieldValue3.Text;
  sLog1 := CboxLogic1.Items[CboxLogic1.ItemIndex];
  sLog2 := CboxLogic2.Items[CboxLogic2.ItemIndex];

  //一下取得SQLWhr
  if ( sFld1 <> '' ) and ( sOpr1 <> '' ) then
  begin
    case DBGrid1.DataSource.DataSet.FieldByName(sFld1).DataType of
      ftString: begin
                  if sOpr1='like' then sVal1:='%'+sVal1+'%';
                  SQL1:=format(' where %s %s ''%s''',[ sFld1, sOpr1, sVal1]);
                end;
      ftInteger: begin
                   try
                     StrToInt(sVal1);
                   except
                     showmessage('第一个字段（列）值为无效的整型，请重新输入！');
                     exit;
                   end;
                   SQL1:=format(' Where %s %s %d', [ sFld1, sOpr1, StrToInt(sVal1)]);
                 end;

      ftFloat:   begin
                   try
                     StrToFloat(sVal1);
                   except
                     showmessage('第一个字段（列）值为无效的浮点数值类型，请重新输入！');
                     exit;
                   end;
                   SQL1:=format(' Where %s %s %f', [ sFld1, sOpr1, StrToFloat(sVal1)]);
                 end;
      ftDateTime:begin
                   try
                     StrToDate(sVal1);
                   except
                     showmessage('第一个字段（列）值为无效的日期类型，有效的日期类型为：YY-MM-DD！请重新输入！');
                     exit;
                   end;
                   SQL1:=format(' Where %s %s ''%s''', [ sFld1, sOpr1, sVal1]);
                 end;
    else
      begin
        showmessage('要查询的字段:'+sFld1+'的类型还未定义！');
        exit;
      end;
    end;
    SQLWhr := SQLWhr + SQL1;
  end;
  if ( sLog1 <> '' ) and ( sFld2 <> '' ) and ( sOpr2 <> '' ) then
  begin
    case DBGrid1.DataSource.DataSet.FieldByName(sFld2).DataType of
      ftString: begin
                 if sOpr2='like' then sVal2:='%'+sVal2+'%';
                 SQL2:=format(' %s  %s %s ''%s'' ', [sLog1, sFld2, sOpr2, sVal2]);
                end;
      ftInteger: begin
                   try
                     StrToInt(sVal2);
                   except
                     showmessage('第二个字段（列）值为无效的整型，请重新输入！');