unit unit2;
//https://forum.lazarus.freepascal.org/index.php/topic,60565.0.html
{$mode ObjFPC}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls;
type
{ TForm2 }
TForm2 = class(TForm)
dummyImg: TImage;
FinalName: TMemo;
Label1: TLabel;
Label2: TLabel;
PaintBox1: TPaintBox;
Panel1: TPanel;
Panel2: TPanel;
RadioGroup1: TRadioGroup;
SelectedName: TLabeledEdit;
ListBox1: TListBox;
SplittedName: TLabeledEdit;
procedure FormCreate(Sender: TObject);
procedure ListBox1Click(Sender: TObject);
procedure PaintBox1Paint(Sender: TObject);
private
FComponentName:string;
FFinalName : string;
public
end;
var
Form2: TForm2;
implementation
{$R *.lfm}
{ TForm2 }
function toLines(s:string; maxLength:integer; Canvas:TCanvas=nil; maxWidth:integer=90): string;
function canBeALine(s2:string):Boolean;
begin
if (canvas <> nil) then
result := Canvas.TextWidth(s2) <= maxWidth
else
result := length(s2) <= maxLength;
end;
var ss : TStringArray;
i : integer;
aline : string;
begin
result := '';
aline := '';
ss := s.split(' ');
//for i := 0 to length(ss) - 1 do
// writeln(ss[i]);
writeln('---------', s);
for i := 0 to length(ss) - 1 do
begin
//if length(aline + ss[i]) <= maxLength then
if canBeALine(aline + ss[i]) then
aline := aline + ss[i]
else
begin
if result <> EmptyStr then
result := result + #13;
result := result + aline;
aline := ss[i];
end;
if (i = length(ss) -1) and (aline <> EmptyStr) then
result := result + #13 + aline;
end;
writeln('#======> ', result.replace(#13, '|'), #13);
end;
// beautify a string by putting a space on logical positions
// warning: limited to a-z and 0-9 (!)
// written in a hurry by KodeZwerg 2022 for forum.lazarus.freepascal.org
function PrettyString(const AString: AnsiString; const Force: Boolean = False): AnsiString;
function IsUpper(const AChar: AnsiChar): Boolean; inline;
begin
Result := AChar in ['A'..'Z'];
end;
function IsLower(const AChar: AnsiChar): Boolean; inline;
begin
Result := AChar in ['a'..'z'];
end;
function IsNumber(const AChar: AnsiChar): Boolean; inline;
begin
Result := AChar in ['0'..'9'];
end;
{ver 1 -----------------------------
var
LCopy, LOutput: AnsiString;
LLen, i: Integer;
begin
Result := AString;
// only work on strings that are longer than 16 chars, except you force it
if ((not Force) and (Length(AString) < 17)) then
Exit;
LCopy := AString;
LLen := Length(LCopy);
LOutput := '';
for i := 1 to LLen do
begin
if ( (Pred(i) > 0) and (Succ(i) <= LLen) and (IsLower(LCopy[Pred(i)])) and (IsUpper(LCopy[i])) ) then
LOutput := LOutput + ' ' + LCopy[i]
else
if ( (Pred(i) > 0) and (Succ(i) <= LLen) and (IsLower(LCopy[Pred(i)])) and (IsNumber(LCopy[i])) ) then
LOutput := LOutput + ' ' + LCopy[i]
else
LOutput := LOutput + LCopy[i];
end;
Result := LOutput;
end;}
var
LCopy, LOutput: AnsiString;
LLen, i: Integer;
begin
Result := AString;
LCopy := AString;
LLen := Length(LCopy);
LOutput := '';
for i := 1 to LLen do
begin
if ( (Pred(i) > 0) and (Succ(i) < LLen) and (IsUpper(LCopy[i])) and (IsLower(LCopy[Succ(i)])) ) then
LOutput := LOutput + ' ' + LCopy[i]
else
if ( (Pred(i) > 0) and (IsLower(LCopy[Pred(i)])) and (IsUpper(LCopy[i])) ) then
LOutput := LOutput + ' ' + LCopy[i]
else
if ( (Pred(i) > 0) and (IsLower(LCopy[Pred(i)])) and (IsNumber(LCopy[i])) ) then
LOutput := LOutput + ' ' + LCopy[i]
else
LOutput := LOutput + LCopy[i];
end;
Result := LOutput;
end;
const
ATOMS : array [0..3] of string = (
'JSCRIPT', 'JSON', 'EXTJS', 'XML'
);
function getAtom(s:string):string;
var i :integer;
begin
s := uppercase(s);
for i := 0 to length(ATOMS) -1 do
if pos(ATOMS[i], s) = 1 then
exit(ATOMS[i]);
result := EmptyStr;
end;
function splitName(s:string):UnicodeString;
function IsUpper(const AChar: AnsiChar): Boolean; inline;
begin
Result := AChar in ['A'..'Z'];
end;
function IsLower(const AChar: AnsiChar): Boolean; inline;
begin
Result := AChar in ['a'..'z'];
end;
function IsNumber(const AChar: AnsiChar): Boolean; inline;
begin
Result := AChar in ['0'..'9'];
end;
//const numbers = '0123456789';
var ret : UnicodeString; //result
var i : integer;
function nextIsLower:boolean;
var c : char;
begin
if i+1 > length(s) then exit(false);
c := s[i+1];
result := isLower(c);
//result := (c <> EmptyStr) and {(numbers.IndexOf(c)<=0)} not IsNumber(c) and IsLower(c);
end;
var
c : char;
sep, atom : String;
begin
//sep := #13;
//sep := utf8encode(#$00AD); //shoft hypenation
sep := ' '; //space
//sep := utf8encode(#$200B); //Zero-width space. https://en.wikipedia.org/wiki/Zero-width_space
//sep := utf8encode(#$200c); //Zero-width non-joiner. https://en.wikipedia.org/wiki/Zero-width_space
//sep := utf8encode(#$200d); //Zero-width joiner. https://en.wikipedia.org/wiki/Zero-width_space
////sep := #$20#$0b;
////sep := #$0b#$20;
//sep := #$200B;
ret := '';
//for i := 1 to length(s) do
i := 0;
while i < length(s) do
begin
inc(i);
c := s[i];
if (i > 1) then
begin
{atom := getAtom(copy(s,i,length(s)));
if atom <> emptyStr then
begin
ret := ret + sep + copy(s,i, length(atom)) + sep;
inc(i, length(atom));
end
else}
if isNumber(c) then
begin
if not isNumber(s[i-1]) then
ret := ret + sep
end
else if IsUpper(c) then
begin
if IsLower(s[i-1]) or nextIsLower() then
ret := ret + sep
else
begin
atom := getAtom(copy(s,i,length(s)));
if atom <> emptyStr then
begin
ret := ret + sep + copy(s,i, length(atom)) + sep;
inc(i, length(atom)-1);
continue;
end
end
end
end;
ret := ret + c;
end; //while
result := ret;
end;
procedure TForm2.ListBox1Click(Sender: TObject);
begin
FComponentName := ListBox1.Items[ ListBox1.ItemIndex]; // original
if RadioGroup1.ItemIndex = 0 then
FComponentName := PrettyString(FComponentName)
else
FComponentName := splitName(FComponentName);
FFinalName := toLines(FComponentName, 13, PaintBox1.Canvas, 100);
PaintBox1.Invalidate;
SelectedName.Text:= ListBox1.Items[ ListBox1.ItemIndex];
SplittedName.Text:=FComponentName;
FinalName.Text:=FFinalName;
end;
procedure TForm2.FormCreate(Sender: TObject);
begin
listBox1.Click;
end;
procedure TForm2.PaintBox1Paint(Sender: TObject);
var
style : TTextStyle;
aRect : TRect;
begin
style.Alignment:=taCenter;
style.SingleLine:=false;
style.Wordbreak:=true;
//style.SystemFont:=true;
style.EndEllipsis := true;
style.Opaque := true;
aRect:=PaintBox1.ClientRect;
PaintBox1.Canvas.Brush.Color:=clBtnFace;
PaintBox1.Canvas.TextRect(aRect,0,0, FFinalName, style);
end;
end.
Recent
