creport.pas

企业智能(ERP)管理系统

begin
  if not Saved then
  begin
    CanClose := False;
    key := Application.Messagebox('保存报表按“是”，不保存报表按“否”，取消本次操作按“取消”', '注意', MB_YESNOCANCEL + MB_ICONEXCLAMATION); //+MB_ICONQUESTION);
    if key = MrYes then n29click(sender);
    CanClose := key <> MrCancel;
  end;
end;

procedure TCreportForm.fontsizeChange(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.SpeedButton8Click(Sender: TObject); // add 李泽伦
var
  z1, z2: integer;
begin
  {  if (width-171) > (height-150) then
       zoomxxx:=trunc(((height-150) / cp_pgh)*100)
    else
      zoomxxx:=trunc(((width-171) / cp_pgw)*100);
   }
  if (height - 160) < ReportControl1.cp_pgh then
    z1 := trunc(((height - 160) / ReportControl1.cp_pgh) * 100)
  else
    z1 := 100;

  if (width - 171) < ReportControl1.cp_pgw then
    z2 := trunc(((width - 171) / ReportControl1.cp_pgw) * 100)
  else
    z2 := 100;

  if z1 <= z2 then
    zoomxxx := z1
  else
    zoomxxx := z2;

  ReportControl1.FreeEdit;
  ShowWindow(ReportControl1.Handle, SW_HIDE);
  ReportControl1.ReportScale := zoomxxx;
  ScrollBox1Resize(Self);
  ShowWindow(ReportControl1.Handle, SW_SHOW);

end;

procedure TCreportForm.SpeedButton12Click(Sender: TObject);
begin
  zoomxxx := zoomxxx + 10;
  ReportControl1.FreeEdit;
  ShowWindow(ReportControl1.Handle, SW_HIDE);
  ReportControl1.ReportScale := zoomxxx;
  ScrollBox1Resize(Self);
  ShowWindow(ReportControl1.Handle, SW_SHOW);

end;

procedure TCreportForm.SpeedButton15Click(Sender: TObject);
begin
  zoomxxx := zoomxxx - 10;
  ReportControl1.FreeEdit;
  ShowWindow(ReportControl1.Handle, SW_HIDE);
  ReportControl1.ReportScale := zoomxxx;
  ScrollBox1Resize(Self);
  ShowWindow(ReportControl1.Handle, SW_SHOW);

end;

procedure TCreportForm.ReportControl1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer); // update 李泽伦
var
  hTempDC: HDC;
  pt, ptOrg: TPoint;
  i: integer;
begin
  if ssright in shift then
    PopupMenu1.Popup(X, Y);

  if ssleft in shift then
  try
    Panel3.Enabled := False;
    Panel4.Enabled := False;
    if ReportControl1.celldisp <> nil then
    begin

      if ReportControl1.celldisp.HorzAlign = 0 then left1.Down := True;
      if ReportControl1.celldisp.HorzAlign = 1 then center1.Down := True;
      if ReportControl1.celldisp.HorzAlign = 2 then right1.Down := True;
      if ReportControl1.celldisp.vertAlign = 0 then top1.Down := True;
      if ReportControl1.celldisp.vertAlign = 1 then medium1.Down := True;
      if ReportControl1.celldisp.vertAlign = 2 then bottom1.Down := True;
      if ReportControl1.celldisp.LogFont.lfItalic = 1 then italic.Down := True else italic.Down := False;
      if ReportControl1.celldisp.LogFont.lfUnderline = 1 then underline.Down := True else underline.Down := False;
      if ReportControl1.celldisp.LogFont.lfWeight = 700 then bold.Down := True else bold.Down := False;
      for i := 0 to fontbox.items.Count do
      begin
        if ReportControl1.celldisp.LogFont.lfFaceName = fontbox.Items[i] then
        begin
          fontbox.ItemIndex := i;
          break;
        end;
      end;
      hTempDC := GetDC(0);
      pt.y := abs(ReportControl1.celldisp.LogFont.lfheight) * 720 div GetDeviceCaps(hTempDC, LOGPIXELSY);
      DPtoLP(hTempDC, pt, 1);
      ptOrg.x := 0;
      ptOrg.y := 0;
      DPtoLP(hTempDC, ptOrg, 1);
      fontsize.Text := inttostr((pt.y - ptOrg.y) div 10);

      CellDispFormt.Text := ReportControl1.celldisp.CellDispformat;
    end;
  except
  end;

  Panel3.Enabled := True;
  Panel4.Enabled := True;


