dviewer.pas

来自「KSDev.BlockEngine.v3.03.rar 界面控件」· PAS 代码 · 共 1,449 行 · 第 1/3 页

          { Draw middle tic }
          Pt := PaperToScreen(Tics + TicsStep / 2, 0);
          MoveTo(Pt.X, RulerMargin * 3);
          LineTo(Pt.X, RulerSize - RulerMargin);
          { Draw left and right tics }
          Pt := PaperToScreen(Tics + TicsStep / 4, 0);
          MoveTo(Pt.X, RulerMargin * 3);
          LineTo(Pt.X, RulerSize - RulerMargin);
          Pt := PaperToScreen(Tics + TicsStep / 2 + TicsStep / 4, 0);
          MoveTo(Pt.X, RulerMargin * 3);
          LineTo(Pt.X, RulerSize - RulerMargin);

          Tics := Tics + TicsStep;
        end;
        { Draw mouse X }
        Pen.Color := clHighlight;
        MoveTo(FMousePos.X, RulerMargin);
        LineTo(FMousePos.X, RulerSize - RulerMargin);
      end;
    end;

    Canvas.Draw(0, 0, Buffer);

    { Vertical }
    Buffer.Width := RulerSize;
    Buffer.Height := ClientHeight;
    with Buffer.Canvas do
    begin
      R := Classes.Rect(0, 0, Buffer.Width, Buffer.Height);
      Brush.Style := bsSolid;
      Brush.Color := clBtnFace;
      FillRect(R);
      if Document <> nil then
      begin
        { Calc rulers vars }
        InflateRect(R, -RulerMargin, -RulerMargin);
        with Document.Paper do
        begin
          Pt := PaperToScreen(0, 0);
          R.Top := Pt.Y;
          Pt := PaperToScreen(Width, Height);
          R.Bottom := Pt.Y;
        end;
        Brush.Color := clWindow;
        FillRect(R);

        { Draw tics }
        Pen.Color := clBlack;
        Tics := - Trunc(PageY / TicsStep) * TicsStep;
        { Set font }
        Brush.Style := bsClear;
        Font.Name := 'Arial';
        Font.Size := 6;
        while Tics < WorkHeight do
        begin
          { Draw big tic }
          Pt := PaperToScreen(0, Tics);
          MoveTo(RulerMargin, Pt.Y);
          LineTo(RulerSize - RulerMargin, Pt.Y);
          { Draw text }
          if (Document <> nil) and (Document.UnitType = Centimeter) then
            TextOut(RulerMargin, Pt.Y + 2, IntToStr(Round(Tics / 10)))
          else
            TextOut(RulerMargin, Pt.Y + 2, IntToStr(Trunc(Tics)));
          { Draw middle tic }
          Pt := PaperToScreen(0, Tics + TicsStep / 2);
          MoveTo(RulerMargin * 3, Pt.Y);
          LineTo(RulerSize - RulerMargin, Pt.Y);
          { Draw left and right tics }
          Pt := PaperToScreen(0, Tics + TicsStep / 4);
          MoveTo(RulerMargin * 3, Pt.Y);
          LineTo(RulerSize - RulerMargin, Pt.Y);
          Pt := PaperToScreen(0, Tics + TicsStep / 2 + TicsStep / 4);
          MoveTo(RulerMargin * 3, Pt.Y);
          LineTo(RulerSize - RulerMargin, Pt.Y);

          Tics := Tics + TicsStep;
        end;

        { Draw mouse X }
        Pen.Color := clHighlight;
        MoveTo(RulerMargin, FMousePos.Y);
        LineTo(RulerSize - RulerMargin, FMousePos.Y);
      end;
    end;
    Canvas.Draw(0, 0, Buffer);
  finally
    Buffer.Free;
  end;

  { Draw gripper }
  SelectClipRgn(Canvas.Handle, 0);
  Canvas.Brush.Color := clBtnFace;
  Canvas.FillRect(Classes.Rect(0, 0, RulerSize, RulerSize));
end;

procedure TBlockViewer.PaintPaper;
var
  P, P1: TGPPen;
  B: TGPBrush;
  ShadowWidth: single;
  SaveState: cardinal;
  L, X, Y: Float;
