faxfield.bak

将图像转换为传真文件

  P : TPoint;
begin
  P.X := X;
  P.Y := Y;
  P   := Target.ScreenToClient(Source.ClientToScreen(P));
  X   := P.X;
  Y   := P.Y;
end;


{*** TStretchHandle *}

constructor TStretchHandle.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Canvas.Brush.Color := clBlack;
  Canvas.Brush.Style := bsSolid;
  SetBounds(Top, Left, ctStretchHandleSize, ctStretchHandleSize);
end;

procedure TStretchHandle.Paint;
begin
  Canvas.FillRect(Rect(0, 0, Width, Height));
end;

{------------------------------ TBaseField ---------------------------------}

constructor TBaseField.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Brush.Color := clWindow;
  Brush.Style := bsClear;
  DragCursor  := crCross;
  DragMode    := dmManual;
  Pen.Mode    := pmCopy;
  Pen.Style   := psDashDot;
  Pen.Color   := clBlack;
  Pen.Width   := 1;
  Shape       := stRectangle;
  Visible     := False; {Caller must make visible after setting size and position}
  SetSelected(False);
end;

procedure TBaseField.bfMouseDown(Sender: TObject; Button: TMouseButton;
                                 Shift: TShiftState; X, Y: Integer);
begin
  if Parent is TPanel then begin
    {If Sender is one of the StretchHandles, convert its coordinates to our own}
    if Sender is TStretchHandle then
      ConvertCoords(Sender as TStretchHandle, Self, X, Y);
    (Parent as TPanel).OnMouseDown(Self, Button, Shift, X, Y);
  end;
end;

procedure TBaseField.bfMouseUp(Sender: TObject; Button: TMouseButton;
                               Shift: TShiftState; X, Y: Integer);
begin
  if Parent is TPanel then begin
    {If Sender is one of the StretchHandles, convert its coordinates to our own}
    if Sender is TStretchHandle then
      ConvertCoords(Sender as TStretchHandle, Self, X, Y);
    (Parent as TPanel).OnMouseUp(Self, Button, Shift, X, Y);
  end;
end;

procedure TBaseField.bfMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  if Parent is TPanel then begin
    {If Sender is one of the StretchHandles, convert its coordinates to our own}
    if Sender is TStretchHandle then begin
      ConvertCoords(Sender as TStretchHandle, Self, X, Y);
      if not (ssLeft in Shift) then
        StretchMode := (Sender as TStretchHandle).HandlePosition;
    end else
      StretchMode := smDrag;
    (Parent as TPanel).OnMouseMove(Self, Shift, X, Y);
  end;
end;

procedure TBaseField.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
var
  I : Integer;
  P : TPoint;
begin
  inherited SetBounds(ALeft, ATop, AWidth, AHeight);

  {Move all StretchHandles to the proper positions}
  for I := Low(bfStretchHandles) to High(bfStretchHandles) do
    if Assigned(bfStretchHandles[I]) then
      with bfStretchHandles[I] do begin
        P := GetStretchHandleCoords(HandlePosition);
        SetBounds(P.X, P.Y, Width, Height);
      end;
end;

procedure TBaseField.SetParent(AParent: TWinControl);

  function CreateStretchHandle(WhichHandle : TStretchModes) : TStretchHandle;
  var
    P : TPoint;
  begin
    P := GetStretchHandleCoords(WhichHandle);
    Result := TStretchHandle.Create(Self);
    with Result do begin
      HandlePosition := WhichHandle;
      Parent         := AParent;
      Visible        := Selected;
      OnMouseDown    := bfMouseDown;
      OnMouseUp      := bfMouseUp;
      OnMouseMove    := bfMouseMove;
      SetBounds(P.X, P.Y, Width, Height);
    end;
  end;

const
  ctStretchHandleCorners :
    array[Low(TStretchHandleArray)..High(TStretchHandleArray)] of TStretchModes =
      (smNW, smN, smNE, smE, smSE, smS, smSW, smW);
var
  I : Integer;
begin
  if AParent <> Parent then begin
    inherited SetParent(AParent);
    if Assigned(AParent) then begin
      OnMouseDown := (AParent as TPanel).OnMouseDown;
      OnMouseUp   := (AParent as TPanel).OnMouseUp;
      OnMouseMove := (AParent as TPanel).OnMouseMove;
      {If StretchHandles already exist, destroy them}
      for I := Low(bfStretchHandles) to High(bfStretchHandles) do
        if Assigned(bfStretchHandles[I]) then begin
          bfStretchHandles[I].Free;
          bfStretchHandles[I] := nil;
        end;
      {Create new StretchHandles}
      for I := Low(bfStretchHandles) to High(bfStretchHandles) do
        bfStretchHandles[I] := CreateStretchHandle(ctStretchHandleCorners[I]);
    end else begin
      OnMouseDown := nil;
      OnMouseUp   := nil;
      OnMouseMove := nil;
    end;
  end;
