gmclasses.pas

GmPrintSuite 2.96.7] a

  case index of
    0: FMargins.Left.AsGmValue[FMeasurement] := Value;
    1: FMargins.Top.AsGmValue[FMeasurement] := Value;
    2: FMargins.Right.AsGmValue[FMeasurement] := Value;
    3: FMargins.Bottom.AsGmValue[FMeasurement] := Value;
  end;
end;

//------------------------------------------------------------------------------

// *** TGmShadow ***

constructor TGmShadow.Create;
begin
  inherited Create;
  FColor := clBlack;
  FWidth := 3;
  FVisible := True;
end;

procedure TGmShadow.Assign(Source: TPersistent);
begin
  if (Source is TGmShadow) then
  begin
    FColor   := (Source as TGmShadow).Color;
    FVisible := (Source as TGmShadow).Visible;
    FWidth   := (Source as TGmShadow).Width;
    Changed;
  end
  else
    inherited Assign(Source);
end;

procedure TGmShadow.Draw(ACanvas: TCanvas; APageRect: TRect);
var
  ARect1: TRect;
  ARect2: TRect;
begin
  if not FVisible then Exit;
  SelectClipRgn(ACanvas.Handle, 0);
  SetMapMode(ACanvas.Handle, MM_TEXT);
  ARect1 := Rect(APageRect.Right,
                 APageRect.Top+FWidth,
                 APageRect.Right+FWidth,
                 APageRect.Bottom);
  OffsetRect(ARect1, 1, 1);
  ARect2 := Rect(APageRect.Left+FWidth,
                 APageRect.Bottom,
                 APageRect.Right+FWidth,
                 APageRect.Bottom+FWidth);
  OffsetRect(ARect2, 1, 1);
  ACanvas.Pen.Width := 1;
  ACanvas.Brush.Color := FColor;
  ACanvas.Pen.Color := FColor;
  ACanvas.Rectangle(ARect1.Left, ARect1.Top, ARect1.Right, ARect1.Bottom);
  ACanvas.Rectangle(ARect2.Left, ARect2.Top, ARect2.Right, ARect2.Bottom);
end;

procedure TGmShadow.Changed;
begin
  if Assigned(FOnChange) then FOnChange(Self);
end;

procedure TGmShadow.SetColor(Value: TColor);
begin
  if FColor = Value then Exit;
  FColor := Value;
  Changed;
end;

procedure TGmShadow.SetVisible(Value: Boolean);
begin
  if FVisible = Value then Exit;
  FVisible := Value;
  Changed;
end;

procedure TGmShadow.SetWidth(Value: integer);
begin
  if FWidth = Value then Exit;
  FWidth := Value;
  Changed;
end;

//------------------------------------------------------------------------------

// *** TGmPageGrid ***

constructor TGmPageGrid.Create;
begin
  inherited Create;
  FGridPen := TPen.Create;
  FGridStyle := gmNoGrid;
  FGridInterval := TGmValue.CreateValue(10, gmMillimeters);
  FGridPen.Color := clSilver;
  FGridPen.Width := 1;
  FGridInterval.OnChange := Changed;
  FGridPen.OnChange := Changed;
end;

destructor TGmPageGrid.Destroy;
begin
  FGridInterval.Free;
  FGridPen.Free;
  inherited Destroy;
end;

procedure TGmPageGrid.Changed(Sender: TObject);
begin
  if Assigned(FOnChange) then FOnChange(Self);
end;

procedure TGmPageGrid.DrawToCanvas(Canvas: TCanvas; APageSize: TGmSize; Ppi: integer);
var
  ICount1,
  ICount2: integer;
  Dot: TPoint;
begin
  if FGridStyle = gmNoGrid then Exit;
  Canvas.Pen.Assign(FGridPen);
  if FGridStyle = gmLines then
  begin
    for ICount1 := 1 to Round(APageSize.Width / FGridInterval.AsInches) do
    begin
      Canvas.MoveTo(Round((ICount1 * FGridInterval.AsInches) * Ppi), 0);
      Canvas.LineTo(Round((ICount1 * FGridInterval.AsInches) * Ppi), Round(APageSize.Height * Ppi));
    end;
    for ICount2 := 1 to Round(APageSize.Height / FGridInterval.AsInches) do
    begin
      Canvas.MoveTo(0, Round((ICount2 * FGridInterval.AsInches) * Ppi));
      Canvas.LineTo(Round(APageSize.Width * Ppi), Round((ICount2 * FGridInterval.AsInches) * Ppi));
    end;
  end
  else
  if FGridStyle = gmDots then
  begin
    for ICount1 := 1 to Round(APageSize.Width / FGridInterval.AsInches) do
      for ICount2 := 1 to Round(APageSize.Height / FGridInterval.AsInches) do
      begin
        Dot := Point(Round((ICount1 * FGridInterval.AsInches) * Ppi), Round((ICount2 * FGridInterval.AsInches) * Ppi));
        Canvas.Pixels[Dot.X, Dot.Y] := FGridPen.Color;
      end;
  end;
