creport.pas

Delphi报表设计器源代码

      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;

procedure TCreportForm.SpeedButton8Click(Sender: TObject); // add 李泽伦
var
  z1, z2: integer;
begin

  if (ScrollBox1.Height) < pgh then // add 李泽伦
    z1 := trunc(((ScrollBox1.Height-80) / pgh) * 100)
  else
    z1 := 100-1;

  if (ScrollBox1.Width) < pgw then // add 李泽伦
    z2 := trunc(((ScrollBox1.Width-170) / pgw) * 100)
  else
    z2 := 100-1;

  if z1 <= z2 then // add 李泽伦
    zoomxxx := z1
  else
    zoomxxx := z2;

  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;
  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;
  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) and (not plcreportbutt) then
  begin
   pt:=(Sender as TWinControl).ClienttoScreen(point(x,y));
   PopupMenu1.Popup(pt.X,pt.Y);
  end;
  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;
      if ReportControl1.celldisp.LogFont.lfStrikeOut = 1 then StrikeOut.Down := True else StrikeOut.Down := False;

       Sxbform.edit1.OnChange:=nil;
       Sxbform.edit2.OnChange:=nil;
       Sxbform.SpinEdit1.OnChange:=nil;
       Sxbform.SpinEdit2.OnChange:=nil;

       Sxbform.SpinEdit1.Value:=ReportControl1.celldisp.zj;
       Sxbform.SpinEdit2.Value:=ReportControl1.celldisp.lj;

       Sxbform.edit1.Text:=ReportControl1.celldisp.Fsbbs;
       Sxbform.edit2.Text:=ReportControl1.celldisp.Fxbbs;

       Sxbform.edit1.OnChange:=Sxbform.Edit1Change;
       Sxbform.edit2.OnChange:=Sxbform.Edit2Change;
       Sxbform.SpinEdit1.OnChange:=Sxbform.SpinEdit1Change;
       Sxbform.SpinEdit2.OnChange:=Sxbform.SpinEdit2Change;

      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;
      lsum.Text := '';
    end;
  except
    //
  end;

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


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-1;

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

  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;


//lzl

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.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);
      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.ComboBox1Change(Sender: TObject); // add 李泽伦
var
  ss: STRING;
  Dbar: tpanel;                         //TToolWindow97;
  Dlist: tlistbox;
begin

  IF ComboBox1.Items[ComboBox1.ItemIndex] = '' THEN
   exit;
  Dbar := tpanel.Create(self);          //TToolWindow97
  Dlist := tlistbox.Create(self);
  Dbar.Parent := Self;
  Dbar.Height := 140;
  Dbar.Width := 120;
  Dlist.Parent := DBar;
  Dlist.Align := alClient;
  Dlist.DragMode := dmAutomatic;
  Dbar.DragMode := dmAutomatic;
  dbar.DragKind:=dkdock;
  Dlist.OnDragOver := ListBoxDragOver;
  Dbar.Left := dbarleft * 120 + 2;
  dbar.top := dbartop * 140 + 2;
  PostMessage(dbar.Handle, WM_LBUTTONDOWN, 0, 0);
  mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0);
  dbar.Show;

  if dbar.left > 780 then
  begin
    dbartop := dbartop + 1;
    dbarleft := 0;
  end
  else
    dbarleft := dbarleft + 1;
  ss := ComboBox1.Items[ComboBox1.itemindex];
  Dbar.Caption := '表名:' + ss;
  try
    TDataSet(LFindComponent(Owner, ss)).GetFieldNames(dlist.Items);
  except
    MessageDlg('此表打不开或属性设置不正确', mtInformation, [mbOk], 0);
  end;

end;


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

procedure TCreportForm.LoadFromStream(Stream: TStream);
begin
  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;

procedure TCreportForm.mn_medium1Click(Sender: TObject);
begin
  medium1.Down := not medium1.Down;
  left1Click(sender)
end;

procedure TCreportForm.setbuttonClose;
begin
  SpeedButton1.Enabled:=false;
  SpeedButton13.Enabled:=false;
  SpeedButton14.Enabled:=false;
  SpeedButton17.Enabled:=false;
  SpeedButton23.Enabled:=false;
  SpeedButton24.Enabled:=false;
  SpeedButton25.Enabled:=false;
  SpeedButton26.Enabled:=false;
  SpeedButton28.Enabled:=false;
  SpeedButton29.Enabled:=false;
  SpeedButton30.Enabled:=false;
  SpeedButton31.Enabled:=false;
  ComboBox1.Enabled:=false;
  t2.Enabled:=false;
  ReportControl1.CPreviewEdit:=false;
end;

procedure TCreportForm.FormActivate(Sender: TObject);
begin
   Application.CreateForm(Tsxbform,sxbform);
   FCreportedit:=true;
end;

procedure TCreportForm.N401To4111Click(Sender: TObject);
begin

  if OpenDialog1.Execute then
  begin
   try
    ReportControl1.LoadFromFilek(OpenDialog1.Filename);
    ReportControl1.SaveToFile(OpenDialog1.Filename);
   except
    end;
  end;

end;

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

end;

procedure TCreportForm.N33Click(Sender: TObject);
begin
if cellline_d=nil then
begin
   Application.Messagebox('请选择单元格!!!', '警告', MB_OK + MB_iconwarning);
   exit;
end;
    try
      if OpenPictureDialog1.Execute then
      begin
        ReportControl1.SaveBmp(ReportControl1.celldisp, OpenPictureDialog1.FileName);
        Saved := False;
      end;
    except
    end;

end;

procedure TCreportForm.N34Click(Sender: TObject);
var
  Acanvas: Tcanvas;
  LTempRect: Trect;
begin
if cellline_d=nil then
begin
   Application.Messagebox('请选择单元格!!!', '警告', MB_OK + MB_iconwarning);
   exit;
end;
    ReportControl1.FreeBmp(ReportControl1.celldisp);
    Saved := False;

    ShowWindow(ReportControl1.Handle, SW_HIDE);
    ScrollBox1Resize(Self);
    ShowWindow(ReportControl1.Handle, SW_SHOW);
end;

procedure TCreportForm.SpeedButton4Click(Sender: TObject);
begin
if cellline_d=nil then
begin
   Application.Messagebox('请选择单元格!!!', '警告', MB_OK + MB_iconwarning);
   exit;
end;
       sxbform.Rep:=ReportControl1;
       sxbform.ShowModal;
end;

procedure TCreportForm.CellDispFormtChange(Sender: TObject);
begin
if cellline_d=nil then
begin
   Application.Messagebox('请选择单元格!!!', '警告', MB_OK + MB_iconwarning);
   exit;
end;
   ReportControl1.SetCellDispFormt(CellDispFormt.items[CellDispFormt.itemindex]);
end;

procedure TCreportForm.LsumChange(Sender: TObject);
begin
if cellline_d=nil then
begin
   Application.Messagebox('请选择单元格!!!', '警告', MB_OK + MB_iconwarning);
   exit;
end;
      ReportControl1.celldisp.CellText := Lsum.Items[Lsum.ItemIndex];
      ReportControl1.SetCellSumText('`' + Lsum.items[Lsum.itemindex]);
      ReportControl1.SetCellFont(ReportControl1.celldisp.LogFont);

end;

end.