setprint.pas

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

    procedure btnSaveClick(Sender: TObject);
    procedure btnIniClick(Sender: TObject);
    procedure FontNameChange(Sender: TObject);
    procedure FontSizeChange(Sender: TObject);
    procedure FontColorClick(Sender: TObject);
    procedure ColorClick(Sender: TObject);
    procedure RichSelectionChange(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure BoldButtonClick(Sender: TObject);
    procedure ItalicButtonClick(Sender: TObject);
    procedure UnderlineButtonClick(Sender: TObject);
    procedure YmdyFontClick(Sender: TObject);
    procedure rbPrintAllClick(Sender: TObject);
    procedure AddSysItemClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
    ReportCount: integer;
    FilePath, FileName, strSpace: string;
    { RichEdit }
    CurrFile: TRichEdit;
    FUpdating: Boolean;
    BoldButton, ItalicButton, UnderlineButton: TToolButton;
    FontColor: TPanel;
    FontSize: TEdit;
    FontName: TComboBox;
    TmpFileName: string;
    blnPrintting: boolean;
    { RichEdit }
    function CurrText: TTextAttributes;
    procedure RichClone(SourceRich, TargetRich: TRichEdit);
    function FileToString(Sender: TObject): string;
    procedure SetRichText(ARichEdit: TRichEdit);
    { Ini File }
    procedure IniSet;
    procedure SaveSet(AFileName: string);
    procedure LoadSet(AFileName: string);
    { Column }
    procedure MoveSelected(List: TCustomListBox; Items: TStrings);
    procedure SetItem(List: TListBox; Index: Integer);
    function GetFirstSelection(List: TCustomListBox): Integer;
    { Others }
    procedure SetPmnXm;
    procedure AddMenuItem(ACaption, AHint: string; ATag: integer);
    procedure MenuItemClick(Sender: TObject);
    procedure SetNotePage(APage: string);
    function GetInputString(const ACaption, APrompt, ADefault: string): string;
    function GetRichEditHeight(ARichEdit: TRichEdit): integer;
    procedure BeginPrint(APreview: boolean);
    procedure SetPageSize(Width, Length: integer);
    function GetActiveMemo(Sender: TObject): TMemo;
    procedure SetButtons;
    procedure DrawBandFrame(ABand: TQRCustomBand; AItemIndex: Integer);
  public
    { Public declarations }
    ReportName: string;
    AForm: TForm;
    AGrid: TDBGrid;
    ADataSet: TClientdataset;
    blnPreview: boolean;
    blnHaveTotal, blnHavePageTotal: boolean;
    strTotalFields: string;
  end;

const
  RichMargin = 10;

var
  frmSetPrint: TfrmSetPrint;

implementation

uses Dm, ComJbzl, Main, SetPrint_P, InputString, ComDjzb, ComDj, ComFlzl,
  ComDczl, ComTjfx;

{$R *.DFM}

{-Form Even 窗体事件-}

//Form.Create
procedure TfrmSetPrint.FormCreate(Sender: TObject);
begin
  FilePath := ExtractFilePath(Application.ExeName) + 'Report\';
  TmpFileName := FilePath + 'Tmp.Tmp';
  CurrFile := YmRich;
  SetImageTop(Sender);
end;

//Form.Show
procedure TfrmSetPrint.FormShow(Sender: TObject);
var
  i: integer;
  iniFile : TIniFile;
  strRptName: string;
begin
  screen.Cursor := crHourGlass;
  strSpace := '';
  for i := 1 to 50 do
    strSpace := strSpace + ' ';
  //Dyj
  cbDyj.Items.Assign(printer.Printers);
  for i := 0 to cbDyj.Items.Count - 1 do
    cbDyj.Items[i] := Copy(cbDyj.Items[i], 1, Pos('on', cbDyj.Items[i]) - 2);
  cbDyj.ItemIndex := Printer.PrinterIndex;
  cbYmfs.ItemIndex := 0;
  //Set Col Width
  with pnlColWidth do
  begin
    Top := self.TabSheet2.Top + 9;
    Height := self.TabSheet2.Height - 6;
    Left :=  self.TabSheet2.Left + 9;
    Width :=  self.TabSheet2.Width - 6;
    Visible := false;
  end;
  dbgColWidth.DataSource := AGrid.DataSource;
  //PageControl
  PageControl1.ActivePageIndex := 0;
  PageControl2.ActivePageIndex := 0;
  Notebook1.ActivePage := '1';
  //pmnXm Ini
  SetPmnXm;
  //Rich Control Ini
  with YmRich.Font do
  begin
    CurrFile := YmRich;
    YmFontName.Items.Assign(screen.Fonts);
    YmFontName.Text := Name;
    YmFontName.Sorted := True;
    YmFontSize.Text := IntToStr(Size);
  end;
  with BtRich.Font do
  begin
    CurrFile := BtRich;
    BtFontName.Items.Assign(screen.Fonts);
    BtFontName.Text := Name;
    BtFontName.Sorted := True;
    BtFontSize.Text := IntToStr(Size);
  end;
  with BgbtRich.Font do
  begin
    CurrFile := BgbtRich;
    BgbtFontName.Items.Assign(screen.Fonts);
    BgbtFontName.Text := Name;
    BgbtFontName.Sorted := True;
    BgbtFontSize.Text := IntToStr(Size);
  end;
  with BwRich.Font do
  begin
    CurrFile := BwRich;
    BwFontName.Items.Assign(screen.Fonts);
    BwFontName.Text := Name;
    BwFontName.Sorted := True;
    BwFontSize.Text := IntToStr(Size);
  end;
  with YjRich.Font do
  begin
    CurrFile := YjRich;
    YjFontName.Items.Assign(screen.Fonts);
    YjFontName.Text := Name;
    YjFontName.Sorted := True;
    YjFontSize.Text := IntToStr(Size);
  end;
  CurrFile := YmRich;
  //Default Buttom
  if blnPreview then
    frmSetPrint.btnPreview.Default := true
  else
    frmSetPrint.btnPrint.Default := true;
  //RptList
  ReportCount := RptList.Items.Count;
  with FileListBox1 do
  begin
    Mask := FilePath + AForm.Name + '_*.ini';
    for i := 0 to Items.Count - 1 do
      RptList.Items.Add(Copy(Items[i], Length(AForm.Name) + 2,
        Length(Items[i]) - Length(AForm.Name) - 5));
  end;
  if RptList.Items.Count > 0 then
  begin
    RptList.ItemIndex := 0;
    RptList.SetFocus;
  end else
    btnNew.SetFocus;
  //cbRep
  with cbRpt do
  begin
    Items := RptList.Items;
    Items.Insert(0, '');
    iniFile := TiniFile.Create(ExtractFilePath(Application.ExeName) + 'System\DefRpt.ini');
    strRptName := iniFile.ReadString(AForm.Name, 'Name', '');
    iniFile.Free;
    cbRpt.ItemIndex := Items.IndexOf(strRptName)
  end;
  SetButtons;
  SetNotePage('1');
  screen.Cursor := crDefault;
  //DefRpt
  if (not blnPreview) and (cbRpt.ItemIndex <> - 1) then
  begin
    FileName := FilePath + AForm.Name + '_' + cbRpt.Text + '.ini';
    LoadSet(FileName);
    BeginPrint(true);
  end;
end;

//Form.KeyDown
procedure TfrmSetPrint.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = VK_ESCAPE then
    if self.pnlColWidth.Visible then
      self.pnlColWidth.Visible := false
    else
      btnCancelSet.Click;
  if (self.PageControl1.ActivePageIndex = 1) and
    (Shift = [ssCtrl]) then
    case Key of
      VK_LEFT:
        begin
          Key := 0;
          if self.btnLeft.Enabled then
            self.btnLeft.Click;
        end;
      VK_RIGHT:
        begin
          Key := 0;
          if self.btnRight.Enabled then
            self.btnRight.Click;
        end;
      VK_UP:
        begin
          Key := 0;
          if self.btnUp.Enabled then
            self.btnUp.Click;
        end;
      VK_DOWN:
        begin
          Key := 0;
          if self.btnDown.Enabled then
            self.btnDown.Click;
        end;
    end;
end;

//Form.Close
procedure TfrmSetPrint.FormClose(Sender: TObject;
  var Action: TCloseAction);
var
  iniFile : TIniFile;
begin
  iniFile := TiniFile.Create(ExtractFilePath(Application.ExeName) + 'System\DefRpt.ini');
  iniFile.WriteString(AForm.Name, 'Name', cbRpt.Text);
  iniFile.Free;
end;

//BG
function TfrmSetPrint.GetActiveMemo(Sender: TObject): TMemo;
begin
  result := nil;
  case self.PageControl2.ActivePageIndex of
  3: if TControl(Sender).Hint = 'Lm' then
    result := TMemo(mmoLm)
    else
    result := TMemo(mmoNy);
  4: if TControl(Sender).Hint = 'Xj' then
    result := TMemo(mmoXj)
    else
    result := TMemo(mmoHj);
  end;
end;

procedure TfrmSetPrint.btnBgBtFontClick(Sender: TObject);
begin
  with GetActiveMemo(Sender) do
  begin
    FontDialog1.Font := Font;
    if FontDialog1.Execute then
      Font := FontDialog1.Font;
  end;
  SetPreviewPnl(Sender);
end;

procedure TfrmSetPrint.btnBgBtColorClick(Sender: TObject);
begin
  with GetActiveMemo(Sender) do
  begin
    ColorDialog1.Color := Color;
    if ColorDialog1.Execute then
      Color := ColorDialog1.Color;
  end;
  if Sender = btnNyColor then
  begin
    pnlOdd.Color := ColorDialog1.Color;
    pnlEven.Color := ColorDialog1.Color;
  end;
  SetPreviewPnl(Sender);
end;

procedure TfrmSetPrint.rgBgBtClick(Sender: TObject);
begin
  SetPreviewPnl(Sender);
end;

procedure TfrmSetPrint.cbBjClick(Sender: TObject);
begin
  edtPageLeft.Enabled := not cbBj.Checked or not cbBj.Enabled;
  edtPageRight.Enabled := edtPageLeft.Enabled;
end;

//LM
procedure TfrmSetPrint.btnLeftClick(Sender: TObject);
var
  Index: Integer;
begin
  Index := GetFirstSelection(DstList);
  MoveSelected(DstList, SrcList.Items);
  SetItem(DstList, Index);
end;

procedure TfrmSetPrint.btnRightClick(Sender: TObject);
var
  Index: Integer;
begin
  Index := GetFirstSelection(SrcList);
  MoveSelected(SrcList, DstList.Items);
  SetItem(SrcList, Index);
end;

procedure TfrmSetPrint.btnUpClick(Sender: TObject);
var
  i: integer;
begin
  with DstList do
  begin
    if ItemIndex <= 0 then
    begin
      if (ItemIndex < 0) and ((Items.Count - 1) >= 0) then
        ItemIndex := 0
      else
        Beep;
      abort;
    end;
    i := ItemIndex - 1;
    Items.Move(ItemIndex, i);
    ItemIndex := i;
  end;
end;

procedure TfrmSetPrint.btnDownClick(Sender: TObject);
var
  i: integer;
begin
  with DstList do
  begin
    if (ItemIndex < 0) or (ItemIndex >= Items.Count - 1) then
    begin
      if (ItemIndex < 0) and ((Items.Count - 1) >= 0) then
        ItemIndex := 0
      else
        Beep;
      abort;
    end;
    i := ItemIndex + 1;
    Items.Move(ItemIndex, i);
    ItemIndex := i;
  end;
end;

procedure TfrmSetPrint.DstListDragDrop(Sender, Source: TObject; X,
  Y: Integer);
var
  i: integer;
  APoint: TPoint;
begin
  if Source = SrcList then
    btnRight.Click;
  if Source = DstList then
    if (Sender is TListBox) and (Source is TListBox) then
      with DstList do
      begin
        APoint.x := X;
        APoint.y := Y;
        i := ItemAtPos(APoint, true);
        if (i >= 0) and (i <= Items.Count - 1) and (i <> ItemIndex ) then
        begin
          Items.Move(ItemIndex, i);
          ItemIndex := i;
        end;
      end;
end;

procedure TfrmSetPrint.SrcListDragDrop(Sender, Source: TObject; X,
  Y: Integer);
begin
  if Source = DstList then
    btnLeft.Click;
end;

procedure TfrmSetPrint.SrcListDragOver(Sender, Source: TObject; X,
  Y: Integer; State: TDragState; var Accept: Boolean);
begin
  if Source = DstList then
    Accept := true;
end;

procedure TfrmSetPrint.DstListDragOver(Sender, Source: TObject; X,
  Y: Integer; State: TDragState; var Accept: Boolean);
begin
  if (Source = SrcList) or (Source = DstList) then
    Accept := true;
end;

function TfrmSetPrint.GetFirstSelection(List: TCustomListBox): Integer;
begin
  for Result := 0 to List.Items.Count - 1 do
    if List.Selected[Result] then Exit;
  Result := LB_ERR;
end;

procedure TfrmSetPrint.MoveSelected(List: TCustomListBox; Items: TStrings);
var
  I: Integer;
begin
  for I := 0 to List.Items.Count - 1 do
    if List.Selected[I] then
      Items.AddObject(List.Items[I], List.Items.Objects[I]);
  for I := List.Items.Count - 1 downto 0 do
    if List.Selected[I] then
      List.Items.Delete(I);
end;

procedure TfrmSetPrint.SetItem(List: TListBox; Index: Integer);
var
  MaxIndex: Integer;
begin
  with List do
  begin
    SetFocus;
    MaxIndex := List.Items.Count - 1;
    if Index = LB_ERR then Index := 0
    else if Index > MaxIndex then Index := MaxIndex;
    Selected[Index] := True;
  end;
  SetButtons;
end;

procedure TfrmSetPrint.SetButtons;