end;

procedure TCreportForm.ReportControl1MouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  zoomxxx := 100; // add 李泽伦
end;

procedure TCreportForm.SpeedButton7Click(Sender: TObject);
begin
  close;
end;

procedure TCreportForm.FormResize(Sender: TObject); //lzl 修改
var
  z1, z2: integer;
begin
  if (height - 160) < ReportControl1.cp_pgh then
    z1 := trunc(((height - 160) / ReportControl1.cp_pgh) * 100)
  else
    z1 := 100;

  if (width - 171) < ReportControl1.cp_pgw then
    z2 := trunc(((width - 171) / ReportControl1.cp_pgw) * 100)
  else
    z2 := 100;

  if z1 <= z2 then
    zoomxxx := z1
  else
    zoomxxx := z2;

  ShowWindow(ReportControl1.Handle, SW_HIDE);
  ReportControl1.ReportScale := zoomxxx;
  ScrollBox1Resize(Self);
  ShowWindow(ReportControl1.Handle, SW_SHOW);

end;


//以下均为李泽伦增加

procedure TCreportForm.ListBoxDragOver(Sender, Source: TObject; X,
  Y: Integer; State: TDragState; var Accept: Boolean); // lzl
begin
  Accept := True;
end;

procedure TCreportForm.ReportControl1DragOver(Sender, Source: TObject; X,
  Y: Integer; State: TDragState; var Accept: Boolean); // add 李泽伦
begin
  Accept := True;
end;

procedure TCreportForm.ReportControl1DragDrop(Sender, Source: TObject; X, Y: Integer); // add 李泽伦
begin
  if Source is Tlistbox then
  begin
    ReportControl1.FreeEdit;
    ReportControl1.celldisp := nil;
    mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0);
    mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0);
    Application.ProcessMessages;
    if ReportControl1.celldisp <> nil then
    begin
      ReportControl1.celldisp.CellText := '#T1.' + tlistbox(Source).Items[tlistbox(Source).ItemIndex];
      ReportControl1.UpdateLines;
      mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0);
      mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0);
    end;
  end;
end;

procedure TCreportForm.CellDispFormtChange(Sender: TObject); // add 李泽伦
begin
  if ReportControl1.celldisp <> nil then
  begin
    ReportControl1.SetCellDispFormt(CellDispFormt.items[CellDispFormt.itemindex]);
    Saved := False;
  end;
end;

procedure TCreportForm.LsumChange(Sender: TObject);
begin
  if ReportControl1.celldisp <> nil then
  begin
    if ReportControl1.IsCellSelected(ReportControl1.celldisp) then
    begin
      ReportControl1.celldisp.CellText := Lsum.Items[Lsum.ItemIndex];
      ReportControl1.SetCellSumText('`' + Lsum.items[Lsum.itemindex]);
      fontboxChange(Sender);
      Saved := False;

    end;
  end;
end;

procedure TCreportForm.LEnumComponents(F: TComponent); // lzl
var
  i: integer;
  c: TComponent;
begin
  for i := 0 to f.ComponentCount - 1 do
  begin
    c := f.Components[i];
    //if (f is TDataModule) then
    if (c is TDataset) then
      //List.Add(f.Name + '.' + c.Name)
      combobox1.Items.Add(f.name + '.' + c.name);
  end;

end;

function TCreportForm.LFindComponent(Owner: TComponent; Name: string): TComponent; // lzl
var
  n: Integer;
  s1, s2: string;
begin
  Result := nil;
  n := Pos('.', Name);
  try
    if n = 0 then
      Result := Owner.FindComponent(Name)
    else
    begin
      s1 := Copy(Name, 1, n - 1); // module name
      s2 := Copy(Name, n + 1, 255); // component name
      Owner := FindGlobalComponent(s1);
      if Owner <> nil then
        Result := Owner.FindComponent(s2);
    end;
  except
  end;