end;

procedure TGmPageGrid.SetGridStyle(const Value: TGmGridStyle);
begin
  if FGridStyle = Value then Exit;
  FGridStyle := Value;
  Changed(Self);
end;

procedure TGmPageGrid.SetGridPen(Value: TPen);
begin
  FGridPen.Assign(Value);
  Changed(Self);
end;

//------------------------------------------------------------------------------

// *** TGmPaperImage ***

constructor TGmPaperImage.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FMouseValuePoint := TGmValuePoint.Create;
  FDragValuePoint := TGmValuePoint.Create;
  FGutters := Rect(30, 30, 30, 30);
  FZoom := 20;
  FUpdateCount := 0;
  FMargins := nil;
  FShadow := nil;
  FDrawPpi := 600;
  FDragDrawShape := gmDragRectangle;
  FDragDrawing := False;
  FDrawPage := True;
  FFastDraw := False;
end;

destructor TGmPaperImage.Destroy;
begin
  FMouseValuePoint.Free;
  FDragValuePoint.Free;
  inherited Destroy;
end;

procedure TGmPaperImage.BeginUpdate;
begin
  Inc(FUpdateCount);
end;

procedure TGmPaperImage.DragDrawStop;
begin
  FDragDrawing := False;
  Invalidate;
end;

procedure TGmPaperImage.DragDrawStart;
begin
  if FDragDrawing then Exit;
  FDragDrawing := True;
  FDragDrawRect.TopLeft := CalcCursorPos;
  FDragDrawRect.BottomRight := FDragDrawRect.TopLeft;
end;

procedure TGmPaperImage.DragDrop(Source: TObject; X, Y: Integer);
begin
  if Assigned(OnDragDrop) then OnDragDrop(Self, Source, X, Y);
  XYtoInchValuePoint(x, y, FDragValuePoint);
  if Assigned(FOnPageDragDrop) then FOnPageDragDrop(Self, Source, FDragValuePoint.X, FDragValuePoint.Y);
end;

procedure TGmPaperImage.EndUpdate;
begin
  if FUpdateCount > 0 then Dec(FUpdateCount);
  if not IsUpdating then Invalidate;
end;

function TGmPaperImage.CalcCursorPos: TPoint;
begin
  GetCursorPos(Result);
  Result := ScreenToClient(Result);
end;

function TGmPaperImage.GetDragDrawInchRect: TGmRect;
var
  APageRect: TRect;
begin
  APageRect := PageRect;

  Result.Left   := ((FDragDrawRect.Left - APageRect.Left)  / SCREEN_PPI) / (FZoom / 100);
  Result.Top    := ((FDragDrawRect.Top - APageRect.Top)  / SCREEN_PPI) / (FZoom / 100);
  Result.Right  := ((FDragDrawRect.Right - APageRect.Left) / SCREEN_PPI) / (FZoom / 100);
  Result.Bottom := ((FDragDrawRect.Bottom - APageRect.Top) / SCREEN_PPI) / (FZoom / 100);
end;

function TGmPaperImage.GetIsUpdating: Boolean;
begin
  Result := FUpdateCount > 0;
end;

function TGmPaperImage.GetPageExtent(Ppi: integer): TSize;
begin
  Result.cx := Round((FPaperSizeInch.Width * Ppi) * (FZoom/100));
  Result.cy := Round((FPaperSizeInch.Height * Ppi) * (FZoom/100));
end;

procedure TGmPaperImage.Changed(Sender: TObject);
begin
  Invalidate;
end;

procedure TGmPaperImage.ClipPaper;
var
  PaperRgn: HRGN;
  ARect: TRect;
begin
  ARect := Rect(0,
                0,
                Round(FPaperSizeInch.Width*DrawPpi),
                Round(FPaperSizeInch.Height*DrawPpi));
  if not BeginPath(Canvas.Handle) then Exit;
  GmDrawRect(Canvas, ARect);
  EndPath(Canvas.Handle);
  PaperRgn := PathToRegion(Canvas.Handle);
  try
    SelectClipRgn(Canvas.Handle, PaperRgn);
  finally
    DeleteObject(PaperRgn);
  end;
