⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 gmpreview.pas

📁 GmPrintSuite 2.96.7] a
💻 PAS
📖 第 1 页 / 共 4 页
字号:
  FPages.PagesPerSheet := Value;
  MessageToControls(GM_MULTIPAGE_CHANGED, 0, 0);
end;

procedure TGmPreview.SetShadow(Value: TGmShadow);
begin
  FShadow.Assign(Value);
end;

procedure TGmPreview.SetTimeFormat(Value: string);
begin
  GlobalTimeTokenFormat := Value;
end;

procedure TGmPreview.SetZoom(Value: integer);
begin
  if (Value > FMaxZoom) then Value := FMaxZoom;
  if (Value < FMinZoom) then Value := FMinZoom;
  if FPaper.Zoom = Value then Exit;
  SaveScrollPos;
  try
    FPaper.Zoom := Value;
    UpdateScrollBars;
    FPaper.BeginUpdate;
    FPaper.EndUpdate;
  finally
    LoadScrollPos;
  end;
end;

procedure TGmPreview.UpdateScrollBars;
begin
  if FUpdating then Exit;
  HorzScrollBar.Range := Round(FPaper.PageExtent[SCREEN_PPI].cx) + (FPaper.Gutters.Left + FPaper.Gutters.Right);
  VertScrollBar.Range := Round(FPaper.PageExtent[SCREEN_PPI].cy) + (FPaper.Gutters.Top + FPaper.Gutters.Bottom);
  Realign;
  Invalidate;
end;

procedure TGmPreview.ZoomToArea(ARect: TRect);
var
  BoxSize: TSize;
  InchBoxOrigin: TGmPoint;
  PercentOfClient: TGmPoint;
  ChangeFraction: Extended;
  ActualChangeFraction: Extended;
  Adjust: TPoint;
  LastZoom: integer;
  CenterPtInch: TGmPoint;
  InchRect: TGmRect;
begin
  BoxSize.cx := ARect.Right - ARect.Left;
  BoxSize.cy := ARect.Bottom - ARect.Top;
  if (BoxSize.cx = 0) or (BoxSize.cy = 0) then Exit;
  InchRect := FPaper.DragDrawInchRect;
  PercentOfClient.x := (BoxSize.cx) / (ClientWidth);
  PercentOfClient.y := (BoxSize.cy) / (ClientHeight);
  ChangeFraction := MaxFloat(PercentOfClient.x, PercentOfClient.y);
  LastZoom := Zoom;
  Zoom := Trunc(Zoom / ChangeFraction);
  ActualChangeFraction := LastZoom / Zoom;
  with InchRect do
  begin
    CenterPtInch.X := (Right + Left) / 2;
    CenterPtInch.Y := (Bottom + Top) / 2;
    InchBoxOrigin.X := MinFloat(Left, Right);
    InchBoxOrigin.Y := MinFloat(Top, Bottom);
  end;
  BoxSize.cx := Round(BoxSize.cx / ActualChangeFraction);
  BoxSize.cy := Round(BoxSize.cy / ActualChangeFraction);
  Adjust.X := (ClientWidth - BoxSize.cx) div 2;
  Adjust.Y := (ClientHeight - BoxSize.cy) div 2;

  HorzScrollBar.Position := FPaper.Gutters.Left + Round((InchBoxOrigin.X * SCREEN_PPI) * (Zoom / 100)) - Adjust.X;
  VertScrollBar.Position := FPaper.Gutters.Top + Round((InchBoxOrigin.Y * SCREEN_PPI) * (Zoom / 100)) - Adjust.Y;
end;

procedure TGmPreview.CMMouseLeave(var Message: TMessage);
begin
  StopPanning;
end;

procedure TGmPreview.DefineProperties(Filer: TFiler);
begin
  inherited;
  Filer.DefineProperty('MarginValues', ReadData, WriteData, True);
end;

procedure TGmPreview.DoDragDrop(Sender: TObject; Source: TObject; X, Y: integer);
begin
  if Assigned(OnDragDrop) then OnDragDrop(Self, Source, X, Y);
end;

procedure TGmPreview.DoDragOver(Sender, Source: TObject; X, Y: integer; State: TDragState; var Accept: Boolean);
begin
  if Assigned(OnDragOver) then OnDragOver(Self, Source, X, Y, State, Accept);
end;

procedure TGmPreview.DoMarginsChanged(Sender: TObject);
begin
  FPaper.Invalidate;
  MessageToControls(GM_HEADERFOOTER_CHANGED, 0, 0);
end;

procedure TGmPreview.DoMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  SetFocus;
  FMouseDownPoint := Point(X, Y);
  if Assigned(OnMouseDown) then OnMouseDown(Self, Button, Shift, X, Y);
end;

procedure TGmPreview.DoMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
  XyChange: TPoint;
  tmpRect:TGmRect;
