creport.pas

企业智能(ERP)管理系统

end;

procedure TCreportForm.CellBorderLineClick(Sender: TObject); // update 李泽伦
begin
  if ReportControl1.cellline_d <> nil then begin
    with Tborderform.Create(Self) do begin
      try
        LeftLine.Checked := ReportControl1.celldisp.LeftLine;
        TopLine.Checked := ReportControl1.celldisp.TopLine;
        RightLine.Checked := ReportControl1.celldisp.RightLine;
        BottomLine.Checked := ReportControl1.celldisp.BottomLine;

        SpinEdit1.Value := ReportControl1.celldisp.LeftLineWidth;
        SpinEdit2.Value := ReportControl1.celldisp.TopLineWidth;
        SpinEdit3.Value := ReportControl1.celldisp.RightLineWidth;
        SpinEdit4.Value := ReportControl1.celldisp.BottomLineWidth;

        if ShowModal = mrOK then
          ReportControl1.SetCellLines(LeftLine.Checked,
            TopLine.Checked,
            RightLine.Checked,
            BottomLine.Checked,
            SpinEdit1.Value, SpinEdit2.Value, SpinEdit3.Value, SpinEdit4.Value);
        Saved := False;
      finally
        Free;
      end;
    end;
  end
  else Application.Messagebox('请选择单元格!!!', '警告', MB_OK + MB_iconwarning);
end;

procedure TCreportForm.CellDiagonalLineClick(Sender: TObject);
var
  nDiagonal: UINT;
begin
  if ReportControl1.celldisp <> nil then
    with TDiagonalForm.Create(Self) do begin
      try
        if ShowModal = mrOK then
        begin
          nDiagonal := 0;
          if LeftDiagonal1.Checked then
            nDiagonal := nDiagonal or LINE_LEFT1;

          if LeftDiagonal2.Checked then
            nDiagonal := nDiagonal or LINE_LEFT2;

          if LeftDiagonal3.Checked then
            nDiagonal := nDiagonal or LINE_LEFT3;

          if RightDiagonal1.Checked then
            nDiagonal := nDiagonal or LINE_RIGHT1;

          if RightDiagonal2.Checked then
            nDiagonal := nDiagonal or LINE_RIGHT2;

          if RightDiagonal3.Checked then
            nDiagonal := nDiagonal or LINE_RIGHT3;
          ReportControl1.SetCellDiagonal(nDiagonal);
          Saved := False;
        end;
      finally
        Free;
      end;
    end;
end;

procedure TCreportForm.CellFontClick(Sender: TObject);
var
  CellFont: TLogFont;
  hTempDC: HDC;
  pt, ptOrg: TPoint;
begin
  if ReportControl1.cellline_d <> nil then
  begin
    hTempDC := GetDC(0);
    pt.y := abs(reportcontrol1.cellFont_d.lfheight) * 720 div GetDeviceCaps(hTempDC, LOGPIXELSY);
    DPtoLP(hTempDC, pt, 1);
    ptOrg.x := 0;
    ptOrg.y := 0;
    DPtoLP(hTempDC, ptOrg, 1);

    FontDialog1.Font.Name := reportcontrol1.cellFont_d.lfFaceName;
    FontDialog1.Font.Size := ((pt.y - ptOrg.y) div 10);

    if FontDialog1.Execute then
    begin
      Windows.GetObject(FontDialog1.Font.Handle, SizeOf(CellFont), @CellFont);
      ReportControl1.SetCellFont(CellFont);
      ReportControl1.SetCellTextColor(FontDialog1.Font.color);
      Saved := False;
    end;
  end
  else Application.Messagebox('请选择单元格!!!', '警告', MB_OK + MB_iconwarning);
end;

procedure TCreportForm.CellColorClick(Sender: TObject);
begin
  if ReportControl1.cellline_d <> nil then
  begin
    with TColorForm.Create(Self) do begin
      try
        if ShowModal = mrOK then
        begin
          ReportControl1.SetCellColor(Panel1.Font.Color, Panel1.Color);
          Saved := False;
        end;
      finally
        Free;
      end;
    end;
  end
  else Application.Messagebox('请选择单元格!!!', '警告', MB_OK + MB_iconwarning);
end;

