gmpagelist.pas

GmPrintSuite 2.96.7] a

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

procedure TGmHeaderFooterCaption.SetCaption(Value: string);
begin
  if FCaption = Value then Exit;
  FCaption := Value;
  Changed;
end;

procedure TGmHeaderFooterCaption.SetFont(Value: TFont);
begin
  FFont.Assign(Value);
  Changed;
end;

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

// *** TGmHeaderFooter ***

constructor TGmHeaderFooter.Create(const ChangeEvent: TNotifyEvent = nil);
begin
  inherited Create;
  FPen := TPen.Create;
  FHeight := TGmValue.Create(Changed);
  FHeight.AsInches := 0;
  FVisible := False;
  FCaptions[gmLeft]   := TGmHeaderFooterCaption.Create(Self, Changed);
  FCaptions[gmCenter] := TGmHeaderFooterCaption.Create(Self, Changed);
  FCaptions[gmRight]  := TGmHeaderFooterCaption.Create(Self, Changed);
  FShowLine := True;
  OnChange := ChangeEvent;
end;

destructor TGmHeaderFooter.Destroy;
begin
  FPen.Free;
  FHeight.Free;
  FCaptions[gmLeft].Free;
  FCaptions[gmCenter].Free;
  FCaptions[gmRight].Free;
  inherited Destroy;
end;

function TGmHeaderFooter.GetLargestFont: TFont;
var
  F1, F2, F3: TFont;
begin
  F1 := FCaptions[gmLeft].Font;
  F2 := FCaptions[gmCenter].Font;
  F3 := FCaptions[gmRight].Font;
  Result := F1;
  if F2.Size > Result.Size then Result := F2;
  if F3.Size > Result.Size then Result := F3;
end;

procedure TGmHeaderFooter.Assign(Source: TPersistent);
begin
  if (Source is TGmHeaderFooter) then
  begin
    FCaptions[gmLeft].Assign((Source as TGmHeaderFooter).CaptionLeft);
    FCaptions[gmCenter].Assign((Source as TGmHeaderFooter).CaptionCenter);
    FCaptions[gmRight].Assign((Source as TGmHeaderFooter).CaptionRight);
  end
  else
    inherited Assign(Source);
end;

procedure TGmHeaderFooter.LoadFromStream(Stream: TStream);
var
  AValues: TGmValueList;
  APen: TGmPen;
begin
  FCaptions[gmLeft].LoadFromStream(Stream);
  FCaptions[gmCenter].LoadFromStream(Stream);
  FCaptions[gmRight].LoadFromStream(Stream);
  AValues := TGmValueList.Create;
  try
    AValues.LoadFromStream(Stream);
    FVisible := AValues.ReadBoolValue(C_VS, True);
    FShowLine := AValues.ReadBoolValue(C_SL, True);
    FHeight.AsInches := AValues.ReadExtValue(C_HT, -1);
  finally
    AValues.Free;
  end;
  APen := TGmPen.Create;
  try
    APen.LoadFromStream(Stream);
     
    //APen.AssignToPen(FPen, -1);

  finally
    APen.Free;
  end;
end;

procedure TGmHeaderFooter.SaveToStream(Stream: TStream);
var
  AValues: TGmValueList;
  APen: TGmPen;
begin
  FCaptions[gmLeft].SaveToStream(Stream);
  FCaptions[gmCenter].SaveToStream(Stream);
  FCaptions[gmRight].SaveToStream(Stream);
  AValues := TGmValueList.Create;
  try
    AValues.WriteBoolValue(C_VS, FVisible);
    AValues.WriteBoolValue(C_SL, FShowLine);
    AValues.WriteExtValue(C_HT, FHeight.AsInches);
    AValues.SaveToStream(Stream);
  finally
    AValues.Free;
  end;
  APen := TGmPen.Create;
  try
    APen.Assign(FPen);
    APen.SaveToStream(Stream);
  finally
    APen.Free;
  end;
end;

function TGmHeaderFooter.GetCaptionIndex(index: integer): TGmHeaderFooterCaption;
begin
  Result := FCaptions[TGmCaptionAlign(index)];
end;

function TGmHeaderFooter.GetHeight(Measurement: TGmMeasurement): Extended;
begin
  if FHeight.AsInches = 0 then
    Result := ConvertValue(GetFontHeightInch(GetLargestFont), gmInches, Measurement)
  else
    Result := FHeight.AsGmValue[Measurement];
end;

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

procedure TGmHeaderFooter.SetCaptionIndex(index: integer; Value: TGmHeaderFooterCaption);
begin
  FCaptions[TGmCaptionAlign(index)] := Value;
end;

procedure TGmHeaderFooter.SetHeight(Measurement: TGmMeasurement; Value: Extended);
begin
  FHeight.AsInches := ConvertValue(Value, Measurement, gmInches);
end;

procedure TGmHeaderFooter.SetPen(Value: TPen);
begin
  FPen.Assign(Value);
