As it says in the title.
I'm writing a program which asks the user to input a surname surname then a first name and finally an address.
When this is done it prints out a table of the results and then organises then alphabetically based first on surname, then first name and finally address.
All this is done. I just have to make it that the table always prints out with first letters uppercase and the rest lowercase, ie:
input: jOHN SMith
output: John Smith
How can I do this in Pascal?
Here is the code I've written for this part so far:
writeln();
write(UpCaseFirstChar(arrSurnames[count]):15);
write(UpCaseFirstChar(arrFirstNames[count]):15);
write(UpCaseFirstChar(arrAddress[count]):30);
writeln();
I have a function for uppercasing the first letter, how can I change it to lowercase the rest?
EDIT: Here is the uppercase function:
function UpCaseFirstChar(const S: string): string;
begin
Result := S;
if Length(Result) > 0 then
Result[1] := UpCase(Result[1]);
end;
EDIT 2: I think I figured it out. Here is the new code for the UpCase/LowerCase function in case anyone is interested:
function UpCaseFirstChar(const S: string): string;
var
i: integer;
begin
Result := S;
if Length(Result) > 0 then
Result[1] := UpCase(Result[1]);
for i := 2 to Length(Result) do
begin
Result[i] := LowerCase(Result[i]);
end;
end;
Your update is more verbose than it needs to be. If you read the documentation carefully, the function LowerCase applies to a string. So you could write:
function UpCaseFirstChar(const S: string): string;
begin
if Length(S) = 0 then
Result := S
else begin
Result := LowerCase(S);
Result[1] := UpCase(Result[1]);
end;
end;
Related
This is my code that works except for the icon
procedure TForm1.FormCreate(Sender: TObject);
var item : TMenuItemInfo;
begin
with item do
begin
cbSize := SizeOf(MenuItemInfo);
fMask := MIIM_TYPE or MIIM_ID;
fType := MFT_STRING;
wID := 180;
dwTypeData := PChar('Test');
cch := 4;
hbmpItem := Image1.Picture.Bitmap.Handle; //Image1 is TImage
end;
InsertMenuItem(GetSystemMenu(Handle, FALSE),0,true,item);
end;
A couple of issues:
You don't clear the TMenuItemInfo instance before use. Unassigned fields may contain invalid or erroneous data when the call is made.
Use
ZeroMemory(#item, SizeOf(item));
at the beginning of the procedure.
The combination of fMask and fType members you have is incorrect.
Use the following instead
fMask := MIIM_STRING or MIIM_BITMAP or MIIM_ID;
// fType := MFT_STRING;
That is, don't assign fType
Here is a sample snip of a test, where a TImage holds the image depicting a number 2 on orange background. That is added as icon to the new menu item. (Which is your question)
Adding test code as requested:
// Note! Your `Image1` must have a bitmap loaded
procedure TForm39.AddSystemMenuItem;
var
item : TMenuItemInfo;
begin
ZeroMemory(#item, SizeOf(item));
with item do
begin
cbSize := SizeOf(MenuItemInfo);
fMask := MIIM_STRING or MIIM_BITMAP or MIIM_ID;
// fType := MFT_STRING;
wID := 180;
dwTypeData := PChar('Test');
cch := 4;
hbmpItem := Image1.Picture.Bitmap.Handle; //Image1 is TImage
end;
if not InsertMenuItem(GetSystemMenu(Handle, FALSE),0,true,item) then
ShowMessage('Failed');
end;
procedure TForm39.Button1Click(Sender: TObject);
begin
AddSystemMenuItem;
end;
I am currently making a little Program in Delphi 10.3 Community Version 26.0.34749.6593. No additional components.
Essentially I draw on TPaintBox which is fitted in a Panel. Everything works fine so far, but when the objects are repainted via "PaintBox1.Repaint" the Objects got the wrong BrushStyle (bsSolid when they should have bsClear e.g.) Of course I tried to pin it down, but I got no luck. But I found out that at the following Point something doesn't work:
procedure TForm1.PaintBox1Paint(Sender: TObject);
var
i: Integer;
fig : ^TFigure;
apen: TPenStyle;
abrush: TBrushStyle;
color1,color2: TColor;
begin
aPen := PaintBox1.Canvas.Pen.Style;
aBrush := bsStyle;
color1 := PaintBox1.Canvas.Brush.Color;
color2 := PaintBox1.Canvas.Pen.Color;
for I:=0 to List.Count-1 do
begin
fig := List.Items[i];
case fig.Typ of
f_Kreis : begin
with Paintbox1.Canvas do
begin
pen.Style := fig.Pen;
Brush.Style := fig.Brush;
pen.Color := fig.PenColor;
brush.Color := fig.BrushColor;
Ellipse(fig.X,fig.Y,fig.X2,fig.Y2);
end;
end;
f_Rechteck : begin
with PaintBox1.Canvas do
begin
Pen.Style := fig.Pen;
Brush.Style := fig.Brush;
Pen.Color := fig.PenColor;
Brush.Color := fig.BrushColor;
Rectangle(fig.X,fig.Y,fig.X2,fig.Y2);
end;
end;
f_Line : begin
with PaintBox1.Canvas do
begin
pen.Style := fig.Pen;
brush.Style := fig.Brush;
pen.Color := fig.PenColor;
brush.Color := fig.BrushColor;
MoveTo(fig.X,Fig.Y);
LineTo(fig.X2,fig.Y2);
end;
end;
end;
end;
PaintBox1.Canvas.Pen.Style := aPen;
bsStyle := aBrush;
PaintBox1.Canvas.Brush.Color := color1;
PaintBox1.Canvas.Pen.Color := color2;
end;
So when the "Brush.Style := fig.Brush;"-Line is called, nothing happens. I went step by step and after these Line "Brush.Style" is still "bsSolid" even when "fig.Brush" is "bsClear"
For explanation: TFigure is my own class. It houses information about a drawing, such as a rectangle. It is the parent class.
Do I miss something. I really am out of Ideas. Can anyone tell me, why nothing happens?
Edit:
For testing I added the lines:
if Brush.Style <> fig.Brush then
ShowMessage('Warnung!');
under
Brush.Style := fig.Brush;
and it actually wont set it on false, though Brush.Style is bsSolid and fig.Brush is bsClear.
You have declared fig : ^TFigure;, but class instances are already references (pointers). Thus you are creating a pointer to reference, and using that pointer as if it were the reference.
Remove the pointer operator and declare
fig: TFigure;
I can't verify whether there are other errors in your code
This is my code (don't mind the German variable names):
IF Frage = 1 THEN
BEGIN
Reset(Textdatei);
Writeln;
i := 0;
WHILE NOT EoF(Textdatei) DO
BEGIN
Inc(i);
Readln(Textdatei,Dateiname);
// NUMMER
IF i < 10 THEN
BEGIN
Temp := Copy(Dateiname,2,1); // Speichert position als Str
posTemp := StrToInt(Temp); // position wird als Int gespeichert
pos0 := posTemp;
END;
IF (i < 100) AND (i > 9) THEN
BEGIN
Temp := Copy(Dateiname,2,2);
posTemp := StrToInt(Temp);
pos0 := posTemp;
END;
IF (i >= 100) THEN
BEGIN
Temp := Copy(Dateiname,2,3);
posTemp := StrToInt(Temp);
pos0 := posTemp;
END;
// NAME
posTemp := pos(' ',Dateiname);
posTemp2:= pos('.',Dateiname);
UnknownLength := (posTemp2-1) - posTemp;
Temp := Copy(Dateiname,posTemp+1,UnknownLength);
Name := Temp;
// KG
posTemp := pos('// ',Dateiname);
posTemp2:= pos('kg',Dateiname);
posTemp := posTemp + 2;
UnknownLength := (posTemp2-1) - posTemp;
Temp := Copy(Dateiname,posTemp,UnknownLength);
posTemp := StrToInt(Temp);
KG := posTemp;
//Liste beschreiben
Liste := AddElement(Name, pos0, KG, Liste);
END;
END;
ClrScr;
Writeln('Laden erfolgreich!');
Readkey;
Submenu();
So, this code does not work right, because the txt file that I load contains empty lines. To be more precise: every SECOND line in the txt is empty. That means, that I have to skip every empty line when filling my chained list with the elements from the txt.
How can I tell the compiler to skip every 2 / empty line ?
How can I tell my compiler to only read a certain line ?
If you answer either of my questions I can finally finish my little program.
The inside of my txt looks exactly like this:
#1: Bisasam. // 11 kg
#2: Bisaknosp. // 22 kg
#3: Bisaflor. // 33 kg
So as you can see, every second line is blank and when it tries to load a blank line into my list it crashes.
You can just add an extra Readln to skip the blank line, so your code becomes:
...
WHILE NOT EoF(Textdatei) DO
BEGIN
Inc(i);
// *** read non-empty line containing data ***
Readln(Textdatei,Dateiname);
...
//Liste beschreiben
Liste := AddElement(Name, pos0, KG, Liste);
// *** skip empty line ***
Readln(Textdatei);
END;
...
Note that this assumes that the non-empty lines are the odd lines in the file, i.e. the first line is non-empty, the second line is empty, etc. If it's the other way round then move the Readln(Textdatei); to the start of the WHILE loop instead of the end.
What happens when the assign operator := gets overloaded in Object Pascal? I mainly mean what gets evaluated first and more importantly how (if possible) can I change this order. Here is an example that bugs me:
I declare TMyClass thusly:
TMyClass = class
private
FSomeString: string;
class var FInstanceList: TList;
public
function isValid: boolean;
property SomeString: String write setSomeString;
end;
the isValid function checks MyObject for nil and dangling pointers.
Now lets assume I want to overload the := operator to assign a string to TMyClass. I also want to check if the object I'm assigning this string to is a valid object and if not create a new one, so:
operator :=(const anewString: string): TMyClass;
begin
if not(result.isValid) then
result:= TMyObject.Create;
result.SomeString:= aNewString;
end;
In short I was hoping that the result would automatically hold the pointer to the object I'm assigning to. But tests with the following:
procedure TForm1.TestButtonClick(Sender: TObject);
var
TestObject: TMyObject;
begin
TestObject:= TMyObject.Create;
TestObject:= 'SomeString';
TestObject.Free;
end;
led me to believe that instead an intermediate value for result is assigned first and the actual assignment to TestObject happens after the code in := executes.
Everything I know about coding is self taught but this example shows that I clearly missed some basic concept somewhere.
I understand that there are easier ways to do this than by overloading a := operator but out of scientific curiosity is there ANY way to make this code work? (No matter how complicated.)
It's not possible to do what you want with operator overloads. You must use a method.
The problem is that the := operator does not give you the access to the left hand side (LHS) argument (here it's the Self, a pointer to the current instance) but only to the right hand side argument.
Currently in you example if not(result.isValid) then is dangereous because the result at the beginning of the function is undefined (it can have any value, it can be either nil or not and when not nil, calling isValid will lead to some possible violation access. It does not represent the LHS at all.
Using a regular method you would have an access to the Self and you could call isValid.
I do not have Lazarus to check, but it is possible in Delphi in the following way. We give access to an instance of the class indirectly via TValue.
Here is a sample class:
type
TMyClass = class(TComponent)
private
FSomeString: string;
published
property SomeString: string read FSomeString write FSomeString;
end;
And we do the following in the container class (for example, TForm1).
TForm1 = class(TForm)
private
FMyClass: TMyClass;
function GetMyTypeString: TValue;
procedure SetMyTypeString(const Value: TValue);
public
property MyClass: TValue read GetMyTypeString write SetMyTypeString;
end;
...
function TForm1.GetMyTypeString: TValue;
begin
Result := FMyClass;
end;
procedure TForm1.SetMyTypeString(const Value: TValue);
begin
if Value.Kind in [TTypeKind.tkChar, TTypeKind.tkUString,
TTypeKind.tkString, TTypeKind.tkWChar, TTypeKind.tkWString]
then
begin
if not Assigned(FMyClass) then
FMyClass := TMyClass.Create(self);
FMyClass.SomeString := Value.AsString;
end else
if Value.Kind = TTypeKind.tkClass then
FMyClass := Value.AsType<TMyClass>;
end;
In this case both button clicks will work properly. In other words, it simulates := overloading:
procedure TForm1.Button1Click(Sender: TObject);
begin
MyClass := 'asd';
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
MyClass := TMyClass.Create(self);
end;
And here is how to get access to TMyClass instance:
procedure TForm1.Button3Click(Sender: TObject);
begin
if Assigned(TMyClass(MyClass.AsObject)) then
ShowMessage(TMyClass(MyClass.AsObject).SomeString)
else
ShowMessage('nil');
end;
In a similar vein to this question, I'm after a way to pragmatically read the information in the "details" pane that is shown when you select "properties" in explorer.
For example in the screenshots below,
a few random details are circled.
i am not after a way to determine the specific items circled in some other way (eg please don't suggest how to find out the width in pixels of an image) that is not what i am after. i need a way to parse all the information that is available, for display purposes in my own program, without having to "know" about the files myself. this is simply to create a specific user interface without having to actually open up the Dialogs shown.
For what its worth, the language du jour is Delphi, but i am quite capable of translating c++ or any other dialect of winapi code, but if you happen to have delphi code, that would be a bonus for me personally.
edit: i'd like to be able to get document specific details, eg the slide count in a powerPoint document, which does not conform to the standardarized constants you need to access properties that most documents have.
i can for example get some basic information from a powerpoint document using this code (but not the slide count).
uses shellapi,ComObj;
{$R *.dfm}
const
FmtID_SummaryInformation: TGUID =
'{F29F85E0-4FF9-1068-AB91-08002B27B3D9}';
function FileTimeToDateTimeStr(F: TFileTime): string;
var
LocalFileTime: TFileTime;
SystemTime: TSystemTime;
DateTime: TDateTime;
begin
if Comp(F) = 0 then Result := '-'
else
begin
FileTimeToLocalFileTime(F, LocalFileTime);
FileTimeToSystemTime(LocalFileTime, SystemTime);
with SystemTime do
DateTime := EncodeDate(wYear, wMonth, wDay) +
EncodeTime(wHour, wMinute, wSecond, wMilliseconds);
Result := DateTimeToStr(DateTime);
end;
end;
function GetDocInfo(const FileName: WideString): string;
var
I: Integer;
PropSetStg: IPropertySetStorage;
PropSpec: array[2..19] of TPropSpec;
PropStg: IPropertyStorage;
PropVariant: array[2..19] of TPropVariant;
Rslt: HResult;
S: string;
Stg: IStorage;
begin
Result := '';
try
OleCheck(StgOpenStorage(PWideChar(FileName), nil, STGM_READ or
STGM_SHARE_DENY_WRITE,
nil, 0, Stg));
PropSetStg := Stg as IPropertySetStorage;
OleCheck(PropSetStg.Open(FmtID_SummaryInformation,
STGM_READ or STGM_SHARE_EXCLUSIVE, PropStg));
for I := 2 to 19 do
begin
PropSpec[I].ulKind := PRSPEC_PROPID;
PropSpec[I].PropID := I;
end;
Rslt := PropStg.ReadMultiple(18, #PropSpec, #PropVariant);
OleCheck(Rslt);
if Rslt <> S_FALSE then for I := 2 to 19 do
begin
S := '';
if PropVariant[I].vt = VT_LPSTR then
if Assigned(PropVariant[I].pszVal) then
S := PropVariant[I].pszVal;
case I of
2: S := Format('Title: %s', [S]);
3: S := Format('Subject: %s', [S]);
4: S := Format('Author: %s', [S]);
5: S := Format('Keywords: %s', [S]);
6: S := Format('Comments: %s', [S]);
7: S := Format('Template: %s', [S]);
8: S := Format('Last saved by: %s', [S]);
9: S := Format('Revision number: %s', [S]);
10: S := Format('Total editing time: %g sec',
[Comp(PropVariant[I].filetime) / 1.0E9]);
11: S := Format('Last printed: %s',
[FileTimeToDateTimeStr(PropVariant[I].filetime)]);
12: S := Format('Create time/date: %s',
[FileTimeToDateTimeStr(PropVariant[I].filetime)]);
13: S := Format('Last saved time/date: %s',
[FileTimeToDateTimeStr(PropVariant[I].filetime)]);
14: S := Format('Number of pages: %d', [PropVariant[I].lVal]);
15: S := Format('Number of words: %d', [PropVariant[I].lVal]);
16: S := Format('Number of characters: %d',
[PropVariant[I].lVal]);
17:; // thumbnail
18: S := Format('Name of creating application: %s', [S]);
19: S := Format('Security: %.8x', [PropVariant[I].lVal]);
else
S := Format('unknown property#%d: %s', [i,S]);
end;
if S <> '' then Result := Result + S + #13#10;
end;
finally
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
memo1.text :=GetDocInfo('C:\mypowerpoint.ppt');
end;
There are samples in C++ in the Windows 7 SDK that demonstrate property enumeration (under Samples\winui\shell\appplatform\PropertyEdit), as well as a longer demo on CodePlex.
There isn't a "canonical" list of properties, as the property system is extensible; however, the Microsoft list of properties is part of the SDK and is found in propkey.h.