fr_view.pas

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

    if ssCtrl in Shift then
      PgUpClick(nil) else
      VScrollBar.Position := VScrollBar.Position - VScrollBar.LargeChange
  else if Key = vk_Next then
    if ssCtrl in Shift then
      PgDownClick(nil) else
      VScrollBar.Position := VScrollBar.Position + VScrollBar.LargeChange
  else if Key = vk_Space then
    ZoomBtnClick(nil)
  else if Key = vk_Escape then
    ExitBtnClick(nil)
  else if Key = vk_Home then
    if ssCtrl in Shift then
      VScrollBar.Position := 0 else
      Exit
  else if Key = vk_End then
    if ssCtrl in Shift then
    begin
      CurPage := TfrEMFPages(EMFPages).Count;
      SetToCurPage;
    end
    else Exit
  else if ssCtrl in Shift then
  begin
    if Chr(Key) = 'O' then LoadBtnClick(nil)
    else if Chr(Key) = 'S' then SaveBtnClick(nil)
    else if (Chr(Key) = 'P') and PrintBtn.Enabled then PrintBtnClick(nil)
    else if Chr(Key) = 'F' then FindBtnClick(nil)
    else if (Chr(Key) = 'E') and N5.Visible then EditBtnClick(nil)
  end
  else if Key = vk_F3 then
  begin
    if FindStr <> '' then
    begin
      if LastFoundPage <> CurPage - 1 then
      begin
        LastFoundPage := CurPage - 1;
        LastFoundObject := 0;
      end;
      FindText;
    end;
  end
  else Exit;
  Key := 0;
end;

procedure TfrPreviewForm.PgUpClick(Sender: TObject);
begin
  if CurPage > 1 then Dec(CurPage);
  ShowPageNum;
  SetToCurPage;
end;

procedure TfrPreviewForm.PgDownClick(Sender: TObject);
begin
  if EMFPages = nil then Exit;
  if CurPage < TfrEMFPages(EMFPages).Count then Inc(CurPage);
  ShowPageNum;
  SetToCurPage;
end;

procedure TfrPreviewForm.ZoomBtnClick(Sender: TObject);
var
  pt: TPoint;
begin
  pt := ZoomBtn.ClientToScreen(Point(ZoomBtn.Left, ZoomBtn.Top + ZoomBtn.Height));
  N4.Visible := False;
  N5.Visible := False;
  N6.Visible := False;
  N7.Visible := False;
  ProcMenu.Popup(pt.x, pt.y);
end;

procedure TfrPreviewForm.N3Click(Sender: TObject);
begin
  if EMFPages = nil then Exit;
  ofx := 0;
  with Sender as TMenuItem do
  begin
    case Tag of
      1: mode := mdPageWidth;
      2: mode := mdOnePage;
      3: mode := mdTwoPages;
    else
      begin
        mode := mdNone;
        per := Tag / 100;
      end;
    end;
    Checked := True;
  end;
  HScrollBar.Position := 0;
  FormResize(nil);
  LastScale := per;
  LastScaleMode := mode;
  PBox.Repaint;
end;

procedure TfrPreviewForm.LoadBtnClick(Sender: TObject);
begin
  if EMFPages = nil then Exit;
  OpenDialog.Filter := frLoadStr(SRepFile) + ' (*.frp)|*.frp';
  with OpenDialog do
   if Execute then
     LoadFromFile(FileName);
end;

procedure TfrPreviewForm.SaveBtnClick(Sender: TObject);
var
  i, n: Integer;
  s: String;
begin
  if EMFPages = nil then Exit;
  s := frLoadStr(SRepFile) + ' (*.frp)|*.frp';
  for i := 0 to frFiltersCount - 1 do
    s := s + '|' + frFilters[i].FilterDesc + '|' + frFilters[i].FilterExt;
  n := 1;
  for i := 0 to frFiltersCount - 1 do
    if frFilters[i].Filter.Default then
    begin
      n := i + 2;
      break;
    end;
  with SaveDialog do
  begin
    Filter := s;
    FilterIndex := n;
    if Execute then
      if FilterIndex = 1 then
        SaveToFile(FileName)
      else
      begin
        ConnectBack;
        TfrReport(Doc).ExportTo(frFilters[FilterIndex - 2].Filter,
          ChangeFileExt(FileName, Copy(frFilters[FilterIndex - 2].FilterExt, 2, 255)));
        Connect(Doc);
        RedrawAll(False);
      end;
  end;
