setprint.pas

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

procedure TfrmSetPrint.btnSaveAsClick(Sender: TObject);
var
  strItem: string;
begin
  if RptList.ItemIndex <= ReportCount - 1 then
  begin
    Application.MessageBox('此份是系统预设的报表, 不能另存为.',
        '提示', MB_OK + MB_ICONINFORMATION);
    exit;
  end;
  strItem := GetInputString('另存 ' + RptList.Items[RptList.ItemIndex] + ' 为',
    '报表名称', RptList.Items[RptList.ItemIndex]);
  if strItem <> '' then
    if RptList.Items.IndexOf(strItem) >= 0 then
      Application.MessageBox('此报表名称已存在, 请重新另存.',
        '另存为', MB_OK + MB_ICONINFORMATION)
    else begin
      CopyFile(PChar(FilePath + AForm.Name + '_' + RptList.Items[RptList.ItemIndex] + '.ini'),
        PChar(FilePath + AForm.Name + '_' + strItem + '.ini'), false);
      RptList.ItemIndex := RptList.Items.Add(strItem);
      cbRpt.Items.Add(strItem);
    end;
  RptList.SetFocus;
end;

//btnDel.Click
procedure TfrmSetPrint.btnDelClick(Sender: TObject);
var
  i: integer;
begin
  if RptList.ItemIndex <= ReportCount - 1 then
  begin
    Application.MessageBox('此份是系统预设的报表, 不能删除.',
        '提示', MB_OK + MB_ICONINFORMATION);
    exit;
  end;
  if Application.MessageBox('确定要删除此份报表吗?',
    '资料删除', MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2) = IDYES then
  begin
    DeleteFile(PChar(FilePath + AForm.Name + '_' + RptList.Items[RptList.ItemIndex] + '.ini'));
    i := RptList.ItemIndex;
    RptList.Items.Delete(i);
    if RptList.Items.Count = 0 then
      i := -1;
    if i > RptList.Items.Count - 1 then
      i := RptList.Items.Count - 1;
    RptList.ItemIndex := i;
  end;
  SetButtons;
end;

//btnPreview.Click
procedure TfrmSetPrint.btnPreviewClick(Sender: TObject);
begin
  if RptList.ItemIndex <= ReportCount - 1 then
  begin
    ReportName := RptList.Items[RptList.ItemIndex];
    Close;
    Exit;
  end;
  FileName := FilePath + AForm.Name + '_' + RptList.Items[RptList.ItemIndex] + '.ini';
  if Sender <> btnPreivewNotLoad then
    LoadSet(FileName);
  BeginPrint(true);
end;

//btnPrint.Click
procedure TfrmSetPrint.btnPrintClick(Sender: TObject);
begin
  if RptList.ItemIndex <= ReportCount - 1 then
  begin
    ReportName := RptList.Items[RptList.ItemIndex];
    Close;
    Exit;
  end;
  FileName := FilePath + AForm.Name + '_' + RptList.Items[RptList.ItemIndex] + '.ini';
  LoadSet(FileName);
  BeginPrint(false);
end;

//btnSave.Click
procedure TfrmSetPrint.btnSaveClick(Sender: TObject);
begin
  SaveSet(FileName);
  Application.MessageBox('已保存对此报表设置的修改。', '保存设置', MB_OK + MB_ICONINFORMATION);
end;

//btnIni.Click
procedure TfrmSetPrint.btnIniClick(Sender: TObject);
begin
  if Application.MessageBox('确定初始化此份报表的设置吗?',
    '初始化', MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2) = IDYES then
    IniSet;
end;

{-Others Even 其它事件-}

//SetPmnXm
procedure TfrmSetPrint.SetPmnXm;
var
  i, j: integer;