begin
  if FDisableUpdate then Exit;
  if Document = nil then Exit;
  SetGraphics;
  if Clipped then
    if ClipRgn <> nil then
      Graphics.SetClip(ClipRgn);

  Graphics.SetSmoothingMode(SmoothingModeInvalid);

  case FViewKind of
    vkPage:
      begin
        { Draw background }
        B := TGPSolidBrush.Create($FF707070);
        Graphics.FillRectangle(B, ViewX, ViewY, ViewWidth, ViewHeight);
        B.Free;
        { Draw shadow }
        B := TGPSolidBrush.Create($FF202020);
        ShadowWidth := GetRealValue(3);
        Graphics.FillRectangle(B, PageX + PageWidth, PageY + ShadowWidth, ShadowWidth, PageHeight);
        Graphics.FillRectangle(B, PageX + ShadowWidth, PageY + PageHeight, PageWidth - ShadowWidth, ShadowWidth);
        B.Free;
        { Draw paper }
        B := TGPSolidBrush.Create(aclWhite);
        Graphics.FillRectangle(B, PageX, PageY, PageWidth, PageHeight);
        B.Free;
        { OnPaint }
        if Assigned(OnPaint) then
          OnPaint(Self, Graphics, MakeFloatRect2(PageX, PageY, PageWidth, PageHeight));
        { Draw grid }
        if FShowGrid then
        begin
          if FGridKind = gkAuto then
          begin
            X := 0;
            P := TGPPen.Create($FFDDDDDD, GetRealValue(1));
            P1 := TGPPen.Create($FFEEEEEE, GetRealValue(1));
            while X < PageWidth do
            begin
              Graphics.DrawLine(P, PageX + X, PageY, PageX + X, PageY + PageHeight);
              X := X + TicsStep / 4;
              if X > PageWidth then Break;
              Graphics.DrawLine(P1, PageX + X, PageY, PageX + X, PageY + PageHeight);
              X := X + TicsStep / 4;
              if X > PageWidth then Break;
              Graphics.DrawLine(P1, PageX + X, PageY, PageX + X, PageY + PageHeight);
              X := X + TicsStep / 4;
              if X > PageWidth then Break;
              Graphics.DrawLine(P1, PageX + X, PageY, PageX + X, PageY + PageHeight);
              X := X + TicsStep / 4;
            end;
            X := 0;
            while X < PageHeight do
            begin
              Graphics.DrawLine(P, PageX, PageY + X, PageX + PageWidth, PageY + X);
              X := X + TicsStep / 4;
              if X > PageHeight then Break;
              Graphics.DrawLine(P1, PageX, PageY + X, PageX + PageWidth, PageY + X);
              X := X + TicsStep / 4;
              if X > PageHeight then Break;
              Graphics.DrawLine(P1, PageX, PageY + X, PageX + PageWidth, PageY + X);
              X := X + TicsStep / 4;
              if X > PageHeight then Break;
              Graphics.DrawLine(P1, PageX, PageY + X, PageX + PageWidth, PageY + X);
              X := X + TicsStep / 4;
            end;
            P1.Free;
            P.Free;
          end;
          if (FGridKind = gkFixed) and (GetPixelValue(FGridHSize) > 3) and (GetPixelValue(FGridVSize) > 3)then
          begin
            L := GetRealValue(1);
            B := TGPSolidBrush.Create($FFBBBBBB);
            X := FGridHSize;
            while X < PageWidth do
            begin
              Y := FGridVSize;
              while Y < PageHeight do
              begin
                Graphics.FillRectangle(B, PageX + X, PageY + Y, L, L);
                Y := Y + FGridVSize;
              end;
              X := X + FGridHSize;
            end;
            B.Free;
          end;
        end;
        { Draw border }
        P := TGPPen.Create(aclBlack, GetRealValue(1));
        Graphics.DrawRectangle(P, PageX, PageY, PageWidth, PageHeight);
        P.Free;
      end;
    vkBlank:
      begin
        { Draw view }
        B := TGPSolidBrush.Create(aclWhite);
        Graphics.FillRectangle(B, ViewX, ViewY, ViewWidth, ViewHeight);
        B.Free;
        { OnPaint }
        if Assigned(OnPaint) then
          OnPaint(Self, Graphics, MakeFloatRect2(ViewX, ViewY, ViewWidth, ViewHeight));
        { Draw grid }
        if FShowGrid then
        begin
          if FGridKind = gkAuto then
          begin
            X := 0;
            P := TGPPen.Create($FFDDDDDD, GetRealValue(1));
            P1 := TGPPen.Create($FFEEEEEE, GetRealValue(1));
            while (X < ViewX + ViewWidth) do
            begin
              Graphics.DrawLine(P, PageX + X, ViewY, PageX + X, ViewY + ViewHeight);
              X := X + TicsStep / 4;
              Graphics.DrawLine(P1, PageX + X, ViewY, PageX + X, ViewY + ViewHeight);
              X := X + TicsStep / 4;
              Graphics.DrawLine(P1, PageX + X, ViewY, PageX + X, ViewY + ViewHeight);
              X := X + TicsStep / 4;
              Graphics.DrawLine(P1, PageX + X, ViewY, PageX + X, ViewY + ViewHeight);
              X := X + TicsStep / 4;
            end;
            X := 0;
            while (X < ViewY + ViewHeight) do
            begin
              Graphics.DrawLine(P, ViewX, PageY + X, ViewX + ViewWidth, PageY + X);
              X := X + TicsStep / 4;
              Graphics.DrawLine(P1, ViewX, PageY + X, ViewX + ViewWidth, PageY + X);
              X := X + TicsStep / 4;
              Graphics.DrawLine(P1, ViewX, PageY + X, ViewX + ViewWidth, PageY + X);
              X := X + TicsStep / 4;
              Graphics.DrawLine(P1, ViewX, PageY + X, ViewX + ViewWidth, PageY + X);
              X := X + TicsStep / 4;
            end;
            P1.Free;
            P.Free;
          end;
          if (FGridKind = gkFixed) and (GetPixelValue(FGridHSize) > 3) and (GetPixelValue(FGridVSize) > 3)then
          begin
            L := GetRealValue(1);
            B := TGPSolidBrush.Create($FFBBBBBB);
            X := FGridHSize;
            while (X < ViewWidth) or (X < WorkWidth) do
            begin
              Y := FGridVSize;
              while Y < PageHeight do
              begin
                Graphics.FillRectangle(B, PageX + X, PageY + Y, L, L);
                Y := Y + FGridVSize;
              end;
              X := X + FGridHSize;
            end;
            B.Free;
          end;
        end;
      end;
  end;

  // check region
  if Clipped then
  begin
{    B := TGPSolidBrush.Create($FF000000 or Random($FFFFFF));
    if ClipRgn <> nil then
    begin
      Graphics.FillRegion(B, ClipRgn);
    end;
    B.Free;}
  end;

  { Draw Document }
  SaveState := Graphics.Save;
  try
    { Set transform }
    Graphics.TranslateTransform(PageX, PageY);
    if FSmooth then
    begin
      Graphics.SetSmoothingMode(SmoothingModeAntiAlias);
      Graphics.SetPixelOffsetMode(PixelOffsetModeHighQuality);
    end
    else
    begin
      Graphics.SetPixelOffsetMode(PixelOffsetModeNone);
    end;

    { Drawing Document }
    PaintBlockDocument;
  finally
    Graphics.Restore(SaveState)
  end;
