rm_view.pas

进销存·完整的·有数据库的·非常完整·只得参考

  if FPreview.AutoScale then
    Exit;
  FDown := False;
  FDFlag := True;
  FPreview.EditPage(FPreview.CurPage - 1);
end;

{----------------------------------------------------------------------------}
{----------------------------------------------------------------------------}
{ TRMPreview}

constructor TRMPreview.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FCanModify := True;
  BevelInner := bvNone;
  BevelOuter := bvLowered;
  Caption := '';
  OnResize := OnResizeEvent;
  FParentForm := nil;

  FScrollBox := TScrollBox.Create(Self);
  with FScrollBox do
  begin
    Parent := Self;
    Caption := '';
    Align := alClient;
{$IFDEF Delphi4}
    OnMouseWheelUp := OnMouseWheelUpEvent;
    OnMouseWheelDown := OnMouseWheelDownEvent;
{$ENDIF}
  end;

  FRPanel := TPanel.Create(Self);
  with FRPanel do
  begin
    Parent := Self;
    Caption := '';
    Width := 16;
    Align := alRight;
    BevelOuter := bvNone;
  end;

  FVScrollBar := TScrollBar.Create(FRPanel);
  with FVScrollBar do
  begin
    Parent := FRPanel;
    Kind := sbVertical;
    Align := alTop;
    Ctl3D := True;
    LargeChange := 200;
    Max := 32000;
    ParentCtl3D := False;
    SmallChange := 10;
    OnChange := OnVScrollBarChange;
  end;

  FPgUp := TSpeedButton.Create(FRPanel);
  with FPgUp do
  begin
    Parent := FRPanel;
    Left := 0;
    Top := 184;
    Width := 16;
    Height := 16;
    Glyph.Handle := LoadBitmap(hInstance, 'PgUp');
    OnClick := OnPgUpClick;
  end;

  FPgDown := TSpeedButton.Create(FRPanel);
  with FPgDown do
  begin
    Parent := FRPanel;
    Left := 0;
    Top := 200;
    Width := 16;
    Height := 16;
    Glyph.Handle := LoadBitmap(hInstance, 'PgDn');
    OnClick := OnPgDnClick;
  end;

  FBPanel := TPanel.Create(Self);
  with FBPanel do
  begin
    Parent := Self;
    Caption := '';
    Height := 18;
    Align := alBottom;
    BevelOuter := bvNone;
  end;

  FBevel := TBevel.Create(FBPanel);
  with FBevel do
  begin
    Parent := FBPanel;
    Left := 0;
    Top := 1;
    Width := 77;
    Height := 17;
  end;

  FLabel := TLabel.Create(FBPanel);
  with FLabel do
  begin
    Parent := FBPanel;
    Left := 4;
    Top := 3;
    Width := 6;
    Height := 12;
  end;

  FHScrollBar := TScrollBar.Create(FBPanel);
  with FHScrollBar do
  begin
    Parent := FBPanel;
    Left := 80;
    Top := 1;
    Width := 329;
    Height := 16;
    Ctl3D := True;
    LargeChange := 200;
    Max := 32000;
    ParentCtl3D := False;
    SmallChange := 10;
    OnChange := OnHScrollBarChange;
  end;

  FPBox := TRMDrawPanel.Create(FScrollBox);
  with FPBox do
  begin
    Parent := FScrollBox;
    Caption := '';
    Align := alClient;
    BevelInner := bvNone;
    BevelOuter := bvNone;
    Color := clGray;
    FPreview := Self;
  end;

  FLastScale := 1;
  FLastScaleMode := mdNone;
  ScrollBars := ssBoth;
  FKWheel := 1;
  FOnPageChanged := nil;
  FOnStatusChange := nil;
end;

destructor TRMPreview.Destroy;
begin
  if FEMFPages <> nil then
    TRMEMFPages(FEMFPages).Free;
  FEMFPages := nil;
  FPBox.Free; FPBox := nil;

  inherited Destroy;
end;

function TRMPreview.CanModify: Boolean;
begin
  Result := FCanModify and (RMDesignerClass <> nil) and (Assigned(FDoc) and TRMReport(Doc).ModifyPrepared);
end;

procedure TRMPreview.Connect_1(aDoc: TObject);
begin
  FDoc := ADoc;
  if FEMFPages <> nil then
  begin
    TRMEMFPages(FEMFPages).Free;
    FEMFPages := nil;
  end;

  FEMFPages := TRMReport(FDoc).EMFPages;
  TRMReport(FDoc).EMFPages := TRMEMFPages.Create(TRMReport(FDoc));
end;

{$HINTS OFF}