end;

procedure TBaseField.SetSelected(IsSelected : Boolean);
var
  I : Integer;
begin
  if IsSelected <> FSelected then begin
    FSelected := IsSelected;
    for I := Low(bfStretchHandles) to High(bfStretchHandles) do
      with bfStretchHandles[I] do begin
        Visible := FSelected;
        {BringToFront to ensure that if this is a TImageField, StretchHandle
         isn't partially hidden behind the image}
        if FSelected then
          BringToFront;
      end;
    Refresh;
  end;
end;

function TBaseField.GetStretchHandleCoords(WhichHandle : TStretchModes) : TPoint;
  {-Returns the coordinates (Left, Top) where the StretchHandle should be drawn}
var
  Offset : Integer;
begin
  with Result do
    case WhichHandle of
      smNW : begin
               Offset := ctStretchHandleSize div 2;
               X      := Left - Offset;
               Y      := Top - Offset;
             end;
      smN  : begin
               Offset := ctStretchHandleSize div 2;
               X      := Left + (Width div 2) - Offset;
               Y      := Top - Offset;
             end;
      smNE : begin
               Offset := (ctStretchHandleSize + 1) div 2;
               X      := Left + Width - Offset;
               Offset := ctStretchHandleSize div 2;
               Y      := Top - Offset;
             end;
      smE  : begin
               Offset := (ctStretchHandleSize + 1) div 2;
               X      := Left + Width - Offset;
               Offset := ctStretchHandleSize div 2;
               Y      := Top + (Height div 2) - Offset;
             end;
      smSE : begin
               Offset := (ctStretchHandleSize + 1) div 2;
               X      := Left + Width - Offset;
               Y      := Top + Height - Offset;
             end;
      smS  : begin
               Offset := ctStretchHandleSize div 2;
               X      := Left + (Width div 2) - Offset;
               Offset := (ctStretchHandleSize + 1) div 2;
               Y      := Top + Height - Offset;
             end;
      smSW : begin
               Offset := ctStretchHandleSize div 2;
               X      := Left - Offset;
               Offset := (ctStretchHandleSize + 1) div 2;
               Y      := Top + Height - Offset;
             end;
      smW  : begin
               Offset := ctStretchHandleSize div 2;
               X      := Left - Offset;
               Y      := Top + (Height div 2) - Offset;
             end;
      else begin
        X := 0;
        Y := 0;
      end;
    end;
end;

procedure TBaseField.Read(Stream : TStream);
var
  FieldRec : TFieldRecord;
begin
  Stream.ReadBuffer(FieldRec, SizeOf(FieldRec));
  if Parent is TFaxPanel then
    with (Parent as TFaxPanel), FieldRec do begin
      Self.Left   := HorzInchesToPixels(frLeftInches);
      Self.Top    := VertInchesToPixels(frTopInches);
      Self.Width  := HorzInchesToPixels(frWidthInches);
      Self.Height := VertInchesToPixels(frHeightInches);
    end;
end;

procedure TBaseField.Write(Stream : TStream);
var
  FieldRec : TFieldRecord;
begin
  FillChar(FieldRec, SizeOf(FieldRec), 0);
  if Parent is TFaxPanel then
    with (Parent as TFaxPanel), FieldRec do begin
      frLeftInches   := HorzPixelsToInches(Self.Left);
      frTopInches    := VertPixelsToInches(Self.Top);
      frWidthInches  := HorzPixelsToInches(Self.Width);
      frHeightInches := VertPixelsToInches(Self.Height);
    end;
  Stream.WriteBuffer(FieldRec, SizeOf(FieldRec));
end;


{*** TTextField ***}

constructor TTextField.Create(AOwner: TComponent);
const
  ctDefWidth = 200;
var
  Items1:TMenuItem;
begin
  inherited Create(AOwner);

  Pen.Style := psClear;  {Don't need the TShape border because FMemo will have a border}
  FpopupMenu:=TPopupMenu.Create(self);
  Items1:=TMenuItem.Create(self);
  Items1.Caption:='载入文本';
  Items1.OnClick:=OnLoadFromFile;
  FPopupmenu.Items.Add(items1);
  FMemo := TMemo.Create(Self);
  FMemo.PopupMenu:=FPopupMenu;
  with FMemo do begin
    Ctl3D       := False;
    ParentCtl3D := False;
    WordWrap    := True;
    OnMouseDown := bfMouseDown;
    OnMouseUp   := bfMouseUp;
    OnMouseMove := bfMouseMove;
    OnDblClick  := MemoDblClick;
    OnEnter     := tfEnter;
    OnExit      := tfExit;
  end;
  FMemo.Font.Name:='宋体';
  FMemo.Font.Size:=11;
  SetBounds(Left, Top, ctDefWidth, Height);
end;

procedure TTextField.Draw(ACanvas : TCanvas);

  procedure ReplaceTags(TagStr     : string;
                  const ReplaceStr : string;
                    var TargetStr  : string);
  var
    Posn    : Integer;
    TempStr : string;
  begin
    TagStr := UpperCase(TagStr);
    repeat
      TempStr := UpperCase(TargetStr);
      Posn    := Pos(TagStr, TempStr);
      if Posn > 0 then begin
        Delete(TargetStr, Posn, Length(TagStr));
        Insert(ReplaceStr, TargetStr, Posn);
      end;
    until Posn = 0;
  end;

var
  I          : Integer;
  X, Y       : Integer;
  TextHeight : Integer;
  S          : string;
  DateStr    : string;
  TimeStr    : string;
begin
  with FMemo do begin
    ACanvas.Font := Font;
    TextHeight := GetTextHeight;

    {Format date string to use for $D replacement tag}
    DateStr := DateToStr(Date);
    {Format time string to use for $T replacement tag}
    TimeStr := TimeToStr(Time);
    Delete(TimeStr, Length(TimeStr) - 5, 4);  {Strip off the seconds}
    TimeStr := LowerCase(TimeStr); {Convert AM or PM to lower case}

    X := Round((Parent as TFaxPanel).DrawAdjustFactor * Self.Left);
    for I := 0 to Lines.Count - 1 do begin
      S := Lines[I];
      {Look for replaceable tags and do replacements as required}
      ReplaceTags('$D', DateStr, S);
      ReplaceTags('$T', TimeStr, S);
      ReplaceTags('$N', IntToStr((Parent as TFaxPanel).PageCount), S);
      ReplaceTags('$P', IntToStr((Parent as TFaxPanel).PageNumber), S);
      ReplaceTags('$F', (Parent as TFaxPanel).Sender, S);
      ReplaceTags('$R', (Parent as TFaxPanel).Recipient, S);
      ReplaceTags('$S', (Parent as TFaxPanel).PageTitle, S);
      ReplaceTags('$I', (Parent as TFaxPanel).StationID, S);

      Y := Round((Parent as TFaxPanel).DrawAdjustFactor * (Self.Top + (I * TextHeight)));
      ACanvas.TextOut(X, Y, S);
    end;
  end;
end;

procedure TTextField.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
  inherited SetBounds(ALeft, ATop, AWidth, AHeight);

  if Assigned(FMemo) then
    FMemo.SetBounds(ALeft, ATop, AWidth, AHeight);
end;

procedure TTextField.SetParent(AParent: TWinControl);
var
  NewHeight : Integer;
begin
  inherited SetParent(AParent);

  if Assigned(FMemo) then begin
    FMemo.Parent := AParent;
    {If no text has yet been entered, get the height of one row of text for the
     current font, and adjust the field height to match}
    if (FMemo.Text = '') and Assigned(AParent) then begin
      NewHeight := GetTextHeight + 4;
      {If SnapToGrid is enabled, adjust height to fall on a grid line}
      with Parent as TFaxPanel do
        if SnapToGrid then
          AdjustHeightToGrid(Top, NewHeight);
      SetBounds(Left, Top, Width, NewHeight);
    end;
    if AParent is TFaxPanel then
      FMemo.OnChange := (AParent as TFaxPanel).FieldChange;
  end;
end;

procedure TTextField.SetFocus;
begin
  FMemo.SetFocus;
end;

function TTextField.GetTextHeight : Integer;
var
  Canvas     : TCanvas;
  TextMetric : TTextMetric;
begin
  Canvas := TCanvas.Create;
  try
    Canvas.Handle := GetDC(FMemo.Handle);
    try
      Canvas.Font := FMemo.Font;
      GetTextMetrics(Canvas.Handle, TextMetric);
      with TextMetric do
        Result := tmHeight + tmExternalLeading;