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

📄 faxfield.bak

📁 将图像转换为传真文件
💻 BAK
📖 第 1 页 / 共 5 页
字号:
    FEditMode := Value;
    for I := fpFieldList.Count - 1 downto 0 do begin
      Field := fpFieldList[I];
      if Field.Selected and (Field is TTextField) then begin
        TTextField(Field).tfEnter(nil);
        if Value then
          TTextField(Field).SetFocus;
      end;
    end;
  end;
end;

procedure TFaxPanel.SetPageWidthInches(AWidth : Double);
begin
  if AWidth <> FPageWidthInches then begin
    FPageWidthInches := AWidth;
    {Recalc pixels per inch and post position messages if necessary}
    SetBounds(Left, Top, Width, Height);
    FNeedsSaving := True;
  end;
end;

procedure TFaxPanel.SetPageHeightInches(AHeight : Double);
begin
  if AHeight <> FPageHeightInches then begin
    FPageHeightInches := AHeight;
    {SetBounds recalcs pixels per inch and calls OnFieldPositionChange if
     necessary}
    SetBounds(Left, Top, Width, Height);
    FNeedsSaving := True;
  end;
end;  

procedure TFaxPanel.SetShowGrid(AShowGrid : Boolean);
begin
  if AShowGrid <> FShowGrid then begin
    FShowGrid := AShowGrid;
    Invalidate;
  end;
end;

procedure TFaxPanel.SetSnapToGrid(ASnapToGrid : Boolean);
var
  I         : Integer;
  NewLeft   : Integer;
  NewTop    : Integer;
  NewWidth  : Integer;
  NewHeight : Integer;
  Field     : TBaseField;
begin
  if ASnapToGrid <> FSnapToGrid then begin
    FSnapToGrid := ASnapToGrid;
    {If SnapToGrid was just turned on, force all existing fields to snap to the grid}
    if FSnapToGrid then begin
      for I := 0 to fpFieldList.Count - 1 do begin
        Field     := fpFieldList[I];
        NewLeft   := Field.Left;
        NewTop    := Field.Top;
        NewWidth  := Field.Width;
        NewHeight := Field.Height;
        {Adjust coordinates to be on grid lines}
        AdjustLeftToGrid(NewLeft);
        AdjustTopToGrid(NewTop);
        AdjustWidthToGrid(NewLeft, NewWidth);
        AdjustHeightToGrid(NewTop, NewHeight);
        Field.SetBounds(NewLeft, NewTop, NewWidth, NewHeight);
      end;
      FNeedsSaving := True;
    end;
  end;
end;

procedure TFaxPanel.SetGridSpacingX(GridSpacing : Integer);
begin
  if (GridSpacing > 0) and (GridSpacing <> FGridSpacingX) then begin
    FGridSpacingX := GridSpacing;
    fpResize(nil);  {Recalculate fpMaxGridLine}
    if FSnapToGrid then begin
      {Turn SnapToGrid off and back on to force all fields to align to the new grid size}
      SetSnapToGrid(False);
      SetSnapToGrid(True);
    end;
    if FShowGrid then
      Invalidate;
  end;
end;

procedure TFaxPanel.SetGridSpacingY(GridSpacing : Integer);
begin
  if (GridSpacing > 0) and (GridSpacing <> FGridSpacingY) then begin
    FGridSpacingY := GridSpacing;
    fpResize(nil);  {Recalculate fpMaxGridLine}
    if FSnapToGrid then begin
      {Turn SnapToGrid off and back on to force all fields to align to the new grid size}
      SetSnapToGrid(False);
      SetSnapToGrid(True);
    end;
    if FShowGrid then
      Invalidate;
  end;
end;

procedure TFaxPanel.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);

  procedure UpdateFieldPositionsAndSizes(OldWidth, OldHeight : Integer);
  var
    I           : Integer;
    NewLeft     : Integer;
    NewTop      : Integer;
    NewWidth    : Integer;
    NewHeight   : Integer;
    Field       : TBaseField;
    WidthRatio  : Double;
    HeightRatio : Double;
  begin
    if OldWidth = 0 then
      WidthRatio := 0.0
    else
      WidthRatio  := Width / OldWidth;
    if OldHeight = 0 then
      HeightRatio := 0.0
    else
      HeightRatio  := Height / OldHeight;
    for I := fpFieldList.Count - 1 downto 0 do begin
      Field := fpFieldList[I];
      with Field do begin
        NewLeft   := Round(Left * WidthRatio);
        NewTop    := Round(Top * HeightRatio);
        NewWidth  := Round(Width * WidthRatio);
        NewHeight := Round(Height * HeightRatio);
        AdjustLeftToGrid(NewLeft);
        AdjustWidthToGrid(NewLeft, NewWidth);
        AdjustTopToGrid(NewTop);
        AdjustHeightToGrid(NewTop, NewHeight);
        SetBounds(NewLeft, NewTop, NewWidth, NewHeight);
        if Selected then begin
          FieldPositionChange(Left, Top, Width, Height);
          {Set Ruler position marks to the new coordinates}
          if Self.Owner is TFaxDesigner then
            (Self.Owner as TFaxDesigner).SetMarkPositions(Left, Top, Width, Height);
        end;
      end;
    end;
  end;  

