Delphi换行_这里只换一行

开发环境DelphiXe11；

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

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

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

 

 

--Unit-- 

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