end;


procedure TCreportForm.SpeedButton10Click(Sender: TObject); // add 李泽伦
begin
  if ReportControl1.celldisp <> nil then
  begin
    try
      if OpenPictureDialog1.Execute then
      begin
        ReportControl1.SaveBmp(ReportControl1.celldisp, OpenPictureDialog1.FileName);
        Saved := False;
      end;
    except
      //
    end;
  end
  else
    MessageDlg('请先选择单元格', mtInformation, [mbOk], 0);

end;

procedure TCreportForm.SpeedButton16Click(Sender: TObject); // add 李泽伦
var
  Acanvas: Tcanvas;
  LTempRect: Trect;
begin
  if ReportControl1.celldisp <> nil then
  begin
    ReportControl1.FreeBmp(ReportControl1.celldisp);
    Saved := False;

    ShowWindow(ReportControl1.Handle, SW_HIDE);
    ScrollBox1Resize(Self);
    ShowWindow(ReportControl1.Handle, SW_SHOW);
  end
  else
    MessageDlg('请先选择单元格', mtInformation, [mbOk], 0);
end;

procedure TCreportForm.ComboBox1Change(Sender: TObject); // add 李泽伦
var
  ss: string;
  Dbar: TToolWindow97;
  Dlist: tlistbox;
begin
  if ComboBox1.Items[ComboBox1.ItemIndex] = '' then
    exit;
  Dbar := TToolWindow97.Create(self);
  Dlist := tlistbox.Create(self);
  Dbar.Parent := Self;
  Dbar.Height := 140;
  Dbar.Width := 120;
  Dlist.Parent := DBar;
  Dlist.Align := alClient;
  Dlist.DragMode := dmAutomatic;
  Dlist.OnDragOver := ListBoxDragOver;
  Dbar.Left := dbarleft * 120 + 2;
  dbar.top := dbartop * 140 + 2;
  if dbar.left > 780 then
  begin
    dbartop := dbartop + 1;
    dbarleft := 0;
  end
  else
    dbarleft := dbarleft + 1;
  ss := ComboBox1.Items[ComboBox1.itemindex];
  Dbar.Caption := '表名:' + ss;
  Saved := False;
  try
    TDataSet(LFindComponent(Owner, ss)).GetFieldNames(dlist.Items);
  except
    MessageDlg('此表打不开或属性设置不正确', mtInformation, [mbOk], 0);
  end;
end;


procedure TCreportForm.SpeedButton4Click(Sender: TObject);
var
  TS:TStream;
begin
  if IsInstalledPrinter then
  begin
    TS:=TMemoryStream.Create;
    try
      ReportControl1.SaveToStream(TS);
      with TPreviewForm.Create(Self) do
      begin
        try
          ReportEdit:=False;//不允许编辑
          SetPreviewMode(True);
          PreviewStreams(TS);
        finally
          Free;
        end;
      end;
    finally
      TS.Free;
    end;
  end
  else Application.Messagebox('未安装打印机', '警告', MB_OK + MB_iconwarning);
end;

procedure TCreportForm.LoadFromFile(FileName: String);
begin
  IsStream:=False;
  IsFile:=True;
  FFile:=FileName;
  ReportControl1.LoadFromFile(FFile);
  Saved := True;
  Caption := FFile;
end;

procedure TCreportForm.LoadFromStream(Stream: TStream);
begin
  IsFile:=False;
  IsStream:=True;
  FStream:=Stream;
  ReportControl1.LoadFromStream(FStream);
  Saved := True;
end;

procedure TCreportForm.RecentFile(Index:Integer);
var
  IniFile: TIniFile;
  TF:String;
begin
  IniFile := TIniFile.create(defini);
  try
    TF := inifile.readstring('Oldies', IntToStr(Index), '');
    if TF <> '' then
      LoadFromFile(TF);
  finally
    IniFile.Free;
  end;
end;

end.