creport.pas

Delphi报表设计器源代码

if cellline_d=nil then
begin
   Application.Messagebox('请选择单元格!!!', '警告', MB_OK + MB_iconwarning);
   exit;
end;
  ReportControl1.DeleteCell;
  Saved := False;
end;

procedure TCreportForm.CellBorderLineClick(Sender: TObject); // update 李泽伦
begin
if cellline_d=nil then
begin
   Application.Messagebox('请选择单元格!!!', '警告', MB_OK + MB_iconwarning);
   exit;
end;
    with Tborderform.Create(Self) do begin
      try
       leftline.Checked :=cellline_d.LeftLine;
       topline.Checked :=cellline_d.TopLine ;
       rightline.Checked :=cellline_d.RightLine ;
       bottomline.Checked :=cellline_d.BottomLine ;

       leftlinewidth.Value  :=cellline_d.LeftLinewidth;
       toplinewidth.Value  :=cellline_d.TopLinewidth ;
       rightlinewidth.Value  :=cellline_d.RightLinewidth ;
       bottomlinewidth.Value  :=cellline_d.BottomLinewidth ;

       p1.Color:=cellline_d.Flc;
       p2.Color:=cellline_d.Ftc;
       p3.Color:=cellline_d.Frc;
       p4.Color:=cellline_d.Fbc;

        if ShowModal = mrOK then
          ReportControl1.SetCellLines(
          LeftLine.Checked,
          TopLine.Checked,
          RightLine.Checked,
          BottomLine.Checked,
          leftLineWidth.value, topLineWidth.value, rightLineWidth.value, bottomLineWidth.value,
          p1.Color,p2.Color,p3.Color,p4.Color);
        Saved := False;
      finally
        Free;
      end;
    end;
end;

procedure TCreportForm.CellDiagonalLineClick(Sender: TObject);
var
  nDiagonal: UINT;
begin
if cellline_d=nil then
begin
   Application.Messagebox('请选择单元格!!!', '警告', MB_OK + MB_iconwarning);
   exit;
end;
    with TDiagonalForm.Create(Self) do begin
      try
        P1.Color:=cellline_d.FDc;
        if ShowModal = mrOK then
        begin
          nDiagonal := 0;
          cellline_d.FDc:=P1.Color;

          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;
BEGIN
if cellline_d=nil then
begin
   Application.Messagebox('请选择单元格!!!', '警告', MB_OK + MB_iconwarning);
   exit;
end;
      FontDialog1.Font.PixelsPerInch:=GetDeviceCaps(getdc(0), LOGPIXELSY);  //防止不同比例下
      FontDialog1.Font.Name := reportcontrol1.cellFont_d.lfFaceName;
      FontDialog1.Font.Size:=strtoint(fontsize.text);
      FontDialog1.Font.Color:=cellline_d.TextColor;
      IF FontDialog1.Execute THEN
        BEGIN
          Windows.GetObject(FontDialog1.Font.Handle, SizeOf(CellFont),  @CellFont);
          ReportControl1.SetCellFont(CellFont);
          ReportControl1.SetCellColor(FontDialog1.Font.Color,cellline_d.BkColor);
          saved := false;
        END;
END;


procedure TCreportForm.CellColorClick(Sender: TObject);
begin
if cellline_d=nil then
begin
   Application.Messagebox('请选择单元格!!!', '警告', MB_OK + MB_iconwarning);
   exit;
end;
    with TColorForm.Create(Self) do begin
      try
        Panel1.Font.Color := cellline_d.TextColor;
        Panel1.Color := cellline_d.BkColor;
        if ShowModal = mrOK then
        begin
          ReportControl1.SetCellColor(Panel1.Font.Color, Panel1.Color);
          Saved := False;
        end;
      finally
        Free;
      end;
    end;
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 cellline_d=nil then
begin
   Application.Messagebox('请选择单元格!!!', '警告', MB_OK + MB_iconwarning);
   exit;
end;
    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 TMarginForm.EditReportControl(Self,ReportControl1) = mrOK then begin
    Saved := False;
    pgw := 0;
    ReportControl1.CalcWndSize;
  end;

end;

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


procedure TCreportForm.updateoldies(thefile: string; sender: tobject);
var
  A, B, holder: string;
  n: integer;
  IniFile: TIniFile;
begin
  IniFile := TIniFile.create(defini);
  try
    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.Add(NewItem);
    end;
  finally
    IniFile.Free;
  end;
end;

procedure TCreportForm.N29Click(Sender: TObject);
var
  t: string;
begin
    if FFile = '' then
    begin
      FileSaveClick(nil);
    end
    else
    begin
      ReportControl1.SaveToFile(FFile);
      updateOldies(FFile, Sender);
      Saved := True;
      tag:=1;//预览调用时判断是否修改过标志
    end;
end;

procedure TCreportForm.ScrollBox1Resize(Sender: TObject);
begin
  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.left1Click(Sender: TObject);
var
  h, v: byte;
begin
if cellline_d=nil then
begin
   Application.Messagebox('请选择单元格!!!', '警告', MB_OK + MB_iconwarning);
   exit;
end;
  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 cellline_d=nil then
begin
   Application.Messagebox('请选择单元格!!!', '警告', MB_OK + MB_iconwarning);
   exit;
end;
    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];
      if StrikeOut.Down then cf.Style := cf.Style + [fsStrikeOut];
      Windows.GetObject(cf.Handle, SizeOf(CellFont), @CellFont);
    finally
      cf.Free;
    end;
    ReportControl1.SetCellFont(CellFont);
    Saved := False;
end;

procedure TCreportForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
var
  key: integer;
begin
  if not Saved then
  begin
    CanClose := False;
    key := Application.Messagebox('是否保存修改过的报表?', '注意', MB_YESNOCANCEL + MB_ICONEXCLAMATION); //+MB_ICONQUESTION);
    if key = MrYes then
    begin
       n29click(sender);
       sxbform.Free;
       CanClose := true;
    end
    else
    if key = MrNo then
    begin
       sxbform.Free;
       CanClose := true;
    end;
  end;
  FCreportedit:=false;
end;

procedure TCreportForm.fontsizeChange(Sender: TObject);
var
  CellFont: TLogFont;
  cf: TFont;
  i, code: integer;
begin
    cf := Tfont.Create;
    try