begin
  pmnXm.Items.Clear;
  //Sys
  AddMenuItem('当前日期', DateToStr(Date), 10);
  AddMenuItem('当前时间', FormatDateTime('hh:nn', Time), 5);
  AddMenuItem('当前操作员', pstrUserName, 12);
  AddMenuItem('-', '', 0);
  //ComFlzl
  if AForm is TfrmComFlzl then
    with TfrmComFlzl(AForm) do
      if (CheckBox1.Checked) and (VarToStr(DBLookupComboBox1.KeyValue)<>'') then
        AddMenuItem(Copy(CheckBox1.Caption, 1, Length(CheckBox1.Caption)-1), VarToStr(DBLookupComboBox1.Text), 2);
  //ComTjfx
  if AForm is TfrmComTjfx then
    with TfrmComTjfx(AForm) do
      AddMenuItem('统计范围', labTj.Caption, Length(labTj.Caption));
  //ComDczl
  if AForm is TfrmComDczl then
    with TfrmComDczl(AForm) do
      for i := 0 to ComponentCount - 1 do
        if (Components[i] is TDBGrid) and (StrToInt(Copy(Components[i].Name, 7, 1)) < StrToInt(Copy(AGrid.Name, 7, 1))) then
          with TDBGrid(Components[i]).DataSource.DataSet do
            for j := 0 to Fields.Count - 1 do
              if Fields[j].Visible and (Fields[j].Tag = 0) then
                if Fields[j] is TNumericField then
                  AddMenuItem(Fields[j].DisplayLabel, FormatFloat(TNumericField(Fields[j]).DisplayFormat, Fields[j].AsFloat), Fields[j].DisplayWidth)
                else
                  AddMenuItem(Fields[j].DisplayLabel, Fields[j].AsString, Fields[j].DisplayWidth);
  //ComDj
  if AForm is TfrmComDj then
    with TfrmComDj(AForm).DBNavigator1.DataSource.DataSet do
      for i := 0 to Fields.Count - 1 do
        if Fields[i].Visible and (Fields[i].Tag = 0) then
          if Fields[i] is TNumericField then
            AddMenuItem(Fields[i].DisplayLabel, FormatFloat(TNumericField(Fields[i]).DisplayFormat, Fields[i].AsFloat), Fields[i].DisplayWidth)
          else
            AddMenuItem(Fields[i].DisplayLabel, Fields[i].AsString, Fields[i].DisplayWidth);
  //pmnAdd
  AddMenuItem('-', '', 0);
  for i := 0 to pmnAdd.Items.Count - 1 do
    AddMenuItem(pmnAdd.Items[i].Caption, pmnAdd.Items[i].Hint, pmnAdd.Items[i].Tag);
end;

//AddMenuItem
procedure TfrmSetPrint.AddMenuItem(ACaption, AHint: string; ATag: integer);
var
  CMI: TMenuItem;
begin
  CMI := TMenuItem.Create(self);
  CMI.Caption := ACaption;
  CMI.Hint := AHint;
  CMI.Tag := ATag;
  CMI.OnClick := MenuItemClick;
  pmnXm.Items.Add(CMI);
end;

//MenuItem.Click
procedure TfrmSetPrint.MenuItemClick(Sender: TObject);
var
  s: string;
begin
  s := CurrFile.Lines.Strings[CurrFile.CaretPos.y];
  Insert(TMenuItem(Sender).Caption + ': [' + TMenuItem(Sender).Caption + ']', s, CurrFile.CaretPos.x + 1);
  CurrFile.Lines.Strings[CurrFile.CaretPos.y] := s;
end;

//AddSysItemClick
procedure TfrmSetPrint.AddSysItemClick(Sender: TObject);
var
  potClient, potScreen: TPoint;
begin
  potClient.x := 28;
  potClient.y := TControl(Sender).Top - pmnXm.Items.Count div 2 * 18;
  potScreen := TControl(Sender).ClientToScreen(potClient);
  pmnXm.Popup(potScreen.x, potScreen.Y);
end;

//rbPrintAll.Click
procedure TfrmSetPrint.rbPrintAllClick(Sender: TObject);
begin
  edtFirstPage.Enabled := not rbPrintAll.Checked;
  edtLastPage.Enabled := edtFirstPage.Enabled;
end;

{-RichEdit-}

//Color.Click
procedure TfrmSetPrint.ColorClick(Sender: TObject);
begin
  ColorDialog1.Color := TPanel(Sender).Color;
  if ColorDialog1.Execute then
    TPanel(Sender).Color := ColorDialog1.Color;
  SetPreviewPnl(nil);