procedure TRMPreview.Connect(aDoc: TObject);
begin
  Connect_1(aDoc);
  case TRMReport(FDoc).InitialZoom of
    pzDefault:
      begin
        FPer := 1;
        FLastScaleMode := mdNone;
      end;
    pzPageWidth: FLastScaleMode := mdPageWidth;
    pzOnePage: FLastScaleMode := mdOnePage;
    pzTwoPages: FLastScaleMode := mdTwoPages;
  end;

  CurPage := 1;
  RedrawAll(TRUE);
{$IFDEF Delphi4}
  if FParentForm <> nil then
  begin
    FParentForm.OnMouseWheelUp := OnMouseWheelUpEvent;
    FParentForm.OnMouseWheelDown := OnMouseWheelDownEvent;
//	  FKWheel := 3;
  end;
{$ENDIF}
end;
{$HINTS ON}

procedure TRMPreview.Disconnect;
begin
  ConnectBack;
end;

procedure TRMPreview.DoStatusChange;
begin
  if Assigned(FOnStatusChange) then
    FOnStatusChange(Self);
end;

procedure TRMPreview.SetToCurPage;
begin
  if FEMFPages = nil then
    Exit;
  if Fofy <> TRMEMFPages(FEMFPages)[FCurPage - 1].r.Top - 10 then
    FVScrollBar.Position := TRMEMFPages(FEMFPages)[FCurPage - 1].r.Top - 10;
end;

procedure TRMPreview.ShowPageNum;
begin
  if FEMFPages = nil then
    FLabel.Caption := ''
  else
  begin
    if Assigned(FOnPageChanged) then
      FOnPageChanged(Self);
    FLabel.Caption := RMLoadStr(SPg) + ' ' + IntToStr(FCurPage) + '/' +
      IntToStr(TRMEMFPages(FEMFPages).Count);
  end;
end;

procedure TRMPreview.LoadFromFile(aFileName: string);
begin
  if (FEMFPages = nil) or (FDoc = nil) then
    Exit;
  TRMEMFPages(FEMFPages).Free;
  FEMFPages := nil;
  TRMReport(FDoc).LoadPreparedReport(aFileName);
  Connect_1(FDoc);
  FCurPage := 1;
  OnResizeEvent(nil);
  FPaintAllowed := False;
  if TRMEMFPages(FEMFPages).Count > 0 then
  begin
    ShowPageNum;
    SetToCurPage;
  end;
  FPaintAllowed := True;
  FPBox.Repaint;
end;

procedure TRMPreview.LoadFromFiles(aFileNames: TStrings);
var
  i: Integer;

  procedure _AppendReport(const aFileName: string; aEMFPages: TRMEMFPages);
  var
    lStream: TFileStream;
  begin
		if not FileExists(aFileName) then Exit;
    lStream := TFileStream.Create(aFileName, fmOpenRead);
    try
      aEMFPages.AppendFromStream(lStream);
    finally
      lStream.Free;
    end;
  end;

begin
  if (FEMFPages = nil) or (FDoc = nil) then
    Exit;
  TRMEMFPages(FEMFPages).Free;
  FEMFPages := nil;
  for i := 0 to aFileNames.Count - 1 do
  begin
    if i = 0 then
      TRMReport(FDoc).LoadPreparedReport(aFileNames[i])
    else
      _AppendReport(aFileNames[i], TRMReport(FDoc).EMFPages);
  end;
  Connect_1(FDoc);
  FCurPage := 1;
  OnResizeEvent(nil);
  FPaintAllowed := False;
  if TRMEMFPages(FEMFPages).Count > 0 then
  begin
    ShowPageNum;
    SetToCurPage;
  end;
  FPaintAllowed := True;
  FPBox.Repaint;
end;

procedure TRMPreview.SaveToFile(aFileName: string; aIndex: Integer);
begin
  if FEMFPages = nil then
    Exit;

  if aIndex < 2 then
  begin
    if FDoc = nil then
      Exit;
    aFileName := ChangeFileExt(aFileName, '.rmp');
    ConnectBack;
    TRMReport(FDoc).SavePreparedReport(aFileName);
    Connect_1(FDoc);
  end
  else //export输出
  begin
    ConnectBack;
    TRMReport(Doc).ExportTo(TRMExportFilter(RMFilters(aIndex - 2).Filter),
      ChangeFileExt(aFileName, Copy(RMFilters(aIndex - 2).FilterExt, 2, 255)));
    Connect_1(FDoc);
    RedrawAll(False);
  end;
end;

procedure TRMPreview.ExportToFile(aExport: TComponent; aFileName: string);
begin
  if FEMFPages = nil then
    Exit;

  ConnectBack;
  TRMReport(Doc).ExportTo(TRMExportFilter(aExport), aFileName);
  Connect_1(FDoc);
  RedrawAll(False);
end;