end;

procedure TfrPreviewForm.PrintBtnClick(Sender: TObject);
var
  Pages: String;
begin
  if (EMFPages = nil) or (Printer.Printers.Count = 0) then Exit;
  with TfrPrintForm.Create(nil) do
  begin
    E1.Text := IntToStr(TfrReport(Doc).DefaultCopies);
    CollateCB.Checked := TfrReport(Doc).DefaultCollate;
    if not TfrReport(Doc).ShowPrintDialog or (ShowModal = mrOk) then
    begin
{      if Printer.PrinterIndex <> ind then
        if TfrReport(Doc).CanRebuild then
          if TfrReport(Doc).ChangePrinter(ind, Printer.PrinterIndex) then
          begin
            TfrEMFPages(EMFPages).Free;
            EMFPages := nil;
            TfrReport(Doc).PrepareReport;
            Connect(Doc);
          end
          else
          begin
            Free;
            Exit;
          end;}
      if RB1.Checked then
        Pages := ''
      else if RB2.Checked then
        Pages := IntToStr(CurPage)
      else
        Pages := E2.Text;
      ConnectBack;
      TfrReport(Doc).PrintPreparedReport(Pages, StrToInt(E1.Text),
        CollateCB.Checked, TfrPrintPages(CB2.ItemIndex));
      Connect(Doc);
      RedrawAll(False);
    end;
    Free;
  end;
end;

procedure TfrPreviewForm.ExitBtnClick(Sender: TObject);
begin
  if Doc = nil then Exit;
  if TfrReport(Doc).ModalPreview then
    ModalResult := mrOk else
    Close;
end;

procedure TfrPreviewForm.LoadFromFile(name: String);
begin
  if Doc = nil then Exit;
  TfrEMFPages(EMFPages).Free;
  EMFPages := nil;
  TfrReport(Doc).LoadPreparedReport(name);
  Connect(Doc);
  CurPage := 1;
  FormResize(nil);
  PaintAllowed := False;
  ShowPageNum;
  SetToCurPage;
  PaintAllowed := True;
  PBox.Repaint;
end;

procedure TfrPreviewForm.SaveToFile(name:String);
begin
  if Doc = nil then Exit;
  name := ChangeFileExt(name, '.frp');
  ConnectBack;
  TfrReport(Doc).SavePreparedReport(name);
  Connect(Doc);
end;


function EnumEMFRecordsProc(DC: HDC; HandleTable: PHandleTable;
  EMFRecord: PEnhMetaRecord; nObj: Integer; OptData: Pointer): Bool; stdcall;
var
  Typ: Byte;
  s: String;
  t: TEMRExtTextOut;
begin
  Result := True;
  Typ := EMFRecord^.iType;
  if Typ in [83, 84] then
  begin
    t := PEMRExtTextOut(EMFRecord)^;
    s := WideCharLenToString(PWideChar(PChar(EMFRecord) + t.EMRText.offString),
      t.EMRText.nChars);
    if not CurPreview.CaseSensitive then s := AnsiUpperCase(s);
    CurPreview.StrFound := Pos(CurPreview.FindStr, s) <> 0;
    if CurPreview.StrFound and (RecordNum >= CurPreview.LastFoundObject) then
    begin
      CurPreview.StrBounds := t.rclBounds;
      Result := False;
    end;
  end;
  Inc(RecordNum);
end;

procedure TfrPreviewForm.FindInEMF(emf: TMetafile);
begin
  CurPreview := Self;
  RecordNum := 0;
  EnumEnhMetafile(0, emf.Handle, @EnumEMFRecordsProc, nil, Rect(0, 0, 0, 0));
end;

procedure TfrPreviewForm.FindText;
var
  EMF: TMetafile;
  EMFCanvas: TMetafileCanvas;
  PageInfo: PfrPageInfo;
  i, nx, ny, ndx, ndy: Integer;
