ucommentconstructorform.pas

Delphi函数工厂。。。。。。。。。。。。。

  mmComment.Lines.BeginUpdate;
  try
    mmComment.Clear;
    FillCharCount := seLineWidth.Value -
      (Length(TCommentChar[cbCommentKeyChar.ItemIndex]) - 2);

    ///////////////////////////////
    //  创建首行和空行
    ///////////////////////////////
    iLineStr := StringOfChar(TFillChar[cbFillChar.ItemIndex], FillCharCount);
    iEmptyLineStr := StringOfChar(' ', FillCharCount);
    FirstAndLastLineStr := Format(TCommentChar[cbCommentKeyChar.ItemIndex], [iLineStr]);
    iEmptyLineStr := Format(TCommentChar[cbCommentKeyChar.ItemIndex], [iEmptyLineStr]);
    mmComment.Lines.Add(FirstAndLastLineStr);
    AddEmptyStrIfAlowed(iEmptyLineStr);

    ///////////////////////////////////////
    //   生成单元名
    ///////////////////////////////////////
    if edtUnit.Text <> '' then
    begin
      /////////////////////////////////////
      //  注意，下面不再像以前那样直接调用
      //  mmComment.Add方法添加行，而是直接
      //  用了AddCommentStr。这样做有几个
      //  考虑，第一，如果用户输入了超长的字符（可能
      //  用户会在Unit名后面加上括号注明一些
      //  说明）的情况下实现自动换行（注意，每行
      //  的长度虽然初始定为70个字符，但用户可以
      //  设置的更小，所以这里增加这样的功能很有
      //   必要。；二、同样 ，
      //  对于下面的Author等内容一样有效
      /////////////////////////////////////
      AddCommentStr(TLanguageComment[cbLanguage.ItemIndex][0] +
        edtUnit.Text, iEmptyLineStr, FillCharCount - 4);
      AddEmptyStrIfAlowed(iEmptyLineStr);
    end;

    ///////////////////////////////////////
    //   作者名信息
    ///////////////////////////////////////
    if edtAuthor.Text <> '' then
    begin
      AddCommentStr(TLanguageComment[cbLanguage.ItemIndex][1] +
        edtAuthor.Text, iEmptyLineStr, FillCharCount - 4);
      AddEmptyStrIfAlowed(iEmptyLineStr);
    end;

    ///////////////////////////////////////
    //   版本
    ///////////////////////////////////////
    if edtVer.Text <> '' then
    begin
      AddCommentStr(TLanguageComment[cbLanguage.ItemIndex][2] +
        edtVer.Text, iEmptyLineStr, FillCharCount - 4);
      AddEmptyStrIfAlowed(iEmptyLineStr);
    end;

    ///////////////////////////////////////
    //   日期
    ///////////////////////////////////////
    AddCommentStr(TLanguageComment[cbLanguage.ItemIndex][3] +
      DateToStr(dtpDate.Date), iEmptyLineStr, FillCharCount - 4);
    AddEmptyStrIfAlowed(iEmptyLineStr);

    ////////////////////////////////////////
    //  描述
    ////////////////////////////////////////
    if Trim(mmDescription.Text) <> '' then
    begin
      ////////////////////////////
      //  把每行的循环调用从
      //  AddCommentStr 过程中
      //  放到这里有两个目的。
      //  1是为了配合上面的BeginUpdate和下面的
      //  EndUpdate方法的调用，使得mmComment
      //  减少闪烁的情况。
      //  2是为了更加合理的分割代码。
      ////////////////////////////
      for I := 0 to mmDescription.Lines.Count - 1 do
      begin
        if I = 0 then
          iDescriptionHead := TLanguageComment[cbLanguage.ItemIndex][4]
        else
          iDescriptionHead := Blanks;
        AddCommentStr(iDescriptionHead + mmDescription.Lines[I], iEmptyLineStr,
          FillCharCount - 4);
      end;
      AddEmptyStrIfAlowed(iEmptyLineStr);
    end;

    ////////////////////////////////////////
    //  结尾行
    ////////////////////////////////////////
    mmComment.Lines.Add(FirstAndLastLineStr);
  finally
    mmComment.Lines.EndUpdate;
  end;