procedure TCreportForm.FileSaveClick(Sender: TObject);
begin
  if IsFile then
    SaveDialog1.FileName := FFile
  else
    SaveDialog1.FileName := '';

  if SaveDialog1.Execute then
  begin
    ReportControl1.SaveToFile(SaveDialog1.FileName);
    Saved := True;
    LoadFromFile(SaveDialog1.FileName);
    updateOldies(SaveDialog1.FileName, sender);
  end;
end;

procedure TCreportForm.PrintItClick(Sender: TObject); // update 李泽伦
begin
  if IsInstalledPrinter then ReportControl1.PrintIt
  else Application.Messagebox('未安装打印机', '警告', MB_OK + MB_iconwarning);
end;

procedure TCreportForm.VSplitCellClick(Sender: TObject);
begin
  if ReportControl1.celldisp <> nil then
    with TVSplitForm.Create(Self) do begin
      try
        if ShowModal = mrOK then
        begin
          ReportControl1.VSplitCell(VSplitCount.Value);
          Saved := False;
        end;
      finally
        Free;
      end;
    end;
end;

procedure TCreportForm.MarginSettingClick(Sender: TObject); // update 李泽伦
begin
  if TMarginkForm.EditReportControl(Self,ReportControl1) = mrOK then begin
    Saved := False;
    ReportControl1.cp_pgw := 0;
    ReportControl1.CalcWndSize;
  end;
end;

procedure TCreportForm.FileCloseClick(Sender: TObject); // update 李泽伦
begin
  if Application.Messagebox('确实要关闭报表吗？', '警告', MB_OKCANCEL) = MrOK then
  begin
    IsStream:=False;
    IsFile:=True;
    FFile:='';
    ReportControl1.celldisp := nil;
    ReportControl1.FreeEdit;
    ReportControl1.ResetContent;
    ReportControl1.cp_pgw := 0;
    ReportControl1.CalcWndSize;
    Self.Caption := '[无报表]';
  end;
end;


procedure TCreportForm.updateoldies(thefile: string; sender: tobject);
var
  A, B, holder: string;
  n: integer;
  IniFile: TIniFile;
begin
  IniFile := TIniFile.create(defini);
  try
    //  IniFile := TIniFile.create(ExtractFilePath(ParamStr(0)) + defini);
    A := uppercase(thefile);
    holder := A;
    for n := 1 to 10 do
    begin
      B := inifile.readstring('Oldies', inttostr(n), '');
      if b = holder then
      begin
        inifile.writestring('Oldies', inttostr(n), 'filepath');
        B := inifile.readstring('Oldies', inttostr(n), '');
      end;
      inifile.writestring('Oldies', inttostr(n), A);
      A := B;
    end;
    zoomxxx := 100;
    ShowWindow(ReportControl1.Handle, SW_HIDE);
    ReportControl1.ReportScale := zoomxxx;
    ScrollBox1Resize(Self);
    ShowWindow(ReportControl1.Handle, SW_SHOW);
  finally
    IniFile.Free;
  end;
end;

procedure TCreportForm.RecentFile1(sender: tobject);
begin
  RecentFile(1);
end;

procedure TCreportForm.RecentFile2(sender: tobject);
begin
  RecentFile(2);
end;

procedure TCreportForm.RecentFile3(sender: tobject);
begin
  RecentFile(3);
end;

procedure TCreportForm.RecentFile4(sender: tobject);
begin
  RecentFile(4);
end;

procedure TCreportForm.RecentFile5(sender: tobject);
begin
  RecentFile(5);
end;

procedure TCreportForm.RecentFile6(sender: tobject);
begin
  RecentFile(6);
end;

procedure TCreportForm.RecentFile7(sender: tobject);
begin
  RecentFile(7);
end;

procedure TCreportForm.RecentFile8(sender: tobject);
begin
  RecentFile(8);
end;

procedure TCreportForm.RecentFile9(sender: tobject);
begin
  RecentFile(9);
end;

procedure TCreportForm.T1Click(Sender: TObject);
var
  NewItem: TMenuItem;
  count, A, B, wipe: string;
  n, m: integer;
  IniFile: TIniFile;
label
  redo;