var
  OldWidth  : Integer;
  OldHeight : Integer;
begin
  OldWidth  := Width;
  Oldheight := Height;
  inherited SetBounds(ALeft, ATop, AWidth, AHeight);

  if FPageWidthInches = 0.0 then
    fpHorzPixelsPerInch := 0.0
  else
    fpHorzPixelsPerInch := Width / FPageWidthInches;
  if FPageHeightInches = 0.0 then
    fpVertPixelsPerInch := 0.0
  else
    fpVertPixelsPerInch := Height / FPageHeightInches;

  {Move and resize all fields so they retain the same relative positions and
   sizes in relation to the FaxPanel size}
  if Assigned(fpFieldList) then
    UpdateFieldPositionsAndSizes(OldWidth, OldHeight);
end;

procedure TFaxPanel.Paint;
var
  X, Y : Integer;
begin
  inherited Paint;
  if FShowGrid then begin
    X := ctGridStart;
    with Canvas do
      while X < Width do begin
        {To improve painting performance, don't draw anything that isn't
         within the current ClipRect}
        if (ClipRect.Left <= X) and (X <= ClipRect.Right) then begin
          Y := ctGridStart;
          while Y < Height do begin
            {To improve painting performance, don't draw anything that isn't
             within the current ClipRect}
            if (ClipRect.Top <= Y) and (Y <= ClipRect.Bottom) then
              Canvas.Pixels[X,Y] := clBlack;
            Y := Y + FGridSpacingY;
          end;
        end;
        X := X + FGridSpacingX;
      end;
  end;
end;

procedure TFaxPanel.fpResize(Sender : TObject);
var
  Extent      : Integer;
  NrGridLines : Integer;
begin
  {Calculate the coordinates of the rightmost and bottommost grid lines given
   the current panel size, and store the results in fpMaxGridLine}
  Extent := Width - ctGridStart;
  NrGridLines := Extent div FGridSpacingX;
  fpMaxGridLine.X := (NrGridLines * FGridSpacingX) + ctGridStart;
  Extent := Height - ctGridStart;
  NrGridLines := Extent div FGridSpacingY;
  fpMaxGridLine.Y := (NrGridLines * FGridSpacingY) + ctGridStart;
end;

procedure TFaxPanel.fpMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  {If user clicked on a field, translate the coordinates to MainPanel
   coordinates and set fpMouseAnchor to those coordinates}
  if Sender is TBaseField then begin
    ConvertCoords(Sender as TControl, Self, X, Y);
    fpMouseAnchor := Point(X, Y);
    if (Button = mbLeft) and not (ssDouble in Shift) then
      fpIsMouseDown := True;
  end else
    fpMouseAnchor := Point(X, Y);
end;

procedure TFaxPanel.fpMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  IsFieldSelected : Boolean;
begin
  case Button of
    mbRight : if Sender is TControl then begin
                ConvertCoords(Sender as TControl, Self, X, Y);
                fpMouseAnchor := Point(X, Y);
              end;
    mbLeft :
      begin
        DeselectAllFields;
        IsFieldSelected := False;  {No fields are currently selected}

        {If user clicked on a field, mark it as selected}
        if Sender is TBaseField then begin
          IsFieldSelected := True;
          fpIsMouseDown   := False;
          with Sender as TBaseField do begin
            Selected := True;
            {Set Ruler position marks to the new coordinates}
            (Self.Owner as TFaxDesigner).SetMarkPositions(Left, Top, Width, Height);
          end;
        end else
          {Turn Ruler position marks off since no fields are selected}
          (Self.Owner as TFaxDesigner).SetMarkPositions(-1, -1, -1, -1);

        FieldSelectionChange(IsFieldSelected);
        if IsFieldSelected then
          with Sender as TBaseField do
            FieldPositionChange(Left, Top, Width, Height);
      end;
  end;
end;

procedure TFaxPanel.fpMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
var
  XDiff     : Integer;
  YDiff     : Integer;
  OldLeft   : Integer;
  OldTop    : Integer;
  NewLeft   : Integer;
  NewTop    : Integer;
  NewWidth  : Integer;
  NewHeight : Integer;