end;

procedure TGmHeaderFooter.SetShowLine(Value: Boolean);
begin
  if FShowLine = Value then Exit;
  FShowLine := Value;
  Changed(Self);
end;

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

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

// *** TGmHeader ***

procedure TGmHeader.DrawToCanvas(ACanvas: TCanvas; AMargins: TGmMargins; APageSize: TGmSize;
  PpiX, PpiY: integer; Page, NumPages: integer);
var
  ValueRect: TGmValueRect;
  HeaderRect: TRect;
  HeaderHeight: Extended;

begin
  if not FVisible then Exit;
  //ACanvas.Font.PixelsPerInch := PpiX;
  ValueRect := TGmValueRect.Create;
  try
  HeaderHeight := Height[gmInches];
  HeaderRect := Rect(Round(AMargins.Left.AsInches * PpiX),
                     Round((AMargins.Top.AsInches) * PpiY),
                     Round((APageSize.Width - AMargins.Right.AsInches) * PpiX),
                     Round((AMargins.Top.AsInches + HeaderHeight) * PpiY));

    HeaderHeight := Height[gmInches]; //GetFontHeightInch(GetLargestFont);
    ValueRect.Left.AsPixels[PpiX]   := Round(AMargins.Left.AsInches * PpiX);
    ValueRect.Top.AsPixels[PpiY]    := Round(AMargins.Top.AsInches * PpiY);
    ValueRect.Right.AsPixels[PpiX]  := Round((APageSize.Width - AMargins.Right.AsInches) * PpiX);
    ValueRect.Bottom.AsPixels[PpiY] := Round((AMargins.Top.AsInches + HeaderHeight) * PpiY);


    //HeaderRect := GmRectToRect(ScaleGmRect(ValueRect.AsInchRect, Ppi));
  finally
    ValueRect.Free;
  end;

  FCaptions[gmLeft].DrawToCanvas(ACanvas, HeaderRect, PpiX, PpiY, gmLeft, Page, NumPages);
  FCaptions[gmCenter].DrawToCanvas(ACanvas, HeaderRect, PpiX, PpiY, gmCenter, Page, NumPages);
  FCaptions[gmRight].DrawToCanvas(ACanvas, HeaderRect, PpiX, PpiY, gmRight, Page, NumPages);
  if FShowLine then
  begin
    ACanvas.Pen.Assign(FPen);
    ACanvas.MoveTo(HeaderRect.Left, HeaderRect.Bottom);
    ACanvas.LineTo(HeaderRect.Right, HeaderRect.Bottom);
  end;
end;

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

// *** TGmFooter ***

procedure TGmFooter.DrawToCanvas(ACanvas: TCanvas; AMargins: TGmMargins; APageSize: TGmSize;
  PpiX, PpiY: integer; Page, NumPages: integer);
var
  FooterRect: TRect;
  FooterHeight: Extended;
begin
  if not FVisible then Exit;
  FooterHeight := Height[gmInches]; //GetFontHeightInch(GetLargestFont);
  FooterRect := Rect(Round(AMargins.Left.AsInches * PpiX),
                     Round(((APageSize.Height-AMargins.Bottom.AsInches) - FooterHeight) * PpiY),
                     Round((APageSize.Width - AMargins.Right.AsInches) * PpiX),
                     Round(((APageSize.Height-AMargins.Bottom.AsInches)) * PpiY));
  FCaptions[gmLeft].DrawToCanvas(ACanvas, FooterRect, PpiX, PpiY, gmLeft, Page, NumPages);
  FCaptions[gmCenter].DrawToCanvas(ACanvas, FooterRect, PpiX, PpiY, gmCenter, Page, NumPages);
  FCaptions[gmRight].DrawToCanvas(ACanvas, FooterRect, PpiX, PpiY, gmRight, Page, NumPages);
  if FShowLine then
  begin
    ACanvas.Pen.Assign(FPen);
    ACanvas.MoveTo(FooterRect.Left, FooterRect.Top);
    ACanvas.LineTo(FooterRect.Right, FooterRect.Top);
  end;
end;


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

// *** TGmPage ***

constructor TGmPage.Create(APageList: TGmPageList);
begin
  inherited Create;
  FObjects := TGmBaseObjectList.Create;
  FRtfInfo := TGmPageRtfInfo.Create(APageList.ResourceTable);
  FPageList := APageList;
  FPageSizeInch.Width := 8.26;
  FPageSizeInch.Height := 11.69;
  FOrientation := gmPortrait;
  FObjects.OnChanged := Changed;
  FShowFooter := True;
  FShowHeader := True;
end;

destructor TGmPage.Destroy;
begin
  FObjects.Free;
  FRtfInfo.Free;
  inherited Destroy;
end;