begin
  IniFile := TIniFile.create(defini);
  try
    while file1.count > 0 do
      file1.Delete(0);
    for n := 1 to 9 do
    begin
      count := inttostr(n);
      redo: //循环开始
      A := inifile.readstring('Oldies', count, '');
      if A = '' then exit;
      if not fileexists(A) then
      begin
        for m := strtoint(count) to 10 do
        begin
          B := inifile.readstring('Oldies', inttostr(m + 1), '');
          inifile.writestring('Oldies', inttostr(m), B);
          wipe := inttostr(m + 1);
        end;
        inifile.writestring('Oldies', wipe, '');
        goto redo; //循环结束
      end;
      NewItem := TMenuItem.Create(Self);
      NewItem.Caption := '&' + count + ' ' + A;
      case n of
        1: newitem.onclick := RecentFile1;
        2: newitem.onclick := RecentFile2;
        3: newitem.onclick := RecentFile3;
        4: newitem.onclick := RecentFile4;
        5: newitem.onclick := RecentFile5;
        6: newitem.onclick := RecentFile6;
        7: newitem.onclick := RecentFile7;
        8: newitem.onclick := RecentFile8;
        9: newitem.onclick := RecentFile9;
      end;
      //    File1.Insert(n-1, NewItem);
      File1.Add(NewItem);
    end;
  finally
    IniFile.Free;
  end;
end;

procedure TCreportForm.N29Click(Sender: TObject);
var
  t: string;
begin
  //  t := statusbar1.Panels[3].text;
  //  statusbar1.Panels[3].text := SaveFileName + ' 正在存盘...';
  if IsFile then
    if FFile = '' then
    begin
      FileSaveClick(nil);
    end
    else
    begin
      ReportControl1.SaveToFile(FFile);
      updateOldies(FFile, Sender);
      Saved := True;
    end;
  if IsStream then
    ReportControl1.SaveToStream(FStream);
  //  statusbar1.Panels[3].text := t;
end;

procedure TCreportForm.ScrollBox1Resize(Sender: TObject);
begin
  {
  if IsWindow(ReportControl1.Handle) then
    begin
      if ScrollBox1.ClientRect.Right > ReportControl1.Width + 20 then
        ReportControl1.Left := (ScrollBox1.ClientRect.Right - ReportControl1.Width) div 2
      else ReportControl1.Left := 15;
      if ScrollBox1.ClientRect.Bottom > ReportControl1.Height + 20 then
        ReportControl1.top := (ScrollBox1.ClientRect.Bottom - ReportControl1.height) div 2
      else ReportControl1.top := 15;
    end;
    }

  if ClientRect.Right > ReportControl1.Width + 20 then
    ReportControl1.Left := (ClientRect.Right - ReportControl1.Width - 20) div 2
  else
    ReportControl1.Left := 30;

  if ((height - 150 - ReportControl1.Height) div 2) + 10 > 10 then
    ReportControl1.top := ((height - 150 - ReportControl1.Height) div 2) + 5
  else
    ReportControl1.top := 5;

end;

procedure TCreportForm.N33Click(Sender: TObject);
begin
  {
  with TfrmAbout.Create(Self) do begin
    try
      ShowModal;
    finally
      Free;
    end;
  end;
  }
end;

procedure TCreportForm.left1Click(Sender: TObject);
var
  h, v: byte;
begin
  h := 3;
  v := 3;
  if left1.Down then h := 0;
  if center1.down then h := 1;
  if right1.down then h := 2;
  if top1.Down then v := 0;
  if medium1.Down then v := 1;
  if bottom1.down then v := 2;
  ReportControl1.SetCellAlign(H, v);
  Saved := False;

end;

procedure TCreportForm.fontboxChange(Sender: TObject);
var
  CellFont: TLogFont;
  cf: TFont;
  i, code: integer;
begin
  if ReportControl1.celldisp <> nil then
  begin
    cf := Tfont.Create;
    try
      cf.Name := fontbox.items[fontbox.itemindex];
      val(fontsize.text, i, code);
      if i < 1 then i := 9;
      cf.Size := i;
      if bold.Down then cf.Style := cf.style + [fsBold];
      if italic.Down then cf.Style := cf.style + [fsItalic];
      if underline.Down then cf.Style := cf.style + [fsunderline];

      Windows.GetObject(cf.Handle, SizeOf(CellFont), @CellFont);
    finally
      cf.Free;
    end;
    ReportControl1.SetCellFont(CellFont);
    Saved := False;
  end;
end;

procedure TCreportForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
var
  key: integer;