previewform.pas

delphi制作表格的控件

      Pen.Color := clGray;
      Brush.Color := clGray;
      Rectangle(4, 4, Width, Height);
      Pen.Color := clBlack;
      Brush.Color := clWhite;
      Rectangle(0, 0, Width - 4, Height - 4);
      Offset := 0;
    end;

    // 画边缘折线
    Pen.Color := clSilver;
    Edge := Round(25 * FZoom / 100);
    with FBox.CommonPageInfo do
    begin
      X := Round((Margin.Left + Offset) * FZoom / 100);
      Y := Round((Margin.Top + Offset) * FZoom / 100);
      PolyLine([Point(X - Edge, Y), Point(X, Y), Point(X, Y - Edge)]);
      X := Round((FPageWidth - Margin.Right + Offset) * FZoom / 100);
      PolyLine([Point(X + Edge, Y), Point(X, Y), Point(X, Y - Edge)]);
      Y := Round((FPageHeight - Margin.Bottom + Offset) * FZoom / 100);
      PolyLine([Point(X + Edge, Y), Point(X, Y), Point(X, Y + Edge)]);
      X := Round((Margin.Left + Offset) * FZoom / 100);
      PolyLine([Point(X - Edge, Y), Point(X, Y), Point(X, Y + Edge)]);
      Pen.Color := clBlack;
      DrawRect := Rect(Margin.Left + Offset, Margin.Top + Offset,
                       FPageWidth - Margin.Right + Offset + 1,
                       FPageHeight - Margin.Bottom + Offset + 1);
    end;

    // 设置映射模式  MM_ANISOTROPIC ( 忽略 Scale 参数 )
    if (FBox.State = pbZoomIn) then NewZoom := 100 else NewZoom := FZoom;
    OldMapMode := SetMapMode(Handle, MM_ANISOTROPIC);
    SetWindowExtEx(Handle,100,100,@OldWindowExtent);
    SetViewPortExtEx(Handle, NewZoom, NewZoom, @OldViewPortExtent);
    // 画页眉、页脚、标题、结尾信息
    FBox.DrawPage(Canvas, DrawRect, FPageIndex, False);
    // 恢复映像模式
    SetViewPortExtEx(Handle,OldViewPortExtent.cx,OldViewPortExtent.cy,nil);
    SetWindowExtEx(Handle,OldWindowExtent.cx,OldWindowExtent.cy,nil);
    SetMapMode(Handle, OldMapMode);

    // 设置映射模式  MM_ANISOTROPIC ( 加入 Scale 参数 )
    if (FBox.State = pbZoomIn) then
      NewZoom := FBox.CommonPageInfo.Scale
    else
      NewZoom := Round(FZoom * FBox.CommonPageInfo.Scale / 100);
    OldMapMode := SetMapMode(Handle, MM_ANISOTROPIC);
    SetWindowExtEx(Handle,100,100,@OldWindowExtent);
    SetViewPortExtEx(Handle, NewZoom, NewZoom, @OldViewPortExtent);
    // 执行自定义绘画过程
    if Assigned(FBox.FOnDrawPage) then
      FBox.FOnDrawPage(Canvas, DrawRect, FPageIndex, False);
    // 恢复映像模式
    SetViewPortExtEx(Handle,OldViewPortExtent.cx,OldViewPortExtent.cy,nil);
    SetWindowExtEx(Handle,OldWindowExtent.cx,OldWindowExtent.cy,nil);
    SetMapMode(Handle, OldMapMode);
  end;
end;

procedure TPage.SetPageHeight(Value: Integer);
begin
  if Value = FPageHeight then Exit;
  FPageHeight := Value;
  Height := Round(Value * Zoom / 100) + 4;
  Invalidate;
end;

procedure TPage.SetPageWidth(Value: Integer);
begin
  if Value = FPageWidth then Exit;
  FPageWidth := Value;
  Width := Round(Value * Zoom / 100) + 4;
  Invalidate;
end;

procedure TPage.SetZoom(Value: Integer);
begin
  if Value = FZoom then Exit;
  FZoom := Value;
  Height := Round(Value * FPageHeight / 100) + 4;
  Width := Round(Value * FPageWidth / 100) + 4;
  Invalidate;
end;

procedure TPage.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  if FBox.State = pbZoomIn then Exit;
  if (FBox.PageIndex = FPageIndex) then
    FBox.State := pbZoomOut
  else
    FBox.State := pbSelect;
end;

