fr_view.pas

1、开发环境 d6 up2,sqlserver2000, win2000 server 1024*768（笔记本电脑） c/s 2、数据库配置方法

          r1.Right := r1.Left + Round((Pw - (Left + Right)) * per);
          r1.Bottom := r1.Top + Round((Ph - (Top + Bottom)) * per);
          Inc(r1.Left, r.Left); Inc(r1.Right, r.Left);
          Inc(r1.Top, r.Top); Inc(r1.Bottom, r.Top);
        end;
        Pages.Draw(i, Canvas, r1);
      end;
    end
    else
      Pages.Draw(i, Canvas, Rect(0, 0, 0, 0)); // remove it from cache
  end;
  DeleteObject(h);
end;

procedure TfrPBox.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  i: Integer;
  pt: TPoint;
  r: TRect;
  C: TCursor;
begin
  if Preview.EMFPages = nil then Exit;
  if DFlag then
  begin
    DFlag := False;
    Exit;
  end;

  with Preview do
  if Button = mbLeft then
  begin
    LastClick := 0;
    pt := Point(x - ofx, y - ofy);
    for i := 0 to TfrEMFPages(EMFPages).Count - 1 do
    begin
      r := TfrEMFPages(EMFPages)[i].r;
      if PtInRect(r, pt) then
      begin
        LastClick := i + 1;
        if TfrEMFPages(EMFPages).DoClick(i,
          Point(Round((pt.X - r.Left) / per), Round((pt.Y - r.Top) / per)),
          True, C) then Exit;
      end;
    end;
    Down := True;
    LastX := X; LastY := Y;
    CurPage := LastClick;
    ShowPageNum;
  end
  else if Button = mbRight then
  begin
    pt := Self.ClientToScreen(Point(X, Y));
    if (frDesignerClass <> nil) and TfrReport(Doc).ModifyPrepared then
    begin
      N4.Visible := True;
      N5.Visible := True;
      N6.Visible := True;
      N7.Visible := True;
    end;
    if THackControl(Preview.PreviewPanel.Parent).PopupMenu = nil then
      ProcMenu.Popup(pt.x, pt.y) else
      THackControl(Preview.PreviewPanel.Parent).PopupMenu.Popup(pt.x, pt.y);
  end;
end;

procedure TfrPBox.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  i: Integer;
  pt: TPoint;
  r: TRect;
  C: TCursor;
begin
  if Preview.EMFPages = nil then Exit;
  if Down then
  begin
    Preview.HScrollBar.Position := Preview.HScrollBar.Position - (X - LastX);
    Preview.VScrollBar.Position := Preview.VScrollBar.Position - (Y - LastY);
    LastX := X; LastY := Y;
  end
  else
  with Preview do
  if (Doc <> nil) and Assigned(TfrReport(Doc).OnMouseOverObject) then
  begin
    pt := Point(x - ofx, y - ofy);
    for i := 0 to TfrEMFPages(EMFPages).Count - 1 do
    begin
      r := TfrEMFPages(EMFPages)[i].r;
      if PtInRect(r, pt) then
      begin
        C := crDefault;
        pt := Point(Round((pt.X - r.Left) / per), Round((pt.Y - r.Top) / per));
        if TfrEMFPages(EMFPages).DoClick(i, pt, False, C) then
          Self.Cursor := C else
          Self.Cursor := crDefault;
        break;
      end;
    end;
  end;
end;

procedure TfrPBox.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  Down := False;
end;

procedure TfrPBox.DblClick;
begin
  Down := False;
  DFlag := True;
  if (Preview.EMFPages = nil) or (LastClick = 0) then Exit;
  with Preview do
  begin
    CurPage := LastClick;
    if N5.Visible then EditBtnClick(nil);
  end;
end;


{----------------------------------------------------------------------------}
procedure TfrPreviewForm.Localize;
begin
  N1.Caption := frLoadStr(frRes + 020);
  N2.Caption := frLoadStr(frRes + 021);
  N3.Caption := frLoadStr(frRes + 022);
  N5.Caption := frLoadStr(frRes + 029);
  N6.Caption := frLoadStr(frRes + 030);
  N7.Caption := frLoadStr(frRes + 031);

  ZoomBtn.Hint := frLoadStr(frRes + 024);
  LoadBtn.Hint := frLoadStr(frRes + 025);
  SaveBtn.Hint := frLoadStr(frRes + 026);
  PrintBtn.Hint := frLoadStr(frRes + 027);
  FindBtn.Hint := frLoadStr(frRes + 028);
  HelpBtn.Hint := frLoadStr(frRes + 032);
  ExitBtn.Hint := frLoadStr(frRes + 023);