begin
  if Sender is TBaseField then begin
    if fpIsMouseDown and (ssLeft in Shift) then begin
      if fpDragging then
        Exit;
      fpDragging := True;
      try
        case (Sender as TBaseField).StretchMode of
          smDrag :
            begin
              {TextFields can't be moved while in Edit Mode}
              if FEditMode and (Sender is TTextField) then
                Exit;
              ConvertCoords(Sender as TControl, Self, X, Y);
              Constrain(X, 0, Width);
              Constrain(Y, 0, Height);
              XDiff := X - fpMouseAnchor.X;
              YDiff := Y - fpMouseAnchor.Y;
              with Sender as TBaseField do begin
                NewLeft := Left + XDiff;
                NewTop  := Top + YDiff;
                {Ensure field remains entirely within Self}
                Constrain(NewLeft, 0, Self.Width  - Width);
                Constrain(NewTop,  0, Self.Height - Height);

                if FSnapToGrid then begin
                  {Adjust NewLeft and NewTop to be on grid lines if necessary}
                  AdjustLeftToGrid(NewLeft);
                  AdjustTopToGrid(NewTop);

                  {Make sure we haven't moved past the rightmost or bottommost grid line}
                  if NewLeft + Width - 1 > fpMaxGridLine.X then
                    NewLeft := NewLeft - FGridSpacingX;
                  if NewTop + Height - 1 > fpMaxGridLine.Y then
                    NewTop := NewTop - FGridSpacingY;
                end;

                OldLeft := Left;
                OldTop  := Top;
                SetBounds(NewLeft, NewTop, Width, Height);
              end;
              {Set fpMouseAnchor to new mouse position, but ONLY if the field
               position has changed. If SnapToGrid is enabled, the field position
               might not have changed even though the mouse position did.}
              fpMouseAnchor.X := fpMouseAnchor.X + NewLeft - OldLeft;
              fpMouseAnchor.Y := fpMouseAnchor.Y + NewTop - OldTop;
            end;
          smE :
            with Sender as TBaseField do begin
              NewWidth := X;
              Constrain(NewWidth, 0, Self.Width - Left);
              AdjustWidthToGrid(Left, NewWidth);

              SetBounds(Left, Top, NewWidth, Height);
              if Width <= 1 then
                StretchMode := smW;
            end;
          smW :
            with Sender as TBaseField do begin
              NewLeft := Left + X;
              {Prevent creeping to right when switching from smW to smE}
              Constrain(NewLeft, 0, Left + Width);
              AdjustLeftToGrid(NewLeft);

              NewWidth := Width + Left - NewLeft;
              Constrain(NewWidth, 0, Self.Width - NewLeft);
              AdjustWidthToGrid(NewLeft, NewWidth);

              SetBounds(NewLeft, Top, NewWidth, Height);
              if Width <= 1 then
                StretchMode := smE;
            end;
          smS :
            with Sender as TBaseField do begin
              NewHeight := Y;
              Constrain(NewHeight, 0, Self.Height - Top);
              AdjustHeightToGrid(Top, NewHeight);

              SetBounds(Left, Top, Width, NewHeight);
              if Height <= 1 then
                StretchMode := smN;
            end;
          smN :
            with Sender as TBaseField do begin
              NewTop := Top + Y;
              {Prevent creeping down when switching from smN to smS}
              Constrain(NewTop, 0, Top + Height);
              AdjustTopToGrid(NewTop);

              NewHeight := Height + Top - NewTop;
              Constrain(NewHeight, 0, Self.Height - NewTop);
              AdjustHeightToGrid(NewTop, NewHeight);

              SetBounds(Left, NewTop, Width, NewHeight);
              if Height <= 1 then
                StretchMode := smS;
            end;
          smNE :
            with Sender as TBaseField do begin
              NewTop := Top + Y;
              {Prevent creeping down when switching from smN? to smS?}
              Constrain(NewTop, 0, Top + Height);
              AdjustTopToGrid(NewTop);

              NewWidth := X;
              Constrain(NewWidth, 0, Self.Width - Left);
              AdjustWidthToGrid(Left, NewWidth);

              NewHeight := Height + Top - NewTop;
              Constrain(NewHeight, 0, Self.Height - NewTop);
              AdjustHeightToGrid(NewTop, NewHeight);

              SetBounds(Left, NewTop, NewWidth, NewHeight);
              if Width <= 1 then begin
                if Height <= 1 then
                  StretchMode := smSW
                else
                  StretchMode := smNW;
              end else if Height <= 1 then
                StretchMode := smSE;
            end;

⌨️ 快捷键说明

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