procedure TPage.WMSetCursor(var Msg: TWMSetCursor);
var
  Cur: HCURSOR;
begin
  Cur := Screen.Cursors[crArrow];
  case FBox.State of
    pbSelect : Cur := Screen.Cursors[crHandPoint];
    pbZoomOut: Cur := Screen.Cursors[crZoomIn];
    pbZoomIn : Cur := Screen.Cursors[crZoomOut];
  end;
  if Cur <> 0 then SetCursor(Cur) else inherited;
end;

procedure TPage.CMMouseLeave(var Msg: TMessage);
begin
  if FBox.State = pbZoomIn then Exit;
  FBox.State := pbSelect;
end;

//TPreviewForm

const
  PageSepWidth = 3;
  EdgeWidth = 25;

constructor TPreviewForm.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FCommonPageInfo := TCommonPageInfo.Create;
  TabStop := True;
  VertScrollBar.Style := ssFlat;
  VertScrollBar.Tracking := True;
  HorzScrollBar.Style := ssFlat;
  HorzScrollBar.Tracking := True;
  Width := 300;
  Height := 300;
  FState := pbSelect;
  FPageIndex := 0;
  FZoom := 20;
  PageCount := 1;
end;

destructor TPreviewForm.Destroy;
var
  i: Integer;
begin
  for i := 0 to FPageCount - 1 do FPages[i].Free;
  inherited Destroy;
end;

procedure TPreviewForm.SetZoom(Value: Integer);
var
  i: Integer;
begin
  if Value < 10 then Value := 10;
  if Value > 100 then Value := 100;
  for i:=0 to FPageCount-1 do
    FPages[i].Zoom := Value;
  FZoom := Value;
  AdjustPages;
end;

procedure TPreviewForm.SetPageCount(Value: Integer);
var
  i: Integer;
begin
  FInitializing := True;
  if FPageCount = Value then Exit;
  if Value < 1 then Value := 1;
  for i := FPageCount - 1 downto Value do
    FPages[i].Free;
  SetLength(FPages, Value);
  for i := FPageCount to Value - 1 do
  begin
    FPages[i] := TPage.Create(Self);
    with FPages[i] do
    begin
      Parent := Self;
      Visible := True;
      Box := Self;
      FPageIndex := i;
      Zoom := Self.Zoom;
    end;
  end;
  FPageCount := Value; FPageIndex := 0;
  FInitializing := False;
  RefreshPages;
end;

procedure TPreviewForm.SetPageIndex(Value: Integer);
var
  APage: TPage;
begin
  if Value >= FPageCount then Value := FPageCount - 1;
  if Value < 0 then Value := 0;
  FPages[FPageIndex].Invalidate;
  FPageIndex := Value;
  FPages[FPageIndex].Invalidate;
  APage := FPages[FPageIndex];
  if (not (FState = pbZoomIn)) and
     (APage.Top >= 0) and (APage.Left >= 0) and
     (APage.Top + APage.Height <= Height) and (APage.Left + APage.Width <= Width) then Exit;
  AdjustPages;
end;

procedure TPreviewForm.CNKeyDown(var Message: TWMKeyDown);
begin
  if Message.CharCode in [VK_PRIOR..VK_DOWN] then Exit;
  inherited;
end;

procedure TPreviewForm.WMSize(var Message: TWMSize);
begin
  inherited;
  if not HandleAllocated or FInitializing then Exit;
  AdjustPages;
end;

procedure TPreviewForm.AdjustPages;
var
  i, VIndex, HCount, VCount, LeftPos, TopPos, RealWidth, RealHeight: Integer;
  PageLeftPos, PageTopPos, PreHPosition: Integer;