end;

procedure TCommentConstructorForm.AddCommentStr(ALineStr: string;
  const EmptyLine: string; const MaxLineLength: Integer);

  function CannotCut(const S: string; const Index: Integer): Boolean;
  begin
    Result := False;
    case ByteType(S, Index) of
      mbSingleByte:
        begin
          case S[Index] of
            '0'..'9', 'a'..'z', 'A'..'Z', '(', '\', '[', '{': Result := True;
          end;
        end;
      mbLeadByte: Result := True;
    end;
  end;

  function GetCutPos(const ALine: string; const MaxPos: Integer): Integer;
  var
    lCount, cCount: Integer;
  begin
    lCount := Length(ALine);
    if lCount <= MaxPos then
    begin
      Result := lCount;
      Exit;
    end;
    for cCount := MaxPos downto 1 do
      if not CannotCut(ALine, cCount) then
        break; //因为ALine前面是Blanks,所以肯定会执行此句,而不会出现死循环
        ////////////////////////////////////
        //  对，你说的没错，的确总会在这里
        //  break。但是，这时会出现一个问题，
        //  当输入的字符超长的时候，会出现第一行
        //  为空的现象.
        ////////////////////////////////////
    ////////////////////////////////////
    //   下面我又增加如下算法，用意
    //   就是防止出现：
    //   ddddddddddddddddddddd...dddd aaa bbb
    //   的时候截断位置却成了从 b... 这里截断
    //   的问题。使用下面的代码后，截断位置
    //   就在 a... 处。
    ///////////////////////////////////
    if cCount <= Length(Blanks) then
      for cCount := MaxPos to lCount do
        if not CannotCut(ALine, cCount) then
          break;
    Result := cCount;
  end;
var
  Pos: Integer;
begin
  repeat
    Pos := GetCutPos(ALineStr, MaxLineLength);
    mmComment.Lines.Add(MakeMidStr(EmptyLine, Copy(ALineStr, 1, Pos)));
    Delete(ALineStr, 1, Pos);
    ALineStr := Blanks + ALineStr;
  until (ALineStr = Blanks) or (Trim(ALineStr) = '');
end;
 //AddCommentStr过程结束处

procedure TCommentConstructorForm.edtUnitChange(Sender: TObject);
begin
  inherited;
  CreateCommentStrings;
end;

procedure TCommentConstructorForm.btnCopyClick(Sender: TObject);
begin
  inherited;
  mmComment.SelectAll;
  mmComment.CopyToClipboard;
end;

procedure TCommentConstructorForm.mmCommentChange(Sender: TObject);
begin
  inherited;
  btnCopy.Enabled := mmComment.Text <> '';
end;



{ TCommentDialog }

constructor TCommentDialog.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FModuleForm := TCommentConstructorForm.Create(Self);
  FModuleForm.FCommentDialog := Self;
  FModuleForm.FDialogModule := Self;
  FModuleForm.Caption := SDefultCommentDialogTitle;

  FWindowForm := FModuleForm;
  FPageIndex := 0;
end;

destructor TCommentDialog.Destroy;
begin
  if FModuleForm.Visible then FModuleForm.Close;
  FModuleForm.Free;
  inherited Destroy;
end;

function TCommentDialog.Execute: Boolean;
begin
  inherited Execute;
  if (Self.FPageIndex >= 0)
    and (Self.FPageIndex <= FModuleForm.pcCommentKinds.PageCount - 1) then
    FModuleForm.pcCommentKinds.ActivePageIndex := Self.FPageIndex;
  Result := FModuleForm.ShowModal = mrOK;
end;

{$IFDEF DEBUGMODE}
initialization
  with TCommentDialog.Create(nil) do
  begin
    Execute;
    Free;
  end;
{$ENDIF}

end.