end;

//FontName.Change
procedure TfrmSetPrint.FontNameChange(Sender: TObject);
begin
  if FUpdating then Exit;
  CurrText.Name := TComboBox(Sender).Items[TComboBox(Sender).ItemIndex];
end;

//FontSize.Change
procedure TfrmSetPrint.FontSizeChange(Sender: TObject);
begin
  if FUpdating then Exit;
  CurrText.Size := StrToInt(TEdit(Sender).Text);
end;

//FontColor.Click
procedure TfrmSetPrint.FontColorClick(Sender: TObject);
begin
  if FUpdating then Exit;
  ColorDialog1.Color := TPanel(Sender).Color;
  if ColorDialog1.Execute then
  begin
    TPanel(Sender).Color := ColorDialog1.Color;
    CurrText.Color := TPanel(Sender).Color;
  end;
end;

//Rich.SelectionChange
procedure TfrmSetPrint.RichSelectionChange(Sender: TObject);
begin
  if blnPrintting then exit;
  with CurrFile.Paragraph do
  try
    FUpdating := True;
    BoldButton.Down := fsBold in CurrFile.SelAttributes.Style;
    ItalicButton.Down := fsItalic in CurrFile.SelAttributes.Style;
    UnderlineButton.Down := fsUnderline in CurrFile.SelAttributes.Style;
    FontColor.Color := CurrFile.SelAttributes.Color;
    FontSize.Text := IntToStr(CurrFile.SelAttributes.Size);
    FontName.Text := CurrFile.SelAttributes.Name;
  finally
    FUpdating := False;
  end;
end;

//BoldButton.Click
procedure TfrmSetPrint.BoldButtonClick(Sender: TObject);
begin
  if FUpdating then Exit;
  if TToolButton(Sender).Down then
    CurrText.Style := CurrText.Style + [fsBold]
  else
    CurrText.Style := CurrText.Style - [fsBold];
end;

//ItalicButton.Click
procedure TfrmSetPrint.ItalicButtonClick(Sender: TObject);
begin
  if FUpdating then Exit;
  if TToolButton(Sender).Down then
    CurrText.Style := CurrText.Style + [fsItalic]
  else
    CurrText.Style := CurrText.Style - [fsItalic];
end;

//UnderlineButton.Click
procedure TfrmSetPrint.UnderlineButtonClick(Sender: TObject);
begin
  if FUpdating then Exit;
  if TToolButton(Sender).Down then
    CurrText.Style := CurrText.Style + [fsUnderline]
  else
    CurrText.Style := CurrText.Style - [fsUnderline];
end;

//CurrText,
function TfrmSetPrint.CurrText: TTextAttributes;
begin
  if CurrFile.SelLength > 0 then Result := CurrFile.SelAttributes
  else Result := CurrFile.DefAttributes;
end;

//RichClone
procedure TfrmSetPrint.RichClone(SourceRich, TargetRich: TRichEdit);
begin
  mmoTmp.Lines.Text := FileToString(SourceRich);
  mmoTmp.Lines.SaveToFile(TmpFileName);
  TargetRich.Lines.LoadFromFile(TmpFileName);
end;

//FileToString
function TfrmSetPrint.FileToString(Sender: TObject): string;
var
  f: TextFile;
  strTmp, strTxt: string;
begin
  if Sender is TRichEdit then
    TRichEdit(Sender).Lines.SaveToFile(TmpFileName)
  else if Sender is TDBGrid then
    TDBGrid(Sender).Columns.SaveToFile(TmpFileName)
  else if Sender is TListBox then
    TListBox(Sender).Items.SaveToFile(TmpFileName);
  strTxt := '';
  AssignFile(f, TmpFileName);
  Reset(f);
  try
    while not Eof(f) do
    begin
      Readln(f, strTmp);
      strTxt := strTxt + strTmp;
    end;
  finally
    CloseFile(f);
  end;
  result := strTxt;
end;

//GetRichEditHeight
function TfrmSetPrint.GetRichEditHeight(ARichEdit: TRichEdit): integer;
var
  i, j: integer;