begin
  if Assigned(OnMouseMove) then OnMouseMove(Self, Shift, X, Y);
  if FPanning then
  begin
    GetCursorPos(XyChange);
    XyChange := ScreenToClient(XyChange);
    XyChange.X := (FPanningOrigin.X - XyChange.X);
    XyChange.Y := (FPanningOrigin.Y - XyChange.Y);
    HorzScrollBar.Position := FPanningScrollOrigin.X + XyChange.X;
    VertScrollBar.Position := FPanningScrollOrigin.Y + XyChange.Y;
  end;
  if (FObjectDragging) and (Assigned(FSelectedObject)) then
  begin
    ScratchCanvas.Brush.Style := bsClear;
    ScratchCanvas.Pen.Mode := pmNot;
    ScratchCanvas.Pen.Style := psDot;
    ScratchCanvas.Pen.Width := 1;
    if FSelectedObject is TGmGraphicObject then
    begin
     tmpRect:=(FSelectedObject as TGmGraphicObject).Coords[gmpixels];
     FDragObjectRect.Left:=round(tmpRect.Left);
     FDragObjectRect.Right:=round(tmpRect.Right);
     FDragObjectRect.Top:=round(tmpRect.Top);
     FDragObjectRect.Bottom:=round(tmpRect.Bottom);
     FDragObjectRect := ScaleRect(FDragObjectRect, Zoom/100);
     OffsetRect(FDragObjectRect,
             (FPaper.PageRect.Left - HorzScrollBar.Position),
             (FPaper.PageRect.Top  - VertScrollBar.Position));
    end
    else
    FDragObjectRect := GmObjectRect(FSelectedObject);
    OffsetRect(FDragObjectRect, HorzScrollBar.Position, VertScrollBar.Position);
    GmDrawRect(ScratchCanvas, FDragObjectRect);
    OffsetRect(FDragObjectRect,
               (X - FMouseDownPoint.X),
               (Y - FMouseDownPoint.Y));

    GmDrawRect(ScratchCanvas, FDragObjectRect);
    FLastObjectRect := FDragObjectRect;
  end;
end;

procedure TGmPreview.DoMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if FPanning then StopPanning;
  if FObjectDragging then DragGmObjectEnd;
  if Assigned(OnMouseUp) then OnMouseUp(Self, Button, Shift, X, Y);
end;

procedure TGmPreview.DoOrientationChanged(Sender: TObject);
begin
  MessageToControls(GM_ORIENTATION_CHANGED, 0, 0);
  Invalidate;
  if Assigned(FOnOrientationChanged) then FOnOrientationChanged(Self);
end;

procedure TGmPreview.DoPageContentChanged(Sender: TObject);
begin
  FPaper.Page := FPages[FPages.CurrentPage];
  UpdateScrollBars;
  MessageToControls(GM_PAGE_CONTENT_CHANGED, 0, 0);
end;

procedure TGmPreview.DoPageCountChanged(Sender: TObject);
begin
  MessageToControls(GM_PAGE_COUNT_CHANGED, 0, 0);
end;

procedure TGmPreview.DoPageNumChanged(Sender: TObject);
begin
  FPaper.Page := CurrentPage;
  SelectGmObject(nil);
  if Assigned(FOnPageChanged) then FOnPageChanged(Self);
  MessageToControls(GM_PAGE_NUM_CHANGED, 0, 0);
end;

procedure TGmPreview.DoPageDragDrop(Sender: TObject; Source: TObject; X, Y: TGmValue);
begin
  if Assigned(FOnPageDragDrop) then FOnPageDragDrop(Self, Source, X, Y);
end;

procedure TGmPreview.DoPageDragOver(Sender, Source: TObject; X, Y: TGmValue; State: TDragState; var Accept: Boolean);
begin
  if Assigned(FOnPageDragOver) then FOnPageDragOver(Self, Source, X, Y, State, Accept);
end;

procedure TGmPreview.DoPageMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: TGmValue);
var
  AObject: TGmVisibleObject;
begin
  if Assigned(FOnPageMouseDown) then FOnPageMouseDown(Self, Button, Shift, X, Y);
  if Assigned(FOnObjectMouseDown) then
  begin
    AObject := GmObjectAtPos(X.AsInches, Y.AsInches, gmInches);
    if Assigned(AObject) then
      FOnObjectMouseDown(Self, Button, Shift, X, Y, AObject);
  end;
end;

procedure TGmPreview.DoPageMouseMove(Sender: TObject; Shift: TShiftState; X, Y: TGmValue);
begin
  FMousePosInch := GmPoint(X.AsInches, Y.AsInches);
  if Assigned(FOnPageMouseMove) then FOnPageMouseMove(Self, Shift, X, Y);
end;

procedure TGmPreview.DoPageMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: TGmValue);
begin
  if Assigned(FOnPageMouseUp) then FOnPageMouseUp(Self, Button, Shift, X, Y);
end;

procedure TGmPreview.DoPaperSizeChanged(Sender: TObject);
begin
  FPaper.Page := CurrentPage;
  MessageToControls(GM_PAPERSIZE_CHANGED, 0, 0);
end;

procedure TGmPreview.DoPrinterChanged(Sender: TObject);
begin
  MessageToControls(GM_PRINTER_CHANGED, 0, 0);
  Invalidate;
end;

procedure TGmPreview.PaintPage(Sender: TObject);
var
  BoundingRect: TRect;
  tmpRect:TGmRect;
  ExpandRect,pw,ph:integer;

