Delphi换行_这里只换一行

开发环境DelphiXe11；

这个代码不适用于Delphi7,一般不适用于Delphi2009之前的版本；

这个图片：12个字(汉字)换行；2数字和2字母认为等于1汉字；

这个换行不大行，全是小写的字母占占用的位置比较少，如果要效果好的，请自己写；

--Unit--

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

unit Unit1;
 
interface
 
uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, System.Math;
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Memo1: TMemo;
    Edit2: TEdit;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
function f_GetLineBreakPosition(const AStr: string;
  ACutoffCount: DWord): Integer;
var
  vStrlen, vCount_A, vCount_B, i, j, vChineseCharacterCount, vSubInt, vSubInt2,
  vTempInt_A, vTempInt_B: Integer;
  vDouble: Double;
  vChineseCharacterBool: Boolean;
begin
  //只是粗略计算，不要太较真
  Result := 0;
  if ACutoffCount < 4 then //最少四个字
    Exit;
  if AStr = '' then
    Exit;
 
  vStrlen := Length(AStr);
 
  if vStrlen <= ACutoffCount then //ACutoffCount截断的汉字位置  只能显示两行，第一行多少个汉字截断(两个数字或者连个数字或者字符默认为一个汉字)
    Exit;
  vCount_A := 0;
  vCount_B := 0;
  for i := 1 to vStrlen do
  begin
    if Ord(Astr[i]) < 256 then
      inc(vCount_A) //字符个数
    else
      inc(vCount_B); //汉字个数
 
 
    j := i + 1;
    if j <= vStrlen then
    begin
      if Ord(Astr[j]) < 256 then //小于256都认为非汉字
        vChineseCharacterBool := False
      else
        vChineseCharacterBool := True;
      vTempInt_B := vCount_B * 2;
      vTempInt_A := vCount_A;
      if vChineseCharacterBool then//下一个是汉字
      begin
        vTempInt_B := (vCount_B + 1) * 2;
      end
      else
      begin
        vTempInt_A := vCount_A + 1;
      end;
 
      vDouble := (vTempInt_A + vTempInt_B) / 2.0;
      vSubInt := Trunc(vDouble);
      vSubInt2 := Ceil(vDouble);
      if vSubInt = vSubInt2 then //没有小数
      begin
        if vSubInt = ACutoffCount then
        begin
          Result := j;
          Exit;
        end;
      end
      else
      begin
        if vChineseCharacterBool  then
        begin
          if (vSubInt <= ACutoffCount) and (ACutoffCount < vSubInt2) then
          begin
            Result := j;
            Exit;
          end;
        end
        else
        begin
          if ACutoffCount = vSubInt then
          begin
            Result := j;
            Exit;
          end;
        end;
      end;
    end
    else
      Result := i;
  end;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
var
  i: Integer;
  vStr1, vStr2: string;
begin
  Memo1.Clear;
  i :=f_GetLineBreakPosition(Edit1.Text, StrToIntDef(Edit2.Text, 10));
  if i = 0 then
    Memo1.Text := Edit1.Text
  else
  begin
    vStr1 := Copy(Edit1.Text,1, i);
    vStr2 := Copy(Edit1.Text,i + 1, 10000);
    Memo1.Lines.Add(vstr1);
    Memo1.Lines.Add(vstr2);
  end;
end;
 
end.

--Form--　

object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 389
  ClientWidth = 449
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -12
  Font.Name = 'Segoe UI'
  Font.Style = []
  TextHeight = 15
  object Button1: TButton
    Left = 151
    Top = 37
    Width = 75
    Height = 25
    Caption = 'Button1'
    TabOrder = 0
    OnClick = Button1Click
  end
  object Edit1: TEdit
    Left = 16
    Top = 8
    Width = 337
    Height = 23
    TabOrder = 1
    Text = #25216#26415#30340#22797#27963#33410#22307#35806#33410#24674'0123456789'
  end
  object Memo1: TMemo
    Left = 16
    Top = 80
    Width = 401
    Height = 281
    Lines.Strings = (
      'Memo1')
    ScrollBars = ssBoth
    TabOrder = 2
  end
  object Edit2: TEdit
    Left = 16
    Top = 37
    Width = 57
    Height = 23
    TabOrder = 3
    Text = '12'
  end
end