end;

procedure TGmPaperImage.DrawPaper(Ppi: integer; OutlineOnly: Boolean);
var
  ARect: TRect;
begin
  ARect := Rect(0,
                0,
                Round(FPaperSizeInch.Width*Ppi),
                Round(FPaperSizeInch.Height*Ppi));
  Canvas.Pen.Width := 0;
  Canvas.Pen.Mode := pmCopy;
  Canvas.Pen.Style := psSolid;
  Canvas.Pen.Color := clBlack;
  Canvas.Brush.Color := clWhite;
  if OutlineOnly then
    Canvas.Brush.Style := bsClear
  else
    Canvas.Brush.Style := bsSolid;
  GmDrawRect(Canvas, ARect);
  ClipPaper;
end;

procedure TGmPaperImage.DrawDragOutline;
begin
  Canvas.Lock;
  try
    Canvas.Pen.Mode := pmNot;
    Canvas.Pen.Style := psDot;
    Canvas.Brush.Style := bsClear;
    GmDrawRect(Canvas, FDragDrawRect);
  finally
    Canvas.Unlock;
  end;
end;
procedure TGmPaperImage.SetDrawPpi(Value: integer);
begin
  if FDrawPpi = Value then Exit;
  FDrawPpi := Value;
  Changed(Self);
end;

procedure TGmPaperImage.SetGrid(Value: TGmPageGrid);
begin
  FGrid := Value;
  if Assigned(FGrid) then
    FGrid.OnChange := Changed;
end;

procedure TGmPaperImage.SetGutters(Value: TRect);
begin
  if EqualRect(FGutters, Value) then Exit;
  FGutters := Value;
  Changed(Self);
end;

procedure TGmPaperImage.SetMargins(Value: TGmMargins);
begin
  FMargins := Value;
end;

procedure TGmPaperImage.SetPage(Value: TObject);
begin
  FPage := Value;
  if Assigned(FPage) then
  begin
    FPaperSizeInch := TGmPage(FPage).PageSize[gmInches];
  end;
  Changed(Self);
end;

procedure TGmPaperImage.SetPaperSizeInch(ASize: TGmSize);
begin
  FPaperSizeInch := ASize;
  Changed(Self);
end;

procedure TGmPaperImage.SetShadow(Value: TGmShadow);
begin
  FShadow := Value;
  if Assigned(FShadow) then FShadow.OnChange := Changed;
end;

procedure TGmPaperImage.SetZoom(Value: integer);
begin
  if FZoom = Value then Exit;
  FZoom := Value;
  Changed(Self);
end;

procedure TGmPaperImage.XYtoInchValuePoint(x, y: integer; var Value: TGmValuePoint);
var
  Origin: TPoint;
begin
  Origin := PageRect.TopLeft;
  x := x - Origin.X;
  y := y - Origin.Y;
  if x = 0 then
    Value.X.AsInches := 0
  else
    Value.X.AsInches := (x / SCREEN_PPI) / (FZoom / 100);
  if y = 0 then
    Value.Y.AsInches := 0
  else
    Value.Y.AsInches := (y / SCREEN_PPI) / (FZoom / 100);
end;

function TGmPaperImage.PageRect: TRect;
var
  OffsetLeft: integer;
  OffsetTop: integer;
begin
  //if Assigned(FPage) then FPaperSizeInch := TGmPage(FPage).PageSize[gmInches];
  Result := Rect(0,
                 0,
                 Round(PageExtent[SCREEN_PPI].cx),
                 Round(PageExtent[SCREEN_PPI].cy));
  OffsetLeft := (((Width - (FGutters.Left + FGutters.Right)) - RectWidth(Result)) div 2);
  OffsetTop  := (((Height - (FGutters.Top + FGutters.Bottom)) - RectHeight(Result)) div 2);

  //if OffsetLeft < FGutters.Left then OffsetLeft := FGutters.Left;
  //if OffsetTop < FGutters.Top then OffsetTop := FGutters.Top;

  OffsetRect(Result, FGutters.Left + OffsetLeft, FGutters.Top + OffsetTop);
end;