begin
  PaintAllowed := False;
  StrFound := False;
  while LastFoundPage < TfrEMFPages(EMFPages).Count do
  begin
    PageInfo := TfrEMFPages(EMFPages)[LastFoundPage];
    EMF := TMetafile.Create;
    EMF.Width := PageInfo.PrnInfo.PgW;
    EMF.Height := PageInfo.PrnInfo.PgH;
    EMFCanvas := TMetafileCanvas.Create(EMF, 0);
    PageInfo.Visible := True;
    TfrEMFPages(EMFPages).Draw(LastFoundPage, EMFCanvas,
      Rect(0, 0, PageInfo.PrnInfo.PgW, PageInfo.PrnInfo.PgH));
    EMFCanvas.Free;

    FindInEMF(EMF);
    EMF.Free;
    if StrFound then
    begin
      CurPage := LastFoundPage + 1;
      ShowPageNum;
      nx := PageInfo.r.Left + Round(StrBounds.Left * per);
      ny := Round(StrBounds.Top * per) + 10;
      ndx := Round((StrBounds.Right - StrBounds.Left) * per);
      ndy := Round((StrBounds.Bottom - StrBounds.Top) * per);

      if ny > PBox.Height - ndy then
      begin
        VScrollBar.Position := PageInfo.r.Top + ny - PBox.Height - 10 + ndy;
        ny := PBox.Height - ndy;
      end
      else
        VScrollBar.Position := PageInfo.r.Top - 10;

      if nx > PBox.Width - ndx then
      begin
        HScrollBar.Position := PageInfo.r.Left + nx - PBox.Width - 10 + ndx;
        nx := PBox.Width - ndx;
      end
      else
        HScrollBar.Position := PageInfo.r.Left - 10;

      LastFoundObject := RecordNum;
      Application.ProcessMessages;

      PaintAllowed := True;
      PBox.Paint;
      with PBox.Canvas do
      begin
        Pen.Width := 1;
        Pen.Mode := pmXor;
        Pen.Color := clWhite;
        for i := 0 to ndy do
        begin
          MoveTo(nx, ny + i);
          LineTo(nx + ndx, ny + i);
        end;
        Pen.Mode := pmCopy;
      end;
      break;
    end
    else
    begin
      PageInfo.Visible := False;
      TfrEMFPages(EMFPages).Draw(LastFoundPage, EMFCanvas,
        Rect(0, 0, PageInfo.PrnInfo.PgW, PageInfo.PrnInfo.PgH));
    end;
    LastFoundObject := 0;
    Inc(LastFoundPage);
  end;
  PaintAllowed := True;
end;

procedure TfrPreviewForm.FindBtnClick(Sender: TObject);
var
  p: TfrPreviewSearchForm;
begin
  if Doc = nil then Exit;
  p := TfrPreviewSearchForm.Create(nil);
  with p do
  if ShowModal = mrOk then
  begin
    FindStr := Edit1.Text;
    CaseSensitive := CB1.Checked;
    if not CaseSensitive then FindStr := AnsiUpperCase(FindStr);
    if RB1.Checked then
    begin
      LastFoundPage := 0;
      LastFoundObject := 0;
    end
    else if LastFoundPage <> CurPage - 1 then
    begin
      LastFoundPage := CurPage - 1;
      LastFoundObject := 0;
    end;
    Free;
    FindText;
  end;
end;

procedure TfrPreviewForm.EditBtnClick(Sender: TObject);
begin
  if (Doc = nil) or not TfrReport(Doc).ModifyPrepared then Exit;
  ConnectBack;
  TfrReport(Doc).EditPreparedReport(CurPage - 1);
  Connect(Doc);
  RedrawAll(False);
end;

procedure TfrPreviewForm.DelPageBtnClick(Sender: TObject);
begin
  if Doc = nil then Exit;
  if TfrEMFPages(EMFPages).Count > 1 then
    if MessageBox(Handle, PChar(frLoadStr(SRemovePg)), PChar(frLoadStr(SConfirm)),
      mb_YesNo + mb_IconQuestion) = mrYes then
    begin
      TfrEMFPages(EMFPages).Delete(CurPage - 1);
      RedrawAll(True);
    end;
end;