begin
  if PageCount = 0 then Exit;
  // 记住原来的滚动条位置
  PreHPosition := HorzScrollBar.Position;
  // 在调整之前把滚动条位置设为 0
  if HorzScrollBar.Range > 0 then
    HorzScrollBar.Position := 0;
  if VertScrollBar.Range > 0 then
    VertScrollBar.Position := 0;
  if FState = pbZoomIn then
  begin
    FPages[FPageIndex].Zoom := 100;
    if Width > FPages[FPageIndex].Width then
      FPages[FPageIndex].Left := (Width - FPages[FPageIndex].Width) div 2
    else
      FPages[FPageIndex].Left := HPageSpace;
    FPages[FPageIndex].Top := VPageSpace;
    FPages[FPageIndex].Visible := True;
    for i:=0 to FPageCount-1 do
      if i <> FPageIndex then FPages[i].Visible := False;
    // 恢复原来的滚动条位置
    if HorzScrollBar.Range > 0 then
      HorzScrollBar.Position := Round(HorzScrollBar.Range * FPages[FPageIndex].FMousePos.x / FPages[FPageIndex].Width);
    if VertScrollBar.Range > 0 then
      VertScrollBar.Position := Round(VertScrollBar.Range * FPages[FPageIndex].FMousePos.y / FPages[FPageIndex].Height);
    Exit;
  end;
  for i:=0 to FPageCount-1 do FPages[i].Visible := True;
  RealWidth := FPages[0].Width + HPageSpace;
  RealHeight := FPages[0].Height + VPageSpace;
  HCount := Trunc((Width-HPageSpace) / RealWidth);
  if HCount < 1 then HCount := 1;
  if FPageCount = 1 then HCount := 1;
  VCount := Round(FPageCount / HCount) + 1;
  VIndex := FPageIndex div HCount ;
  if (FPageCount mod HCount) = 0 then Dec(VCount);
  i := 0;
  LeftPos := HPageSpace;
  TopPos := VPageSpace;
  if (HCount = 1) and (Width > FPages[0].Width) then
    LeftPos := (Width - FPages[0].Width) div 2;
  if (VCount = 1) and (Height > FPages[0].Height) then
    TopPos := (Height - FPages[0].Height) div 2;
  PageLeftPos := LeftPos; PageTopPos := TopPos;
  while i < FPageCount do
  begin
    FPages[i].Left := PageLeftPos;
    FPages[i].Top := PageTopPos;
    Inc(i);
    Inc(PageLeftPos, RealWidth);
    if (i mod HCount) = 0 then
    begin
      PageLeftPos := LeftPos;
      Inc(PageTopPos, RealHeight);
    end;
  end;
  // 恢复滚动条位置
  if HorzScrollBar.Range > 0 then
    HorzScrollBar.Position := Max(HorzScrollBar.Position, PreHPosition);
  if VertScrollBar.Range > 0 then
    VertScrollBar.Position := Round(VertScrollBar.Range * VIndex / VCount);
end;

procedure TPreviewForm.DrawPage(DrawCanvas: TCanvas; DrawRect: TRect;
  PageIndex: Integer; Printing: Boolean);
begin
  DrawHeader(DrawCanvas, DrawRect, PageIndex, Printing);
  DrawFooter(DrawCanvas, DrawRect, PageIndex, Printing);
  if PageIndex = 0 then
    DrawTitle(DrawCanvas, DrawRect, Printing);
  if PageIndex = PageCount - 1 then
    DrawTail(DrawCanvas, DrawRect, Printing);
end;

procedure TPreviewForm.SeTPreviewFormState(NewState: TPreviewFormState);
var
  OldState: TPreviewFormState;
begin
  if FState = NewState then Exit;
  OldState := FState;
  FState := NewState;
  if (NewState = pbZoomIn) then ZoomIn
  else if (OldState = pbZoomIn) then ZoomOut;
end;

procedure TPreviewForm.ZoomIn;
begin
  FPages[FPageIndex].Zoom := 100;
  AdjustPages;
end;

procedure TPreviewForm.ZoomOut;
var
  i: Integer;
begin
  for i:=0 to FPageCount-1 do FPages[i].Zoom := FZoom;
  AdjustPages;
end;

procedure TPreviewForm.WMSetCursor(var Msg: TWMSetCursor);
var
  Cur: HCURSOR;
begin
  Cur := Screen.Cursors[crArrow];
  SetCursor(Cur);
end;

procedure TPreviewForm.SetCommonPageInfo(Value: TCommonPageInfo);
begin
  FCommonPageInfo.Assign(Value);
  RefreshPages;
end;

procedure TPreviewForm.DrawFooter(DrawCanvas: TCanvas; DrawRect: TRect;
  PageIndex: Integer; Printing: Boolean);

  procedure DrawFooterLine;
  var
    LinePos: Integer;
  begin
    if CommonPageInfo.FooterLineWidth <= 0 then Exit;
    with CommonPageInfo, DrawCanvas do
      if FooterDoubleLine then
        begin
          Pen.Width := FooterLineWidth;
          Pen.Style := FooterLineStyle;
          Pen.Mode := pmCopy;
          LinePos := DrawRect.Bottom - FooterExtent + FooterLineWidth Div 2;
          DrawLine(DrawCanvas, DrawRect.Left, LinePos, DrawRect.Right, LinePos);