procedure TGmPaperImage.DragOver(Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
begin
  //if IsUpdating then Exit;
  if Assigned(OnDragOver) then OnDragOver(Self, Source, X, Y, State, Accept);
  XYtoInchValuePoint(x, y, FDragValuePoint);
  if Assigned(FOnPageDragOver) then FOnPageDragOver(Self, Source, FDragValuePoint.X, FDragValuePoint.Y, State, Accept);
end;

procedure TGmPaperImage.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  //if IsUpdating then Exit;
  XYtoInchValuePoint(x, y, FMouseValuePoint);
  if Assigned(OnMouseDown) then OnMouseDown(Self, Button, Shift, X, Y);
  if Assigned(FOnPageMouseDown) then FOnPageMouseDown(Self, Button, Shift, FMouseValuePoint.X, FMouseValuePoint.Y);
end;

procedure TGmPaperImage.CMMouseEnter(var Message: TMessage);
begin
  if Assigned(FOnMouseEnter) then FOnMouseEnter(Self);
end;

procedure TGmPaperImage.CMMouseLeave(var Message: TMessage);
begin
  if Assigned(FOnMouseLeave) then FOnMouseLeave(Self);
end;

procedure TGmPaperImage.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  AClipRgn: HRGN;
  AClipRect: TRect;
begin
  if IsUpdating then Exit;
  inherited MouseMove(Shift, X, Y);
  if Assigned(OnMouseMove) then OnMouseMove(Self, Shift, X, Y);
  if FDragDrawing then
  begin
    AClipRect := PageRect;
    InflateRect(AClipRect, -1, -1);
    AClipRgn := CreateRectRgnIndirect(AClipRect);
    try
      SelectClipRgn(Canvas.Handle, AClipRgn);
    finally
      DeleteObject(AClipRgn);
    end;
    DrawDragOutline;
    FDragDrawRect.BottomRight := Point(X, Y);
    DrawDragOutline;
  end;
  XYtoInchValuePoint(x, y, FMouseValuePoint);
  if Assigned(FOnPageMouseMove) then FOnPageMouseMove(Self, Shift, FMouseValuePoint.X, FMouseValuePoint.Y);
end;

procedure TGmPaperImage.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  inherited MouseUp(Button, Shift, X, Y);
  if Assigned(OnMouseUp) then OnMouseUp(Self, Button, Shift, X, Y);
  XYtoInchValuePoint(x, y, FMouseValuePoint);
  if Assigned(FOnPageMouseUp) then FOnPageMouseUp(Self, Button, Shift, FMouseValuePoint.X, FMouseValuePoint.Y);
end;

procedure TGmPaperImage.Paint;
var
  APageRect: TRect;
  AOrientation: TGmOrientation;
begin
  if IsUpdating then Exit;
  if (Assigned(FPage)) then
    AOrientation := TGmPage(FPage).Orientation
  else
    AOrientation := gmPortrait;
  Canvas.Brush.Color := clWhite;
  APageRect := PageRect;
  SetMapMode(Canvas.Handle, MM_ANISOTROPIC);
  SetWindowExtEx(Canvas.Handle,
                 Round(FPaperSizeInch.Width*FDrawPpi),
                 Round(FPaperSizeInch.Height*FDrawPpi),
                 nil );
  SetWindowOrgEx(Canvas.Handle, 0, 0, nil);
  SetViewportExtEx(Canvas.Handle,
                   PageExtent[SCREEN_PPI].cx,
                   PageExtent[SCREEN_PPI].cy,
                   nil );
  SetViewportOrgEx(Canvas.Handle, APageRect.Left+Left, PageRect.Top+Top, nil);
  DrawPaper(FDrawPpi, False);
  APageRect := Rect(0, 0, PageExtent[SCREEN_PPI].cx, PageExtent[SCREEN_PPI].cy);
  if Assigned(FMargins) then
    FMargins.Clip(FPaperSizeInch, AOrientation, Canvas, FDrawPpi);
  if (Assigned(FPage)) and (FDrawPage) then
    TGmPage(FPage).DrawToCanvas(Canvas, FDrawPpi, FDrawPpi, FFastDraw);
  if Assigned(FMargins) then FMargins.Draw(FPaperSizeInch, AOrientation, Canvas, FDrawPpi);
  if Assigned(FGrid) then FGrid.DrawToCanvas(Canvas, PaperSizeInch, FDrawPpi);
  SelectClipRgn(Canvas.Handle, 0);

  DrawPaper(FDrawPpi, True);
  if Assigned(FShadow) then FShadow.Draw(Canvas, APageRect);

  if Assigned(FOnPaintPage) then
  begin
    ClipPaper;
    SetMapMode(Canvas.Handle, MM_TEXT);
    SetViewportOrgEx(Canvas.Handle, 0, 0, nil);
    Canvas.Brush.Style := bsClear;
    FOnPaintPage(Self);
  end;
end;

end.