begin
  if (Assigned(FSelectedObject)) and (FDrawSelectedBorder) then
  begin
    ScratchCanvas.Pen.Assign(FSelectionPen);
    //
    if FSelectedObject is TGmGraphicObject then
    begin
     tmpRect:=(FSelectedObject as TGmGraphicObject).Coords[gmpixels];
     BoundingRect.Left:=round(tmpRect.Left);
     BoundingRect.Right:=BoundingRect.Left+round((tmpRect.Right- tmpRect.Left));
     BoundingRect.Top:=round(tmpRect.Top);
     BoundingRect.Bottom:=BoundingRect.Top+round((tmpRect.Bottom -tmpRect.Top));
     BoundingRect:=ScaleRect(BoundingRect,Zoom / 100);
     OffsetRect(BoundingRect,
             (FPaper.PageRect.Left - HorzScrollBar.Position),
             (FPaper.PageRect.Top  - VertScrollBar.Position));
     BoundingRect.Left:=BoundingRect.Left -5;
     BoundingRect.Right:=BoundingRect.Right+5;
     BoundingRect.Top:=BoundingRect.Top -5;
     BoundingRect.Bottom:=BoundingRect.Bottom +5;
     //InflateRect(BoundingRect, round(Zoom / 100), ExpandRect);
    end
    else
    begin
    BoundingRect := GmObjectRect(FSelectedObject);
    ExpandRect := Round(10 * (Zoom / 100));
    InflateRect(BoundingRect, ExpandRect, ExpandRect);
    end;
    BoundingRect.Right := BoundingRect.Right + 1;
    BoundingRect.Bottom := BoundingRect.Bottom + 1;
    GmDrawRect(ScratchCanvas, BoundingRect);
  end;
end;

procedure TGmPreview.WMNCHitTest(var Message: TMessage);
begin
  DefaultHandler(Message);
end;

procedure TGmPreview.WMSize(var Message: TMessage);
begin
  inherited;
  UpdateScrollBars;
end;

{$IFDEF D4+}

function TGmPreview.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; // Bieringer
  MousePos: TPoint): Boolean;
var
  Scrollbar: TControlScrollBar;
begin
  Scrollbar := nil;
  if VertScrollBar.IsScrollBarVisible then
    Scrollbar := VertScrollBar
  else
  if HorzScrollBar.IsScrollBarVisible then
    Scrollbar := HorzScrollBar;
  if Scrollbar <> nil then
  begin
    if WheelDelta > 0 then
      Scrollbar.Position := Scrollbar.Position - Scrollbar.Increment
    else
      Scrollbar.Position := Scrollbar.Position + Scrollbar.Increment;
  end;
  Result := inherited DoMouseWheel(Shift, WheelDelta, MousePos);
end;

{$ENDIF}

procedure TGmPreview.KeyDown(var Key: Word; Shift: TShiftState); // Bieringer
var Scrollbar: TControlScrollBar;
begin
  {$IFDEF D4+}
  if VertScrollBar.IsScrollBarVisible then
    Scrollbar := VertScrollBar
  else
  if HorzScrollBar.IsScrollBarVisible then
    Scrollbar := HorzScrollBar
  else
    Exit;
  {$ELSE}
  if VertScrollBar.Range > ClientHeight then
    Scrollbar := VertScrollBar
  else
  if HorzScrollBar.Range > ClientWidth then
    Scrollbar := HorzScrollBar
  else
    Exit;
  {$ENDIF}
  case Key of
    VK_PRIOR: Scrollbar.Position := Scrollbar.Position - 10 * ScrollBar.Increment;
    VK_NEXT:  Scrollbar.Position := Scrollbar.Position + 10 * ScrollBar.Increment;
    VK_END:   begin  // right-bottom-edge
                Perform(WM_VSCROLL, SB_BOTTOM, 0);
                Perform(WM_HSCROLL, SB_RIGHT, 0);
              end;
    VK_HOME:  begin // left-top-edge
                Perform(WM_VSCROLL, SB_TOP, 0);
                Perform(WM_HSCROLL, SB_LEFT, 0);
              end;
    // The VK_UP, VK_DOWN, VK_LEFT, VK_RIGHT only raised in combination with the key <ALT> or <ALTGR>.
    // By only press the keys (VK_UP, VK_DOWN, VK_LEFT, VK_RIGHT) the focus is changed to the next control.
    VK_UP:    Perform(WM_VSCROLL, SB_LINEUP, 0);
    VK_DOWN:  Perform(WM_VSCROLL, SB_LINEDOWN, 0);
    VK_LEFT:  Perform(WM_HSCROLL, SB_LINELEFT, 0);
    VK_RIGHT: Perform(WM_HSCROLL, SB_LINERIGHT, 0);
  end;
end;

procedure TGmPreview.Loaded;
begin
  NewPageEvents(Self);
  inherited;
end;

function TGmPreview.GetPaperSize: TGmPaperSize;
begin
  Result := FPages.PaperSize;
end;

procedure TGmPreview.SetPaperSize(Value: TGmPaperSize);
begin
  FPages.PaperSize := Value;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -