faxfield.bak

将图像转换为传真文件

          smSW :
            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);

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

              SetBounds(NewLeft, Top, NewWidth, NewHeight);
              if Width <= 1 then begin
                if Height <= 1 then
                  StretchMode := smNE
                else
                  StretchMode := smSE;
              end else if Height <= 1 then
                StretchMode := smNW;
            end;
          smSE :
            with Sender as TBaseField do begin
              NewWidth := X;
              Constrain(NewWidth, 0, Self.Width - Left);
              AdjustWidthToGrid(Left, NewWidth);

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

              SetBounds(Left, Top, NewWidth, NewHeight);
              if Width <= 1 then begin
                if Height <= 1 then
                  StretchMode := smNW
                else
                  StretchMode := smSW;
              end else if Height <= 1 then
                StretchMode := smNE;
            end;
          smNW :
            with Sender as TBaseField do begin
              NewLeft := Left + X;
              {Prevent creeping to right when switching from sm?W to sm?E}
              Constrain(NewLeft, 0, Left + Width);
              AdjustLeftToGrid(NewLeft);

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

              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(NewLeft, NewTop, NewWidth, NewHeight);
              if Width <= 1 then begin
                if Height <= 1 then
                  StretchMode := smSE
                else
                  StretchMode := smNE;
              end else if Height <= 1 then
                StretchMode := smSW;
            end;
        end;
        Application.ProcessMessages;
      finally
        fpDragging := False;
      end;

      with Sender as TBaseField do
        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;
      FNeedsSaving := True;
    end;
    StretchMode := (Sender as TBaseField).StretchMode;

  end else
    StretchMode := smNone;
end;

procedure TFaxPanel.SizeMove(Sender : TObject; Key : Word; Shift : TShiftState);
var
  X, Y      : Integer;
  NewWidth  : Integer;
  NewHeight : Integer;
  Delta     : TPoint;
  I, J      : Integer;
  BF        : TBaseField;
begin
  if Sender is TBaseField then begin
    case Key of
      VK_UP    : Delta := Point(0, -1);
      VK_DOWN  : Delta := Point(0, 1);
      VK_RIGHT : Delta := Point(1, 0);
      VK_LEFT  : Delta := Point(-1, 0);
    else
      if (Key = VK_TAB) and (Shift = []) then begin
        {select next object}
        J := -1;
        for I := 0 to FieldCount-1 do
          if Field[I].Selected then begin
            J := I;
            Break;
          end;
        if J >= 0 then begin
          Field[J].Selected := False;
          Inc(J);
          if J >= FieldCount then
            J := 0;
          Field[J].Selected := True;
          Invalidate;
        end;
      end else if (Key = VK_TAB) and (Shift = [ssShift]) then begin
        {select previous object}
        J := -1;
        for I := 0 to FieldCount-1 do
          if Field[I].Selected then begin
            J := I;
            Break;
          end;
        if J >= 0 then begin
          Field[J].Selected := False;
          Dec(J);
          if J < 0 then
            J := FieldCount-1;
          Field[J].Selected := True;
          Invalidate;
        end;
      end;
      Exit;
    end;

    BF := Sender as TBaseField;
    if (ssShift in Shift) then begin
      {size}
      X := BF.Width + Delta.X;
      Y := BF.Height + Delta.Y;
      NewWidth := X;
      NewHeight := Y;
      Constrain(NewWidth, 0, Self.Width - BF.Left);
      Constrain(NewHeight, 0, Self.Height - BF.Top);
      BF.SetBounds(BF.Left, BF.Top, NewWidth, NewHeight);
    end else if (ssCtrl in Shift) then begin
      {move}
      X := BF.Left + Delta.X;
      Y := BF.Top + Delta.Y;
      Constrain(X, 0, Width);
      Constrain(Y, 0, Height);
      {Ensure field remains entirely within Self}
      Constrain(X, 0, Self.Width  - BF.Width);
      Constrain(Y,  0, Self.Height - BF.Height);
      BF.SetBounds(X, Y, BF.Width, BF.Height);
    end;
    
    with Sender as TBaseField do
      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;
    FNeedsSaving := True;
  end;
end;

procedure TFaxPanel.FieldSelectionChange(IsFieldSelected : Boolean);
  {-Calls OnFieldSelectionChange event handler when a field becomes
    deselected or when a new field becomes selected}
begin
  if Assigned(FOnFieldSelectionChange) then
    FOnFieldSelectionChange(IsFieldSelected);
end;

procedure TFaxPanel.FieldPositionChange(ALeft, ATop, AWidth, AHeight : Integer);
  {-Calls OnFieldPositionChange event handler when the location or size of
    the currently-selected field changes}
begin
  if Assigned(FOnFieldPositionChange) then
    FOnFieldPositionChange(ALeft, ATop, AWidth, AHeight);
end;

procedure TFaxPanel.FieldChange(Sender : TObject);
begin
  FNeedsSaving := True;
end;

procedure TFaxPanel.AdjustLeftToGrid(var ALeft : Integer);
begin
  if FSnapToGrid then begin
    if ALeft < ctGridStart then
      ALeft := ctGridStart
    else if ALeft > fpMaxGridLine.X then
      ALeft := fpMaxGridLine.X
    else
      ALeft := (Round((ALeft - ctGridStart) / FGridSpacingX) * FGridSpacingX) + ctGridStart;
  end;
end;