end;

procedure TfrPreviewForm.FormCreate(Sender: TObject);
begin
  PBox := TfrPBox.Create(Self);
  with PBox do
  begin
    Parent := ScrollBox1;
    Align := alClient;
    BevelInner := bvNone;
    BevelOuter := bvNone;
    Color := clGray;
    Preview := Self;
    Tag := 207;
  end;

{$IFDEF Delphi4}
  ScrollBox1.OnMouseWheelUp := FormMouseWheelUp;
  ScrollBox1.OnMouseWheelDown := FormMouseWheelDown;
{$ENDIF}
  KWheel := 1;
end;

procedure TfrPreviewForm.FormDestroy(Sender: TObject);
begin
  if EMFPages <> nil then
    TfrEMFPages(EMFPages).Free;
  EMFPages := nil;
  PBox.Free;
  Application.ProcessMessages;
end;

procedure TfrPreviewForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if FormStyle <> fsMDIChild then
    SaveFormPosition(Self);
  Action := caFree;
end;

procedure TfrPreviewForm.FormShow(Sender: TObject);
begin
  Localize;
  if FormStyle <> fsMDIChild then
    RestoreFormPosition(Self) else
    WindowState := wsNormal;
end;

procedure TfrPreviewForm.FormActivate(Sender: TObject);
begin
  Application.HelpFile := 'FRuser.hlp';
  ActiveControl := ScrollBox1;
end;

procedure TfrPreviewForm.FormDeactivate(Sender: TObject);
begin
  Application.HelpFile := HF;
end;

procedure TfrPreviewForm.InitButtons;
var
  Ini: TRegIniFile;
  GrayedButtons: Boolean;
