I have these data:
CMD210 STA_ 99.0 uS Temp 22.1 C
CMD210 STAB 99.9 uS Temp 22 C
CMD210 STAB 0.1 mS Temp 22.1 C
CMD210 STA_ 99.5 uS Temp 22.1 C
CMD210 STAB 99.4 uS Temp 22 C
CMD210 ST__ 99.0 uS Temp 22.2 C
CMD210 STAB 0.1 mS Temp 22 C
CMD210 STAB 99.3 uS Temp 22.2 C
I would like to have a program that display the temperature from memo for exampel in a listbox.
I know I have to get loop and something with 2 char with 'p' and 'c', because the number is between those to letters....
procedure TForm1.Button4Click(Sender: TObject);
var
midlet,midler:char;
resultat,x:integer;
linecount,index:integer;
found: boolean;
begin
midlet:= 'p';
midler:='C';
index:=0;
resultat:=midlet+x+midler
found := false;
linecount := Memo1.lines.count;
while index<= linecount - 1 do
begin
if x = memo1.lines[index] then
found := true;
index :=index + 1;
end
if found = true then
ListBox1.text:= floattostrF(x,ffFixed,15,2);
end;
There are several problems in your example so this answer will be limited to "how extracting and converting the temperature from a line". You have fundamentally two ways to achieve the task:
use the regular expressions.
write a custom parser.
the custom parser is quite easy to write:
accumulate non-blank chars in an identifier.
if the identifier is equal to Temp then define a flag.
convert the identifier to a double if the flag is defined and if someting's been accumulated.
example:
program Project1;
uses
sysutils;
const
line1 = 'CMD210 STAB 99.3 uS Temp 22.2 C';
line2 = 'CMD210 STAB 0.1 mS Temp 22 C';
line3 = 'it is quite hot over there Temp 55.123456 C';
line4 = 'bla bla bla bla 12.564 C';
line5 = '';
function getTemperature(aLine: string): double;
var
reader: PChar;
identifier: string;
AccumulateTemp: boolean;
const
_Nan = 0/0;
begin
// initialize local variables.
identifier := '';
AccumulateTemp := false;
// success can be tested with isNan()
result := _Nan;
// add a distinct terminal char:
aLine := aLine + #0;
reader := #aLine[1];
while(true) do begin
if reader^= #0 then
exit;
// blank: test the identifier
if reader^ in [#9, ' '] then
begin
if AccumulateTemp then
begin
if not TryStrToFloat(identifier, result) then
result := _Nan;
AccumulateTemp := false;
exit;
end;
if identifier = 'Temp' then
AccumulateTemp := true;
identifier := '';
end else
// accumulate
identifier := identifier + reader^;
Inc(reader);
end;
end;
begin
DecimalSeparator := '.';
writeln( format('%.7f', [getTemperature(line1)]) );
writeln( format('%.7f', [getTemperature(line2)]) );
writeln( format('%.7f', [getTemperature(line3)]) );
writeln( format('%.7f', [getTemperature(line4)]) );
writeln( format('%.7f', [getTemperature(line5)]) );
readln;
end.
which outputs
22.2000000
22.0000000
55.1234560
Nan
Nan
Related
I am trying to make a program that allow me to read a text file and then print it in the terminal.
I just put the simplified parts below so that you see how I think it should work.
My problem is that if for example I open the file a.txt then b.txt it works.
But when I want to open a.txt again, the program stops with an error 217. Same if I want to open another file name c.txt for example. I've spent days on this problem but I do not know where it comes from. I looked on the internet and erorr 217 seems to be related to a non-existing file ? but it is not the case for me...
The error seems to occur on the 'assign' function.
To clarify :
'key' is a Char,
'map' is a two dimension dynamic array of a Record Type.
Repeat
readln(key);
name := key +'.txt';
fileLoading(name, map, maxX, maxY);
Until key = 'l';
...
procedure fileLoading (name : String; var map : PPObjet; var maxX,maxY : Integer);
var
fichier : Text;
i, j : Integer;
chaine : String;
begin
if (FileExists(name)) then
begin
assign(fichier, name);
reset(fichier);
read(fichier,maxX);
readln(fichier,maxY);
if (maxX < 1) or (maxX > MAX) or (maxY < 1) or (maxY > MAX) then
begin
writeln('Tailles invalides');
halt();
end;
allocationTab(maxX, maxY, map);
while (not eof(fichier)) do
begin
for j := 1 to maxY do
begin
readln(fichier,chaine);
for i := 1 to maxX do
begin
case chaine[i] of
'0' : begin
map[j][i].solide := false;
map[j][i].nature := 'v';
map[j][i].valeur := chaine[i];
end;
'1' : begin
map[j][i].solide := true;
map[j][i].nature := 'm';
map[j][i].valeur := chaine[i];
end;
'2'..'9' : begin
map[j][i].solide := false;
map[j][i].nature := 's';
map[j][i].valeur := chaine[i];
end;
end;
end;
end;
end;
end
else
begin
writeln('Erreur le fichier n''existe pas');
halt();
end;
close(fichier);
end;
...
This is the first time I ask a question on stack overflow and I'm not really familiar with it, so I hope my problem is clear enough, as well as my english.
Thanks in advance for all the help you may bring.
try setting
filemode:=0;
before your assign/reset
I am working on a Question/Answer UI application in Pascal / Lazarus. My problem is that upon invoking below code through a button click, the program crashes with a Segmentation Fault error.
// more declarations... (UI Form, Buttons, ...)
type
TQuestion = class(TObject)
title: string;
answers: array of string;
correct: integer;
end;
var
questions: array of TQuestion;
procedure TForm1.BStartClick(Sender: TObject);
var
i: integer;
j: integer;
line: string;
arrayLength: integer;
question: TQuestion;
stringList: TStringList;
begin
stringList := TStringList.create;
stringList.LoadFromFile('questions.txt');
for i := 0 to stringList.Count - 1 do ;
begin
line := stringList[i];
if (length(line) >= 2) then
if (line[2] = ' ') and ((line[1] = '-') or (line[1] = '+')) then
begin
arrayLength := length(question.answers);
SetLength(question.answers, arrayLength + 1);
question.answers[arrayLength] :=
Copy(line, 2, Length(line) - 1);
if zeile[1] = '+' then
question.correct := arrayLength;
end
else
begin
question := TQuestion.Create;
question.title := line;
arrayLength := length(questions);
setLength(questions, arrayLength + 1);
questions[arrayLength] := question;
end;
end;
BStart.Visible := False;
end;
Well, my Pascal knowledge goes to 10 to 15 years ago. However, I can see that you have an extra semicolon at the end of this line:
for i := 0 to stringList.Count - 1 do ;
I have to implement a decision matrix in Delphi 7.
The function is
CalcNewStatus( actionCode: string; reportType: string; currentStatus: string): string;
ActionCode can have the values 'A' and 'N'
ReportType can have the values 'I' and 'F'
CurrentStatus can have the values 'P', 'I', 'F'.
In C# I would use a dictionary, for example. How can I do this in Delphi 7?
Normalize your input characters to zero-based ordinal values and things become much easier. Start with a few type declarations:
type
TActionCode = (acA, acN);
TReportType = (rtI, rtF);
TStatus = (sP, sI, sF);
Then you can define an array using those types with all possible status values. Replace sX with whichever status value belongs in each spot.
const
NextStatus: array[TActionCode, TReportType, TStatus] of TStatus = (
{acA} (// sP, sI, sF
{rtI} ( sX, sX, sX),
{rtF} ( sX, sX, sX)
),
{acN} (
{rtI} ( sX, sX, sX),
{rtF} ( sX, sX, sX)
)
);
Then your function is simply this:
function CalcNewStatus(const actionCode, reportType, currentStatus: string): string;
var
ac: TActionCode;
rt: TReportType;
s: TStatus;
const
StateChars: array[TState] of Char = ('P', 'I', 'F');
begin
Assert(actionCode <> ''); Assert(reportType <> ''); Assert(currentStatus <> '');
Assert(actionCode[1] in ['A', 'N']);
Assert(reportType[1] in ['I', 'F']);
Assert(currentStatus[1] in ['P', 'I', 'F']);
if actionCode[1] = 'A' then ac := acA else ac := acN;
if reportType[1] = 'I' then rt := rtI else rt := rtF;
if currentStatus[1] = 'P' then s := sP
else if currentStatus[1] = 'I' then s := sI
else s := sF;
Result := StateChars[NextStatus[ac, rt, s]];
end;
As you can see, most of this code is spent converting between strings and the enum types. If you can, avoid strings in this case. Switch to the enum types as early in your program as possible, and only convert back to strings or characters when you absolutely need to. Strings can have arbitrary length, which you really shouldn't have to deal with, and strings can also have values outside the range you've defined. Enums can't, unless you do something weird. Furthermore, the compiler won't let you accidentally use a TState value where a TReportType is expected, which will help you from confusing your I's and F's.
First of all in such a limited case (2 ActionCodes, 2 ReportTypes, 3 Statuses) I should definitely use enumerated types instead of strings.
And for the decision matrix ... a matrix:
Type
TActionCode = (taA, taN);
TReprotType = (rtI, rtF);
TStatus = (stP, stI, stF);
const
NewStatus: array [TActionCode, TReportType, TStatus] of TStatus =
((((,,)),((,,))),(((,,)),((,,)))) // values of the new statuses here
There is one solution that uses a single-dimensional array.
unit XnResultStatusOverride;
interface
function XnCalcOverridenResultStatus(
actionCodeStr: string;
reportTypeStr: string;
currentStatusStr: string ): string;
implementation
uses SysUtils;
type
TActionCodes = ( ActionCodeA = 0, ActionCodeN = 1);
TReportTypes = (ReportTypeI = 0, ReportTypeF = 1);
TResultStatus = (ResultStatusP = 0, ResultStatusF = 1, ResultStatusI = 2);
const
DecisionMatrix: array[ 0 .. 15 ] of TResultStatus
=
(
ResultStatusF, // 0 A-I-P
ResultStatusF, // 1 A-I-F
ResultStatusF, // 2 A-I-I
ResultStatusF, // 3 N/A
ResultStatusP, // 4 A-F-P
ResultStatusP, // 5 A-F-F
ResultStatusF, // 6 A-F-I
ResultStatusF, // 7 N/A
ResultStatusF, // 8 N-I-P
ResultStatusF, // 9 N-I-F
ResultStatusP, // 10 N-I-I
ResultStatusF, // 11 N/A
ResultStatusF, // 12 N-F-P
ResultStatusI, // 13 N-F-F
ResultStatusF, // 14 N-F-I
ResultStatusF // 15 N/A
);
function ParseActionCodeString( value: string ): TActionCodes;
begin
if value = 'A' then
begin
result := ActionCodeA;
exit;
end;
if value = 'N' then
begin
result := ActionCodeN;
exit;
end;
raise Exception.Create('Invalid action code string' );
end;
function ParseReportTypeString( value: string ): TReportTypes;
begin
if value = 'I' then
begin
result := ReportTypeI;
exit;
end;
if value = 'F' then
begin
result := ReportTypeF;
exit;
end;
raise Exception.Create('Invalid report type string' );
end;
function ParseResultStatusString( value: string ): TResultStatus;
begin
if value = 'P' then
begin
result := ResultStatusP;
exit;
end;
if value = 'F' then
begin
result := ResultStatusF;
exit;
end;
if value = 'I' then
begin
result := ResultStatusI;
exit;
end;
raise Exception.Create('Invalid result status string' );
end;
function ResultStatusToString( value: TResultStatus ): string;
begin
if value = ResultStatusP then
begin
result := 'P';
exit;
end;
if value = ResultStatusF then
begin
result := 'F';
exit;
end;
if value = ResultStatusI then
begin
result := 'I';
exit;
end;
raise Exception.Create('Unknown TResultStatus enum member' );
end;
function XnCalcOverridenResultStatus(
actionCodeStr: string;
reportTypeStr: string;
currentStatusStr: string ): string;
var
actionCode: TActionCodes;
reportType: TReportTypes;
currentStatus:TResultStatus;
discriminant: integer;
newStatusInt: integer;
newStatus: TResultStatus;
begin
actionCode := ParseActionCodeString( actionCodeStr );
reportType := ParseReportTypeString( reportTypeStr );
currentStatus := ParseResultStatusString( currentStatusStr );
discriminant := integer(actionCode) * 8 + integer(reportType) * 4 + integer(currentStatus);
newStatusInt := DecisionMatrix[ discriminant ];
newStatus := TResultStatus( newStatusInt);
Result := ResultStatusToString( newStatus );
end;
end.
Hi I'm using Delphi and I have a StringList with this items:
45
A15
015
A15
A15
45
I want to process it and make a second stringlist that will have
the number of appearance of each element:
45 [2]
015 [1]
A15 [3]
How can I do this with Delphi?
You could use a dictionary:
Frequencies := TDictionary <String, Integer>.Create;
try
// Count frequencies
for Str in StringList do
begin
if Frequencies.ContainsKey (Str) then
Frequencies [Str] := Frequencies [Str] + 1
else
Frequencies.Add (Str, 1);
end;
// Output results to console
for Str in Frequencies.Keys do
WriteLn (Str + ': ' + IntToStr (Frequencies [Str]));
finally
FreeAndNil (Frequencies);
end;
The only problem might be that the order in which the results appear is completely random and dependes on the inner working of the hash map.
Thanks to daemon_x for the full unit code:
program Project1;
{$APPTYPE CONSOLE}
uses SysUtils, Classes, Generics.Collections;
var Str: String;
StringList: TStrings;
Frequencies: TDictionary <String, Integer>;
begin
StringList := TStringList.Create;
StringList.Add('45');
StringList.Add('A15');
StringList.Add('015');
StringList.Add('A15');
StringList.Add('A15');
StringList.Add('45');
Frequencies := TDictionary <String, Integer>.Create;
try
// Count frequencies
for Str in StringList do
begin
if Frequencies.ContainsKey (Str) then
Frequencies [Str] := Frequencies [Str] + 1
else
Frequencies.Add (Str, 1);
end;
// Output results to console
for Str in Frequencies.Keys do
WriteLn (Str + ': ' + IntToStr (Frequencies [Str]));
finally
StringList.Free;
FreeAndNil(Frequencies);
end;
end.
Sort the original list,
list1.sort;
create a new list
list2:=TStringList.Create;
iterate over the sorted list to count every different item
and store the a count in the objects field of the resulting list (or if you don't use it already, just typecast the count into a pointer and store it as the object).
previtem:=list1[0];
count:=1;
for i:=1 to list1.count-1 do
begin
if list1[i]=previtem then
inc(count)
else
begin
list2.addObject(previtem,pointer(count));
previtem:=list1[i];
count:=1;
end;
end;
list2.addObject(previtem,pointer(count));
finally, iterate again to add the count to the string
for i:=0 to list2.count-1 do
list2.items[i]:=list2[i]+' ['+inttostr(list2.objects[i])+']';
I coded this on my head as I don't have Delphi installed as of now. Let me know how it works for you.
Stringlist1 is the original list with the items, stringlist2 is empty and will be used to store what you want.
for i := 0 to stringlist1.Count - 1 do
begin
if (stringlist2.Values[stringlist1[i]] = '') then
stringlist2.Values[stringlist1[i]] := '1'
else
stringlist2.Values[stringlist1[i]] :=
IntToStr(StrToInt(stringlist2.Values[stringlist1[i]]) + 1);
end;
I was trying to speed up a certain routine in an application, and my profiler, AQTime, identified one method in particular as a bottleneck. The method has been with us for years, and is part of a "misc"-unit:
function cwLeftPad(aString:string; aCharCount:integer; aChar:char): string;
var
i,vLength:integer;
begin
Result := aString;
vLength := Length(aString);
for I := (vLength + 1) to aCharCount do
Result := aChar + Result;
end;
In the part of the program that I'm optimizing at the moment the method was called ~35k times, and it took a stunning 56% of the execution time!
It's easy to see that it's a horrible way to left-pad a string, so I replaced it with
function cwLeftPad(const aString:string; aCharCount:integer; aChar:char): string;
begin
Result := StringOfChar(aChar, aCharCount-length(aString))+aString;
end;
which gave a significant boost. Total running time went from 10,2 sec to 5,4 sec. Awesome! But, cwLeftPad still accounts for about 13% of the total running time. Is there an easy way to optimize this method further?
Your new function involves three strings, the input, the result from StringOfChar, and the function result. One of them gets destroyed when your function returns. You could do it in two, with nothing getting destroyed or re-allocated.
Allocate a string of the total required length.
Fill the first portion of it with your padding character.
Fill the rest of it with the input string.
Here's an example:
function cwLeftPad(const aString: AnsiString; aCharCount: Integer; aChar: AnsiChar): AnsiString;
var
PadCount: Integer;
begin
PadCount := ACharCount - Length(AString);
if PadCount > 0 then begin
SetLength(Result, ACharCount);
FillChar(Result[1], PadCount, AChar);
Move(AString[1], Result[PadCount + 1], Length(AString));
end else
Result := AString;
end;
I don't know whether Delphi 2009 and later provide a double-byte Char-based equivalent of FillChar, and if they do, I don't know what it's called, so I have changed the signature of the function to explicitly use AnsiString. If you need WideString or UnicodeString, you'll have to find the FillChar replacement that handles two-byte characters. (FillChar has a confusing name as of Delphi 2009 since it doesn't handle full-sized Char values.)
Another thing to consider is whether you really need to call that function so often in the first place. The fastest code is the code that never runs.
Another thought - if this is Delphi 2009 or 2010, disable "String format checking" in Project, Options, Delphi Compiler, Compiling, Code Generation.
StringOfChar is very fast and I doubt you can improve this code a lot. Still, try this one, maybe it's faster:
function cwLeftPad(aString:string; aCharCount:integer; aChar:char): string;
var
i,vLength:integer;
origSize: integer;
begin
Result := aString;
origSize := Length(Result);
if aCharCount <= origSize then
Exit;
SetLength(Result, aCharCount);
Move(Result[1], Result[aCharCount-origSize+1], origSize * SizeOf(char));
for i := 1 to aCharCount - origSize do
Result[i] := aChar;
end;
EDIT: I did some testing and my function is slower than your improved cwLeftPad. But I found something else - there's no way your CPU needs 5 seconds to execute 35k cwLeftPad functions except if you're running on PC XT or formatting gigabyte strings.
I tested with this simple code
for i := 1 to 35000 do begin
a := 'abcd1234';
b := cwLeftPad(a, 73, '.');
end;
and I got 255 milliseconds for your original cwLeftPad, 8 milliseconds for your improved cwLeftPad and 16 milliseconds for my version.
You call StringOfChar every time now. Of course this method checks if it has something to do and jumps out if length is small enough, but maybe the call to StringOfChar is time consuming, because internally it does another call before jumping out.
So my first idea would be to jump out by myself if there is nothing to do:
function cwLeftPad(const aString: string; aCharCount: Integer; aChar: Char;): string;
var
l_restLength: Integer;
begin
Result := aString;
l_restLength := aCharCount - Length(aString);
if (l_restLength < 1) then
exit;
Result := StringOfChar(aChar, l_restLength) + aString;
end;
You can speed up this routine even more by using lookup array.
Of course it depends on your requirements. If you don't mind wasting some memory...
I guess that the function is called 35 k times but it has not 35000 different padding lengths and many different chars.
So if you know (or you are able to estimate in some quick way) the range of paddings and the padding chars you could build an two-dimensional array which include those parameters.
For the sake of simplicity I assume that you have 10 different padding lengths and you are padding with one character - '.', so in example it will be one-dimensional array.
You implement it like this:
type
TPaddingArray = array of String;
var
PaddingArray: TPaddingArray;
TestString: String;
function cwLeftPad4(const aString:string; const aCharCount:integer; const aChar:char; var anArray: TPaddingArray ): string;
begin
Result := anArray[aCharCount-length(aString)] + aString;
end;
begin
//fill up the array
SetLength(StrArray, 10);
PaddingArray[0] := '';
PaddingArray[1] := '.';
PaddingArray[2] := '..';
PaddingArray[3] := '...';
PaddingArray[4] := '....';
PaddingArray[5] := '.....';
PaddingArray[6] := '......';
PaddingArray[7] := '.......';
PaddingArray[8] := '........';
PaddingArray[9] := '.........';
//and you call it..
TestString := cwLeftPad4('Some string', 20, '.', PaddingArray);
end;
Here are benchmark results:
Time1 - oryginal cwLeftPad : 27,0043604142394 ms.
Time2 - your modyfication cwLeftPad : 9,25971967336897 ms.
Time3 - Rob Kennedy's version : 7,64538131122457 ms.
Time4 - cwLeftPad4 : 6,6417059620664 ms.
Updated benchmarks:
Time1 - oryginal cwLeftPad : 26,8360194218451 ms.
Time2 - your modyfication cwLeftPad : 9,69653117046119 ms.
Time3 - Rob Kennedy's version : 7,71149259179622 ms.
Time4 - cwLeftPad4 : 6,58248533610693 ms.
Time5 - JosephStyons's version : 8,76641780969192 ms.
The question is: is it worth the hassle?;-)
It's possible that it may be quicker to use StringOfChar to allocate an entirely new string the length of string and padding and then use move to copy the existing text over the back of it.
My thinking is that you create two new strings above (one with FillChar and one with the plus). This requires two memory allocates and constructions of the string pseudo-object. This will be slow. It may be quicker to waste a few CPU cycles doing some redundant filling to avoid the extra memory operations.
It may be even quicker if you allocated the memory space then did a FillChar and a Move, but the extra fn call may slow that down.
These things are often trial-and-error!
You can get dramatically better performance if you pre-allocate the string.
function cwLeftPadMine
{$IFDEF VER210} //delphi 2010
(aString: ansistring; aCharCount: integer; aChar: ansichar): ansistring;
{$ELSE}
(aString: string; aCharCount: integer; aChar: char): string;
{$ENDIF}
var
i,n,padCount: integer;
begin
padCount := aCharCount - Length(aString);
if padCount > 0 then begin
//go ahead and set Result to what it's final length will be
SetLength(Result,aCharCount);
//pre-fill with our pad character
FillChar(Result[1],aCharCount,aChar);
//begin after the padding should stop, and restore the original to the end
n := 1;
for i := padCount+1 to aCharCount do begin
Result[i] := aString[n];
end;
end
else begin
Result := aString;
end;
end;
And here is a template that is useful for doing comparisons:
procedure TForm1.btnPadTestClick(Sender: TObject);
const
c_EvalCount = 5000; //how many times will we run the test?
c_PadHowMany = 1000; //how many characters will we pad
c_PadChar = 'x'; //what is our pad character?
var
startTime, endTime, freq: Int64;
i: integer;
secondsTaken: double;
padIt: string;
begin
//store the input locally
padIt := edtPadInput.Text;
//display the results on the screen for reference
//(but we aren't testing performance, yet)
edtPadOutput.Text := cwLeftPad(padIt,c_PadHowMany,c_PadChar);
//get the frequency interval of the OS timer
QueryPerformanceFrequency(freq);
//get the time before our test begins
QueryPerformanceCounter(startTime);
//repeat the test as many times as we like
for i := 0 to c_EvalCount - 1 do begin
cwLeftPad(padIt,c_PadHowMany,c_PadChar);
end;
//get the time after the tests are done
QueryPerformanceCounter(endTime);
//translate internal time to # of seconds and display evals / second
secondsTaken := (endTime - startTime) / freq;
if secondsTaken > 0 then begin
ShowMessage('Eval/sec = ' + FormatFloat('#,###,###,###,##0',
(c_EvalCount/secondsTaken)));
end
else begin
ShowMessage('No time has passed');
end;
end;
Using that benchmark template, I get the following results:
The original: 5,000 / second
Your first revision: 2.4 million / second
My version: 3.9 million / second
Rob Kennedy's version: 3.9 million / second
This is my solution. I use StringOfChar instead of FillChar because it can handle unicode strings/characters:
function PadLeft(const Str: string; Ch: Char; Count: Integer): string;
begin
if Length(Str) < Count then
begin
Result := StringOfChar(Ch, Count);
Move(Str[1], Result[Count - Length(Str) + 1], Length(Str) * SizeOf(Char));
end
else Result := Str;
end;
function PadRight(const Str: string; Ch: Char; Count: Integer): string;
begin
if Length(Str) < Count then
begin
Result := StringOfChar(Ch, Count);
Move(Str[1], Result[1], Length(Str) * SizeOf(Char));
end
else Result := Str;
end;
It's a bit faster if you store the length of the original string in a variable:
function PadLeft(const Str: string; Ch: Char; Count: Integer): string;
var
Len: Integer;
begin
Len := Length(Str);
if Len < Count then
begin
Result := StringOfChar(Ch, Count);
Move(Str[1], Result[Count - Len + 1], Len * SizeOf(Char));
end
else Result := Str;
end;
function PadRight(const Str: string; Ch: Char; Count: Integer): string;
var
Len: Integer;
begin
Len := Length(Str);
if Len < Count then
begin
Result := StringOfChar(Ch, Count);
Move(Str[1], Result[1], Len * SizeOf(Char));
end
else Result := Str;
end;