procedure TfrPreviewForm.NewPageBtnClick(Sender: TObject);
begin
  if Doc = nil then Exit;
  TfrEMFPages(EMFPages).Insert(CurPage - 1, TfrReport(Doc).Pages[0]);
  RedrawAll(False);
end;

procedure TfrPreviewForm.PageSetupBtnClick(Sender: TObject);
var
  psd: TPageSetupDlg;
  pg: PfrPageInfo;
  pg1: TfrPage;
  i: Integer;

  procedure SetPrinter(DeviceMode, DeviceNames: THandle);
  var
    DevNames: PDevNames;
  begin
    DevNames := PDevNames(GlobalLock(DeviceNames));
    try
      with DevNames^ do
        Printer.SetPrinter(PChar(DevNames) + wDeviceOffset,
          PChar(DevNames) + wDriverOffset,
          PChar(DevNames) + wOutputOffset, DeviceMode);
    finally
      GlobalUnlock(DeviceNames);
      GlobalFree(DeviceNames);
    end;
  end;

begin
  if EMFPages = nil then Exit;
  psd.lStructSize := SizeOf(TPageSetupDlg);
  psd.hwndOwner := ScrollBox1.Handle;
  psd.hDevMode := prn.DevMode;
  psd.hDevNames := 0;
  psd.Flags := PSD_DEFAULTMINMARGINS or PSD_MARGINS or PSD_INHUNDREDTHSOFMILLIMETERS;

  pg := TfrEMFPages(EMFPages)[0];
  psd.rtMargin.Left := pg^.pgMargins.Left * 500 div 18;
  psd.rtMargin.Top := pg^.pgMargins.Top * 500 div 18;
  psd.rtMargin.Right := pg^.pgMargins.Right * 500 div 18;
  psd.rtMargin.Bottom := pg^.pgMargins.Bottom * 500 div 18;

  if PageSetupDlg(psd) then
  begin
    SetPrinter(psd.hDevMode, psd.hDevNames);
    Prn.Update;

    for i := 0 to TfrReport(Doc).Pages.Count - 1 do
    begin
      pg1 := TfrReport(Doc).Pages[i];
      if pg1.PageType = ptReport then
      begin
        pg1.pgMargins.Left := psd.rtMargin.Left * 18 div 500;
        pg1.pgMargins.Top := psd.rtMargin.Top * 18 div 500;
        pg1.pgMargins.Right := psd.rtMargin.Right * 18 div 500;
        pg1.pgMargins.Bottom := psd.rtMargin.Bottom * 18 div 500;
        pg1.ChangePaper(Prn.PaperSize, 0, 0, Prn.Bin, Prn.Orientation);
      end;
    end;

    TfrReport(Doc).PrepareReport;
    TfrEMFPages(EMFPages).Free;
    EMFPages := nil;
    Connect(Doc);
    RedrawAll(True);
  end;
end;

type
  THackBtn = class(TfrSpeedButton)
  end;

procedure TfrPreviewForm.HelpBtnClick(Sender: TObject);
begin
  Screen.Cursor := crHelp;
  SetCapture(Handle);
  THackBtn(HelpBtn).FMouseInControl := False;
  HelpBtn.Invalidate;
end;

procedure TfrPreviewForm.FormMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  c: TControl;
begin
  HelpBtn.Down := False;
  Screen.Cursor := crDefault;
  c := frControlAtPos(Self, Point(X, Y));
  if (c <> nil) and (c <> HelpBtn) then
    Application.HelpCommand(HELP_CONTEXTPOPUP, c.Tag);
end;

{$IFDEF Delphi4}
procedure TfrPreviewForm.FormMouseWheelUp(Sender: TObject;
  Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
begin
  VScrollBar.Position := VScrollBar.Position - VScrollBar.SmallChange * KWheel;
end;

procedure TfrPreviewForm.FormMouseWheelDown(Sender: TObject;
  Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
begin
  VScrollBar.Position := VScrollBar.Position + VScrollBar.SmallChange * KWheel;
end;
{$ENDIF}

procedure TfrPreviewForm.HScrollBarEnter(Sender: TObject);
begin
  ActiveControl := ScrollBox1;
end;

procedure TfrPreviewForm.CMDialogKey(var Message: TCMDialogKey);
begin
// empty method
end;


end.