📄 gmpreview.pas
字号:
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 + -