end;

procedure TBlockViewer.PaintBlockDocument;
begin
  if FDisableUpdate then Exit;
  Document.Draw(Graphics);
end;

procedure TBlockViewer.PaintBlockDocumentToCanvas(Canvas: TCanvas);
var
  G: TGPGraphics;
begin
  if Document = nil then Exit;

  G := TGPGraphics.Create(Canvas.Handle, 0, 0);
  try
    G.SetPageUnit(UnitTypeToGPUnit(Document.UnitType));
    G.SetSmoothingMode(SmoothingModeAntiAlias);

    Document.BlockRoot.DesignState := Document.BlockRoot.DesignState - [dsDesignMode];
    Document.Draw(G);
    Document.BlockRoot.DesignState := Document.BlockRoot.DesignState + [dsDesignMode];
  finally
    G.Free;
  end;
end;

procedure TBlockViewer.WMRepaint(var Msg: TMessage);
var
  UpdateAll: boolean;
  P1, P2: FloatPoint;
  Rcts: array [0..1000] of TRect;
  i, RCount: integer;
  R: TRect;

 procedure ProcessPaintMessages;
 var
   RMsg: TMsg;
 begin
   while PeekMessage(RMsg, Handle, WM_REPAINT, WM_REPAINT, PM_REMOVE) do
   begin
     if UpdateAll then Continue;
     if RMsg.WParam <> 0 then
     begin
       P1 := ScreenToPaper(TSmallPoint(RMsg.WParam).Y - 2, TSmallPoint(RMsg.WParam).X - 2);
       P2 := ScreenToPaper(TSmallPoint(RMsg.LParam).Y + 2, TSmallPoint(RMsg.LParam).X + 2);
       ClipRgn.Union(MakeRect(P1.X, P1.Y, P2.X - P1.X, P2.Y - P1.Y));
       Rcts[RCount] := Classes.Rect(TSmallPoint(RMsg.WParam).Y, TSmallPoint(RMsg.WParam).X,
         TSmallPoint(RMsg.LParam).Y, TSmallPoint(RMsg.LParam).X);
       Inc(RCount);
     end
     else
       UpdateAll := true;
   end;
 end;
begin
  if FDisableUpdate then Exit;
  if not IsWindowVisible(Handle) then Exit;

  if Msg.WParam <> 0 then
  begin
    UpdateAll := false;

    P1 := ScreenToPaper(TSmallPoint(Msg.WParam).Y, TSmallPoint(Msg.WParam).X);
    P2 := ScreenToPaper(TSmallPoint(Msg.LParam).Y, TSmallPoint(Msg.LParam).X);
    ClipRgn := TGPRegion.Create(MakeRect(P1.X, P1.Y, P2.X - P1.X, P2.Y - P1.Y));

    Rcts[0] := Classes.Rect(TSmallPoint(Msg.WParam).Y, TSmallPoint(Msg.WParam).X,
      TSmallPoint(Msg.LParam).Y, TSmallPoint(Msg.LParam).X);
    RCount := 1;
  end
  else
    UpdateAll := true;

  ProcessPaintMessages;

  if UpdateAll then
    UpdateBlockDocument
  else
  begin
    Clipped := true;
    try
      ClipRgn.Translate(PageX, PageY);
      PaintPaper;

      for i := 0 to RCount - 1 do
      begin
        R := Rcts[i];

        if FShowRulers then
          IntersectRect(R, R, Classes.Rect(RulerSize, RulerSize, ClientWidth, ClientHeight));

        BitBlt(Canvas.Handle, R.Left, R.Top, R.Right - R.Left, R.Bottom - R.Top,
          Scene.Canvas.Handle, R.Left, R.Top, SRCCOPY);
      end;
    finally
      ClipRgn.Free;
      ClipRgn := nil;
      Clipped := false;
    end;
  end;
end;

procedure TBlockViewer.UpdateBlockDocument;
begin
  PaintPaper;
  if FShowRulers then
    BitBlt(Canvas.Handle, RulerSize, RulerSize, ClientWidth - RulerSize,
      ClientWidth - RulerSize, Scene.Canvas.Handle, RulerSize, RulerSize, SRCCOPY)
  else
    BitBlt(Canvas.Handle, 0, 0, ClientWidth, ClientWidth, Scene.Canvas.Handle,
      0, 0, SRCCOPY);
end;

procedure TBlockViewer.UpdateBlockDocumentRect(Left, Top, Right, Bottom: Float);
var
  R: TRect;
begin
  Clipped := true;
  try
    ClipRgn := TGPRegion.Create(MakeRect(PageX + Left - DevicePixel, PageY + Top - DevicePixel, Right - Left + DevicePixel * 2, Bottom - Top + DevicePixel * 2));
    PaintPaper;
  finally
    ClipRgn.Free;
    ClipRgn := nil;
    Clipped := false;
  end;

  R.TopLeft := PaperToScreen(Left, Top);
  R.BottomRight := PaperToScreen(Right, Bottom);
  InflateRect(R, 2, 2);
  if FShowRulers then
    IntersectRect(R, R, Classes.Rect(RulerSize, RulerSize, ClientWidth, ClientHeight));

  BitBlt(Canvas.Handle, R.Left, R.Top, R.Right - R.Left, R.Bottom - R.Top,
    Scene.Canvas.Handle, R.Left, R.Top, SRCCOPY);
end;

procedure TBlockViewer.UpdateSceneRect(Left, Top, Right, Bottom: Float);
var
  R: TRect;
begin
  R.TopLeft := PaperToScreen(Left, Top);
  R.BottomRight := PaperToScreen(Right, Bottom);
  InflateRect(R, 2, 2);
  if FShowRulers then
    IntersectRect(R, R, Classes.Rect(RulerSize, RulerSize, ClientWidth, ClientHeight));

  BitBlt(Canvas.Handle, R.Left, R.Top, R.Right - R.Left, R.Bottom - R.Top,
    Scene.Canvas.Handle, R.Left, R.Top, SRCCOPY);
end;

procedure TBlockViewer.DoGetGraphics(Sender: TObject; var G: TGPGraphics);
begin
  G := Graphics;
end;

procedure TBlockViewer.DoRepaintEvent(Sender: TObject);
begin
  PostMessage(Handle, WM_REPAINT, 0, 0);
end;

procedure TBlockViewer.DoRepaintRectEvent(Sender: TObject; Left, Top, Right,
  Bottom: Float);
var
  R: TRect;
begin
  R.TopLeft := PaperToScreen(Left, Top);
  R.BottomRight := PaperToScreen(Right, Bottom);
  InflateRect(R, 10, 10);
  PostMessage(Handle, WM_REPAINT, Cardinal(SmallPoint(R.Top, R.Left)), Cardinal(SmallPoint(R.Bottom, R.Right)));
end;

procedure TBlockViewer.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  inherited;

  FMousePos := Point(X, Y);
  if FShowRulers then
  begin
    PaintRulers;
  end;
end;

procedure TBlockViewer.WMEraseBkgnd(var Msg: TWMEraseBkgnd);
begin
  Msg.Result := 1;
end;

procedure TBlockViewer.UpdateAll;
begin
  if csLoading in ComponentState then Exit;