begin
  CurrFile := ARichEdit;
  result := 0;
  j := 1;
  with ARichEdit do
  begin
    for i := 0 to Lines.Count - 1 do
    begin
      SelStart := j;
      SelLength := Length(Lines[i]);
      result := result + SelAttributes.Height;
      j := j + Length(Lines[i]) + 2;
    end;
    SelLength := 0;
  end;
end;

//SetRichText
procedure TfrmSetPrint.SetRichText(ARichEdit: TRichEdit);
var
  i, j, k: integer;
  b, l: integer;
  strTxt, strXm: string;
begin
  for i := 0 to pmnXm.Items.Count - 1 do
    if pmnXm.Items[i].Caption <> '-' then
    begin
      strXm := '[' + pmnXm.Items[i].Caption + ']';
      for j := 0 to ARichEdit.Lines.Count - 1 do
      begin
        strTxt := ARichEdit.Lines.Strings[j];
        if Pos(strXm, strTxt) > 0 then
        begin
          while Pos(strXm, strTxt) > 0 do
          begin
            b := Pos(strXm, strTxt);
            l := Length(strXm);
            if b + l - 1 > l then
              if l < pmnxm.Items[i].Tag then
                l := pmnxm.Items[i].Tag
            else
              for k := b + Length(strXm) to Length(strTxt) do
                if strTxt[k] = ' ' then
                  Inc(l)
                else
                  break;
            strTxt := Copy(strTxt, 1, b - 1) +
              Copy(pmnxm.Items[i].Hint + strSpace, 1, l) +
              Copy(strTxt, b + l, Length(strTxt) - b - l + 1);
          end;
          ARichEdit.Lines.Strings[j] := Trim(strTxt);
        end;
      end;
    end;
end;

{-Begin Print 开始打印-}
procedure TfrmSetPrint.BeginPrint(APreview: boolean);
var
  i, j, k: integer;
  bmJbzl: TBookMark;
  evnTmp: TDataSetNotifyEvent;
  dblBl: Double;
  intLeft, intWidth, intLmLines: integer;
  strTmp: string;
  CShape: TQRShape;
  CMemo: TQRMemo;
  CDBText: TQRDBText;
  CLabel: TQRLabel;
  CExpr: TQRExpr;
  CSysData: TQRSysData;
begin
  blnPrintting := true;
  if pnlColWidth.Visible then btnSaveColWidth.Click;
  if rptSetPrint = nil then
    rptSetPrint := TrptSetPrint.Create(self);
  //Ini
  i := rptSetPrint.TextWidth(mmoNy.Font, '一二三四五六七八九拾');
  j := dbgColWidth.Canvas.TextWidth('一二三四五六七八九拾');
  dblBl := i / j;
  //Set rptSetPrint
  with rptSetPrint do
  begin
    DataSet := ADataSet;
    with PrinterSettings do
    begin
      Copies := edtCopies.Value;
      PrinterIndex := cbDyj.ItemIndex;
{      if rbPrintAll.Checked then
      begin
        FirstPage := 0;
        LastPage := 0;
      end
      else begin
        FirstPage := StrToInt(Trim(edtFirstPage.Text));
        LastPage := StrToInt(Trim(edtLastPage.Text));
      end;}
    end;
    with Page do
    begin
      if rbPortrait.Checked then
        Orientation := TPrinterOrientation(0)
      else
        Orientation := TPrinterOrientation(1);
      case cbPageSize.ItemIndex of
        0: PaperSize := A3;
        1: PaperSize := A4;
        2: PaperSize := A5;
        3: PaperSize := B4;
        4: PaperSize := B5;
        5: begin
          PaperSize := Custom;
          Width := edtPageWidth.Value;
          Length := edtPageLength.Value;
        end;
      end;
      ColumnSpace := edtLf.Value;
      Columns := edtLmsl.Value;
      TopMargin := edtPageTop.Value;
      BottomMargin := edtPageBottom.Value;
    end;
    //Xh
    if cbXh.Checked then
    begin
      with dbgColWidth.Columns.Add do
      begin
        Index := 0;
        Title.Caption := '序号';
        FieldName := 'DetailNo';
        Width := dbgColWidth.Canvas.TextWidth('1234');
      end;