procedure TRMPreview.OnResizeEvent(Sender: TObject);
var
  i, j, y, d, nx, dwx, dwy, maxx, maxy, maxdy, curx: Integer;
  Pages: TRMEMFPages;
begin
  FPgDown.Top := FRPanel.Height - 16;
  FPgUp.Top := FPgDown.Top - 16;
  FVScrollBar.Height := FPgUp.Top - 1;
//  FVScrollBar.Left := 0;
  if FRPanel.Visible then
    FHScrollBar.Width := FBPanel.Width - FHScrollBar.Left - FVScrollBar.Width
  else
    FHScrollBar.Width := FBPanel.Width - FHScrollBar.Left;

  if FEMFPages = nil then
    Exit;
  Pages := TRMEMFPages(FEMFPages);
  FPaintAllowed := False;
  if Pages.Count < 1 then
    Exit;
  with Pages[FCurPage - 1].PrnInfo do
  begin
    dwx := Pgw; dwy := Pgh;
  end;
  case Fmode of
    mdNone: ;
    mdPageWidth: Fper := (FPBox.Width - 20) / dwx;
    mdOnePage: Fper := (FPBox.Height - 20) / dwy;
    mdTwoPages: Fper := (FPBox.Width - 30) / (2 * dwx);
  end;

  nx := 0; maxx := 10; j := 0;
  for i := 0 to Pages.Count - 1 do
  begin
    d := maxx + 10 + Round(Pages[i].PrnInfo.Pgw * Fper);
    if d > FPBox.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
      begin
        if nx < j then
          nx := j;
      end;
    end;
  end;
  if nx = 0 then
    nx := 1;
  if Fmode = mdOnePage then
    nx := 1;
  if Fmode = 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 * Fper);
      dwy := Round(Pages[i + j].PrnInfo.Pgh * Fper);
      if (nx = 1) and (dwx < FPBox.Width) then
      begin
        d := (FPBox.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;

  maxx := maxx - FPBox.Width;
  maxy := maxy - FPBox.Height;
  if maxx < 0 then
    maxx := 0
  else
    Inc(maxx, 10);
  if maxy < 0 then
    maxy := 0
  else
    Inc(maxy, 10);
  FHScrollBar.Max := maxx; FVScrollBar.Max := maxy;
  FHScrollBar.Enabled := maxx <> 0;
  FVScrollBar.Enabled := maxy <> 0;
  SetToCurPage;
  FPaintAllowed := True;
  DoStatusChange;
end;

procedure TRMPreview.RedrawAll(ResetPage: Boolean);
var
  i: Integer;
begin
  Fper := FLastScale;
  Fmode := FLastScaleMode;

  if ResetPage then
  begin
    FCurPage := 1;
    Fofx := 0; Fofy := 0; FOldH := 0; FOldV := 0;
    FHScrollBar.Position := 0;
    FVScrollBar.Position := 0;
  end;
  ShowPageNum;
  OnResizeEvent(nil);
  if FEMFPages <> nil then
  begin
    for i := 0 to TRMEMFPages(FEMFPages).Count - 1 do
    begin
      TRMEMFPages(FEMFPages)[i].Visible := False;
      TRMEMFPages(FEMFPages).Draw(i, Canvas, Rect(0, 0, 0, 0));
    end;
  end;
  FPBox.Repaint;
end;

procedure TRMPreview.OnVScrollBarChange(Sender: TObject);
var
  i, p, pp: Integer;
  r: TRect;
  Pages: TRMEMFPages;
begin
  if FEMFPages = nil then
    Exit;
  Pages := TRMEMFPages(FEMFPages);
  p := FVScrollBar.Position;
  pp := FOldV - p;
  FOldV := p;
  Fofy := -p;
  r := Rect(0, 0, FPBox.Width, FPBox.Height);
  ScrollWindow(FPBox.Handle, 0, pp, @r, @r);

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

procedure TRMPreview.OnHScrollBarChange(Sender: TObject);
var
  p, pp: Integer;
  r: TRect;
begin
  if FEMFPages = nil then
    Exit;
  p := FHScrollBar.Position;
  pp := FOldH - p;
  FOldH := p;
  Fofx := -p;
  r := Rect(0, 0, FPBox.Width, FPBox.Height);
  ScrollWindow(FPBox.Handle, pp, 0, @r, @r);
end;

procedure TRMPreview.ConnectBack;
begin
  TRMReport(FDoc).EMFPages.Free;
  TRMReport(FDoc).EMFPages := TRMEMFPages(FEMFPages);
  FEMFPages := nil;
end;

procedure TRMPreview.SetPage(Value: Integer);
begin
  if Value < 1 then
    Value := 1;
  if Value > AllPages then
    Value := AllPages;
  FCurPage := Value;