begin
  if not (csDesigning in TfrReport(Doc).ComponentState) then
  begin
    ZoomBtn.Visible := pbZoom in TfrReport(Doc).PreviewButtons;
    LoadBtn.Visible := pbLoad in TfrReport(Doc).PreviewButtons;
    SaveBtn.Visible := pbSave in TfrReport(Doc).PreviewButtons;
    PrintBtn.Visible := pbPrint in TfrReport(Doc).PreviewButtons;
    FindBtn.Visible := pbFind in TfrReport(Doc).PreviewButtons;
    HelpBtn.Visible := (pbHelp in TfrReport(Doc).PreviewButtons) and
      (TPanel.Parent = Self);
    ExitBtn.Visible := (pbExit in TfrReport(Doc).PreviewButtons) and
      (TPanel.Parent = Self);
    PageSetupBtn.Visible := (pbPageSetup in TfrReport(Doc).PreviewButtons);
    if not ZoomBtn.Visible then
      frTBSeparator1.Hide;
    frTBSeparator3.Visible := FindBtn.Visible or HelpBtn.Visible;
  end;

  PrintBtn.Enabled := Printer.Printers.Count > 0;
  PageSetupBtn.Enabled := PrintBtn.Enabled;
  if (frDesignerClass = nil) or not TfrReport(Doc).ModifyPrepared then
  begin
    N4.Visible := False;
    N5.Visible := False;
    N6.Visible := False;
    N7.Visible := False;
  end;

  case TfrReport(Doc).InitialZoom of
    pzPageWidth: LastScaleMode := mdPageWidth;
    pzOnePage: LastScaleMode := mdOnePage;
    pzTwoPages:  LastScaleMode := mdTwoPages;
  end;

  Ini := TRegIniFile.Create('Software\FastReport\' + Application.Title);
  GrayedButtons := TfrReport(Doc).GrayedButtons;
  if frDesignerClass <> nil then
    GrayedButtons := Ini.ReadBool('Form\TfrDesignerForm', 'GrayButtons', False);
  SetGrayedButtons(GrayedButtons);
  Ini.Free;
end;

procedure TfrPreviewForm.Show_Modal(ADoc: Pointer);
begin
  Connect(ADoc);
  InitButtons;
  RedrawAll(True);
  HScrollBar.Position := 0;
  VScrollBar.Position := 0;

  HF := Application.HelpFile;
  if TfrReport(Doc).ModalPreview then
    ShowModal else
    Show;
end;

procedure TfrPreviewForm.Connect(ADoc: Pointer);
begin
  Doc := ADoc;
  if EMFPages <> nil then
    TfrEMFPages(EMFPages).Free;
  EMFPages := TfrReport(Doc).EMFPages;
  TfrReport(Doc).EMFPages := TfrEMFPages.Create(Doc);
end;

procedure TfrPreviewForm.ConnectBack;
begin
  TfrReport(Doc).EMFPages.Free;
  TfrReport(Doc).EMFPages := TfrEMFPages(EMFPages);
  EMFPages := nil;
end;

procedure TfrPreviewForm.SetGrayedButtons(Value: Boolean);
var
  i: Integer;
  c: TControl;
begin
  for i := 0 to Panel1.ControlCount - 1 do
  begin
    c := Panel1.Controls[i];
    if c is TfrTBButton then
      TfrTBButton(c).GrayedInactive := Value;
  end;
end;

procedure TfrPreviewForm.RedrawAll(ResetPage: Boolean);
var
  i: Integer;
begin
  per := LastScale;
  mode := LastScaleMode;
  if mode = mdPageWidth then
    N1.Checked := True
  else if mode = mdOnePage then
    N2.Checked := True
  else if mode = mdTwoPages then
    N3.Checked := True
  else
    for i := 0 to ProcMenu.Items.Count - 1 do
      if ProcMenu.Items[i].Tag = per * 100 then
        ProcMenu.Items[i].Checked := True;

  if ResetPage then
  begin
    CurPage := 1;
    ofx := 0; ofy := 0; OldH := 0; OldV := 0;
    HScrollBar.Position := 0;
    VScrollBar.Position := 0;
  end;
  ShowPageNum;
  FormResize(nil);
  if EMFPages <> nil then
  begin
    for i := 0 to TfrEMFPages(EMFPages).Count - 1 do
    begin
      TfrEMFPages(EMFPages)[i].Visible := False;
      TfrEMFPages(EMFPages).Draw(i, Canvas, Rect(0, 0, 0, 0));
    end;
    N7.Enabled := TfrEMFPages(EMFPages).Count > 1;
  end;
  PBox.Repaint;
end;

procedure TfrPreviewForm.FormResize(Sender: TObject);
var
  i, j, y, d, nx, dwx, dwy, maxx, maxy, maxdy, curx: Integer;
  Pages: TfrEMFPages;
begin
  if EMFPages = nil then Exit;
  Pages := TfrEMFPages(EMFPages);
  PaintAllowed := False;
  with Pages[CurPage - 1].PrnInfo do
  begin
    dwx := Pgw; dwy := Pgh;
  end;
  case mode of
    mdNone:
      begin
        for i := 0 to ProcMenu.Items.Count - 1 do
          if ProcMenu.Items[i].Tag = Round(per * 100) then
            ProcMenu.Items[i].Checked := True;
      end;
    mdPageWidth:
      begin
        per := (PBox.Width - 20) / dwx;
        N1.Checked := True;
      end;
    mdOnePage:
      begin
        per := (PBox.Height - 20) / dwy;
        N2.Checked := True;
      end;
    mdTwoPages:
      begin
        per := (PBox.Width - 30) / (2 * dwx);
        N3.Checked := True;
      end;
  end;
  ZoomBtn.Caption := IntToStr(Round(per * 100)) + '%';
  nx := 0; maxx := 10; j := 0;
  for i := 0 to Pages.Count - 1 do
  begin
    d := maxx + 10 + Round(Pages[i].PrnInfo.Pgw * per);
    if d > PBox.Width then
    begin
      if nx < j then nx := j;
      j := 0;
      maxx := 10;
    end
    else
    begin
      maxx := d;
      Inc(j);
      if i = Pages.Count - 1 then
        if nx < j then nx := j;
    end;
  end;
  if nx = 0 then nx := 1;
  if mode = mdOnePage then nx := 1;
  if mode = mdTwoPages then nx := 2;
  y := 10;
  i := 0;
  maxx := 0; maxy := 0;
  while i < Pages.Count do
  begin
    j := 0; maxdy := 0; curx := 10;
    while (j < nx) and (i + j < Pages.Count) do
    begin
      dwx := Round(Pages[i + j].PrnInfo.Pgw * per);
      dwy := Round(Pages[i + j].PrnInfo.Pgh * per);
      if (nx = 1) and (dwx < PBox.Width) then
      begin
        d := (PBox.Width - dwx) div 2;
        Pages[i + j].r := Rect(d, y, d + dwx, y + dwy);
      end
      else
        Pages[i + j].r := Rect(curx, y, curx + dwx, y + dwy);
      if maxx < Pages[i + j].r.Right then
        maxx := Pages[i + j].r.Right;
      if maxy < Pages[i + j].r.Bottom then
        maxy := Pages[i + j].r.Bottom;
      Inc(j);
      if maxdy < dwy then maxdy := dwy;
      Inc(curx, dwx + 10);
    end;
    Inc(y, maxdy + 10);
    Inc(i, nx);
  end;
  PgDown.Top := RPanel.Height - 16;
  PgUp.Top := PgDown.Top - 16;
  VScrollBar.Height := PgUp.Top - 1;
  if RPanel.Visible then
    HScrollBar.Width := BPanel.Width - HScrollBar.Left - VScrollBar.Width else
    HScrollBar.Width := BPanel.Width - HScrollBar.Left;
  maxx := maxx - PBox.Width;
  maxy := maxy - PBox.Height;
  if maxx < 0 then maxx := 0 else Inc(maxx, 10);
  if maxy < 0 then maxy := 0 else Inc(maxy, 10);
  HScrollBar.Max := maxx; VScrollBar.Max := maxy;
  HScrollBar.Enabled := maxx <> 0;
  VScrollBar.Enabled := maxy <> 0;
  if Visible then
    ActiveControl := ScrollBox1;
  SetToCurPage;
  PaintAllowed := True;
end;

procedure TfrPreviewForm.SetToCurPage;
begin
  if EMFPages = nil then Exit;
  if ofy <> TfrEMFPages(EMFPages)[CurPage - 1].r.Top - 10 then
    VScrollBar.Position := TfrEMFPages(EMFPages)[CurPage - 1].r.Top - 10;
end;

procedure TfrPreviewForm.ShowPageNum;
begin
  if EMFPages = nil then
    Label1.Caption := ''
  else
  begin
    if Assigned(FOnPageChanged) then
      FOnPageChanged(Self);
    Label1.Caption := frLoadStr(SPg) + ' ' + IntToStr(CurPage) + '/' +
      IntToStr(TfrEMFPages(EMFPages).Count);
  end;
end;

procedure TfrPreviewForm.VScrollBarChange(Sender: TObject);
var
  i, p, pp: Integer;
  r: TRect;
  Pages: TfrEMFPages;
begin
  if EMFPages = nil then Exit;
  Pages := TfrEMFPages(EMFPages);
  p := VScrollBar.Position;
  pp := OldV - p;
  OldV := p;
  ofy := -p;
  r := Rect(0, 0, PBox.Width, PBox.Height);
  ScrollWindow(PBox.Handle, 0, pp, @r, @r);

  for i := 0 to Pages.Count-1 do
    if (Pages[i].r.Top < -ofy + 11) and
      (Pages[i].r.Bottom > -ofy + 11) then
    begin
      CurPage := i + 1;
      ShowPageNum;
      break;
    end;
end;

procedure TfrPreviewForm.HScrollBarChange(Sender: TObject);
var
  p, pp: Integer;
  r: TRect;
begin
  if EMFPages = nil then Exit;
  p := HScrollBar.Position;
  pp := OldH - p;
  OldH := p;
  ofx := -p;
  r := Rect(0, 0, PBox.Width, PBox.Height);
  ScrollWindow(PBox.Handle, pp, 0, @r, @r);
end;

procedure TfrPreviewForm.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if EMFPages = nil then Exit;
  if Key = vk_Up then
    VScrollBar.Position := VScrollBar.Position - VScrollBar.SmallChange
  else if Key = vk_Down then
    VScrollBar.Position := VScrollBar.Position + VScrollBar.SmallChange
  else if Key = vk_Left then
    HScrollBar.Position := HScrollBar.Position - HScrollBar.SmallChange
  else if Key = vk_Right then
    HScrollBar.Position := HScrollBar.Position + HScrollBar.SmallChange
  else if Key = vk_Prior then