function TGmPage.ObjectAtPos(x, y: Extended; Measurement: TGmMeasurement; var AObject: TGmVisibleObject): Boolean;
var
  ICount: integer;
  Mf: TMetafile;
  Mfc: TMetafileCanvas;
  ObjectRgn: HRGN;
 // Ppi: integer;
  xInch, yInch: Extended;
  DrawObject: TGmVisibleObject;
  DrawData: TGmObjectDrawData;
  oRect:TgmRect;
begin
  Result := False;
  AObject := nil;
  xInch := ConvertValue(x, Measurement, gmInches);
  yInch := ConvertValue(y, Measurement, gmInches);

  DrawData.PpiX := 600;
  DrawData.PpiY := 600;

  Mf := TMetafile.Create;
  //DrawData.Metafile := Mf;
  try
    Mfc := TMetafileCanvas.Create(Mf, 0);
    try
      Mfc.Font.PixelsPerInch := 600;

      for ICount := 0 to FObjects.Count-1 do
      begin

        if (FObjects.GmObject[ICount] is TGmVisibleObject) then
        begin
          if FObjects.GmObject[ICount] is TGmGraphicObject then
          begin
            oRect:=(FObjects.GmObject[ICount] as TGmGraphicObject).Coords[Measurement]  ;
            if (x>oRect.Left) and (x<oRect.Right) then
              if (y<oRect.Bottom) and (y>oRect.Top) then
                 begin
                  Result := True;
                  AObject := TGmVisibleObject(FObjects.GmObject[ICount]);
                 end;
          end;
          DrawObject := TGmVisibleObject(FObjects.GmObject[ICount]);
          ObjectRgn := CreateRectRgnIndirect(GmRectPointsToRect(DrawObject.BoundingRect(DrawData)));
          try
            if PtInRegion(ObjectRgn, Round(xInch*600), Round(yInch*600)) then
            begin
              Result := True;
              AObject := TGmVisibleObject(FObjects.GmObject[ICount]);
            end;
//            Result := True;
//            AObject := TGmVisibleObject(FObjects.GmObject[ICount]);
          finally
            Windows.DeleteObject(ObjectRgn);
          end;
        end;
      end;
    finally
      Mfc.Free;
    end;
  finally
    Mf.Free;
  end;
end;

function TGmPage.AddObject(AObject: TGmBaseObject): TGmBaseObject;
begin
  Result := AObject;
  FObjects.AddObject(AObject);
  Changed(Self);
end;

function TGmPage.CreateGmObject(ObjectID: integer): TGmBaseObject;
begin
  Result := nil;
  case ObjectID of
    GM_TEXT_OBJECT_ID         : Result := TGmTextObject.Create(FPageList.ResourceTable);
    GM_TEXTBOX_OBJECT_ID      : Result := TGmTextBoxObject.Create(FPageList.ResourceTable);
    GM_LINE_OBJECT_ID         : Result := TGmLineObject.Create(FPageList.ResourceTable);
    GM_RECTANGLE_OBJECT_ID    : Result := TGmRectangleShape.Create(FPageList.ResourceTable);
    GM_ELLIPSE_OBJECT_ID      : Result := TGmEllipseShape.Create(FPageList.ResourceTable);
    GM_ROUNDRECT_OBJECT_ID    : Result := TGmRoundRectShape.Create(FPageList.ResourceTable);
    GM_GRAPHIC_OBJECT_ID      : Result := TGmGraphicObject.Create(FPageList.ResourceTable);
    GM_ARC_ID                 : Result := TGmArcShape.Create(FPageList.ResourceTable);
    GM_CHORD_ID               : Result := TGmChordShape.Create(FPageList.ResourceTable);
    GM_PIE_ID                 : Result := TGmPieShape.Create(FPageList.ResourceTable);
    GM_PATH_OBJECT_ID         : Result := TGmPathObject.Create(FPageList.ResourceTable);
    GM_CLIPRECT_OBJECT_ID     : Result := TGmClipRectObject.Create(FPageList.ResourceTable);
    GM_CLIPROUNDRECT_OBJECT_ID: Result := TGmClipRoundRectObject.Create(FPageList.ResourceTable);
    GM_CLIPELLIPSE_OBJECT_ID  : Result := TGmClipEllipseObject.Create(FPageList.ResourceTable);
    GM_REMOVE_CLIP_OBJECT_ID  : Result := TGmRemoveClipObject.Create(FPageList.ResourceTable);
    GM_POLYGON_OBJECT_ID      : Result := TGmPolygonObject.Create(FPageList.ResourceTable);
    GM_POLYLINE_OBJECT_ID     : Result := TGmPolylineObject.Create(FPageList.ResourceTable);
    GM_POLYBEZIER_OBJECT_ID   : Result := TGmPolyBezierObject.Create(FPageList.ResourceTable);
    GM_POLYLINETO_OBJECT_ID   : Result := TGmPolylineToObject.Create(FPageList.ResourceTable);
    GM_POLYBEZIERTO_OBJECT_ID : Result := TGmPolyBezierToObject.Create(FPageList.ResourceTable);
  end;
end;

function TGmPage.GetCount: integer;
begin