procedure TFaxPanel.AdjustTopToGrid(var ATop : Integer);
begin
  if FSnapToGrid then begin
    if ATop < ctGridStart then
      ATop := ctGridStart
    else if ATop > fpMaxGridLine.Y then
      ATop := fpMaxGridLine.Y
    else
      ATop := (Round((ATop - ctGridStart) / FGridSpacingY) * FGridSpacingY) + ctGridStart;
  end;
end;

procedure TFaxPanel.AdjustWidthToGrid(ALeft : Integer; var AWidth : Integer);
begin
  if FSnapToGrid then begin
    if AWidth < 0 then
      AWidth := 0
    else if ALeft + AWidth > fpMaxGridLine.X then
      AWidth := fpMaxGridLine.X - ALeft
    else
      AWidth := Round((AWidth) / FGridSpacingX) * FGridSpacingX + 1;
  end;
end;

procedure TFaxPanel.AdjustHeightToGrid(ATop : Integer; var AHeight : Integer);
begin
  if FSnapToGrid then begin
    if AHeight < 0 then
      AHeight := 0
    else if ATop + AHeight > fpMaxGridLine.Y then
      AHeight := fpMaxGridLine.Y - ATop
    else
      AHeight := Round((AHeight) / FGridSpacingY) * FGridSpacingY + 1;
  end;
end;

function TFaxPanel.GetDrawAdjustFactor : Double;
const
  ctFaxWidthInPixels = 1728;  {Faxes are 1728 pixels in width}
begin
  if Width = 0 then
    Result := 0.0
  else
    Result := ((ctFaxWidthInPixels / 2) - 10) / Width;
end;

function TFaxPanel.GetDrawWidth : Integer;
begin
  Result := Round(Width * DrawAdjustFactor);
end;

function TFaxPanel.GetDrawHeight : Integer;
begin
  Result := Round(Height * DrawAdjustFactor);
end;

procedure TFaxPanel.SetStretchMode(NewStretchMode : TStretchModes);
begin
  if NewStretchMode <> FStretchMode then begin
    FStretchMode := NewStretchMode;
    case FStretchMode of
      smN, smS   : Cursor := crSizeNS;
      smE, smW   : Cursor := crSizeWE;
      smNW, smSE : Cursor := crSizeNWSE;
      smNE, smSW : Cursor := crSizeNESW;
      else Cursor := crDefault;
    end;
  end;
end;

procedure TFaxPanel.FieldPositionChangeForSelectedField;
var
  I     : Integer;
  Field : TBaseField;
begin
  for I := 0 to fpFieldList.Count - 1 do begin
    Field := fpFieldList[I];
    with Field do
      if Selected then begin
        FieldPositionChange(Left, Top, Width, Height);
        Break; {Only one field can be selected at a time and we just found it, so exit loop}
      end;
  end;
end;

procedure TFaxPanel.Write(Stream : TStream);
var
  I         : Integer;
  NumFields : LongInt;
  Field     : TBaseField;
begin
  {Write the number of fields to the stream}
  NumFields := fpFieldList.Count;
  Stream.WriteBuffer(NumFields, SizeOf(NumFields));

  {Write out each field's information}
  for I := 0 to fpFieldList.Count - 1 do begin
    Field := fpFieldList[I];
    Field.Write(Stream);
  end;

  {We just saved, so set NeedsSaving to False}
  FNeedsSaving := False;
end;

procedure TFaxPanel.Read(Stream : TStream);
var
  FieldType : Byte;
  I         : Integer;
  NumFields : LongInt;
  Field     : TBaseField;
begin
  {Clear out fpFieldList to ensure we're starting off with an empty FaxPanel}
  DeleteAllFields;

  {Read the number of fields that were written out to the stream}
  Stream.ReadBuffer(NumFields, SizeOf(NumFields));

  {For each field, create a new field of the proper type, and then let it read
   itself in}
  for I := 1 to NumFields do begin
    Field := nil;
    Stream.ReadBuffer(FieldType, SizeOf(FieldType));
    case FieldType of
      ftTextField  : Field := AddTextField;
      ftImageField : Field := AddImageField;
    end;
    if Assigned(Field) then
      Field.Read(Stream);
  end;

  {No changes have been made yet, so set NeedsSaving to False}
  FNeedsSaving := False;
end;

procedure TFaxPanel.Draw(ACanvas : TCanvas);
var
  I     : Integer;
  Field : TBaseField;
begin
  {Draw each field}
  for I := 0 to fpFieldList.Count - 1 do begin
    Field := fpFieldList[I];
    Field.Draw(ACanvas);
  end;
end;

function TFaxPanel.HorzPixelsToInches(P : Integer) : Double;
begin
  if fpHorzPixelsPerInch = 0.0 then
    Result := 0.0
  else
    Result := P / fpHorzPixelsPerInch;
end;

function TFaxPanel.VertPixelsToInches(P : Integer) : Double;
begin
  if fpVertPixelsPerInch = 0.0 then
    Result := 0.0
  else
    Result := P / fpVertPixelsPerInch;
end;

function TFaxPanel.HorzInchesToPixels(Inches : Double) : Integer;
begin
  Result := Round(Inches * fpHorzPixelsPerInch);
end;

function TFaxPanel.VertInchesToPixels(Inches : Double) : Integer;
begin
  Result := Round(Inches * fpVertPixelsPerInch);
end;

procedure TFaxPanel.DeselectAllFields;
var
  I     : Integer;
  Field : TBaseFi