I would like to send a BackSpace control char to a TMemo like the user would actually press the BackSpace button.
My Memo is readonly and if I click a button it should delete the last char in the memo.
I would like to do that without using Memo.Text := ... (so no redraw or beginupdate, etc.)
Is that possible, if yes, how?
Thank you for your help.
EDIT: I tried to add #8 but no luck...
Sending a key press to a read only memo won't work. The key press will be ignored because the memo is read only. To delete the final character of a memo in an efficient way, that is without replacing the entire contents, you can use EM_SETSEL and EM_REPLACESEL.
var
Len: Integer;
begin
Len := Memo1.GetTextLen;
SendMessage(Memo1.Handle, EM_SETSEL, Len-1, Len);
SendMessage(Memo1.Handle, EM_REPLACESEL, 0, LPARAM(PChar('')));
end;
Or if you prefer a pure VCL version which wraps up these Windows messages:
begin
Memo1.SelStart := Memo1.GetTextLen-1;
Memo1.SelLength := 1;
Memo1.SelText := '';
end;
The latter probably sends a few more Windows messages, but is much easier to read. I would prefer the latter option.
One possible problem I can see with this is that it may not do what you want with line breaks. Since a Windows line break is two characters (CR+LF), you would need to delete two characters if the last character in the memo was LF. To handle that you can probably do it like this:
begin
Memo1.SelStart := Memo1.GetTextLen-1;
Memo1.SelLength := 1;
if Memo1.SelText=#10 then
begin
Memo1.SelStart := Memo1.SelStart-1;
Memo1.SelLength := 2;
end;
Memo1.SelText := '';
end;
Related
So, I'm new here and I'm new to programming generally. I made this program that I needed for a project (a pascal program using Lazarus) that allows me to get a kind of list generated by replacing * by numbers. What I need is to be able to give it multiple codes to process at once (maximum 10) instead of entering every code at once.
program b;
{$mode objfpc}
{$H+}
uses sysutils;
var
sourcestr: string;
resultstr: string;
n: integer;
begin
writeln('provide a string:');
readln(sourcestr);
for n := 0 to 99 do begin
resultstr := StringReplace(sourcestr, '*', IntToStr(n div 10), []);
resultstr := StringReplace(resultstr, '*', IntToStr(n mod 10), []);
resultStr := resultStr + ':password';
writeln(resultstr);
end;
end.
I hope you could help me with this and thanks in advance.
The code below shows how to replace an arbitrary number of pairs of asterisks by the two substitute characters you are generating.
for n := 0 to 9 do begin
resultstr := sourcestr;
while Pos('*', resultstr) > 0 do begin
stringReplace(resultstr, '*', IntToStr(n div 10), []);
resultstr := StringReplace(resultstr, '*', IntToStr(n mod 10), []);
end;
resultStr := resultStr + ':password';
writeln(resultstr);
end;
It uses the Pos function in a while loop to replace the asterisk pairs. Be aware that the output may not be exactly what you need, because in each generated resultstr you will get the same substitute characters replacing each pair of asterisks, i.e.
with an input of
a ** b ** c
the resultstrs generated will be like
a00b00c
a11b11c
which may not be what you need. If not, changing the code to do what you do need is left as an exercise for the reader, as they say.
Btw, it occurred to me later that maybe you are asking how to input and process several lines'-worth of user input. One way to do that would be to read the lines into a TStringList (see online help) and then process that. Something like:
var
TL : TStringList;
sourcestr : String;
begin
TL := TStringList.Create;
repeat
readln(sourcestr);
if sourcestr <> '' then
TL.Add(sourcestr);
until sourcestr = '';
for i := 0 to TL.Count - 1 do begin
sourcestr := TL[i];
// process sourcestr however you want
end;
TL.Free;
though you could, of course, simply process sourcestr as you go along, in the repeat..until loop.
I'm trying to do a program that reads numbers from a file, outputs them into a vector and then writes them. The code compiles nicely, but when run, it gets stuck with just a prompt without delivering any output.
Program LectorDeEnteros;
type
Arreglo = array [1..30] of integer;
var
//Arch:text;
Prom:byte;
i:integer;
ArregloA:Arreglo;
Procedure CargadorVectorialdeArchivo (var ArregloA:Arreglo);
var
Arch:text;
i:integer;
Begin
assign (Arch,'Numeros.txt');
reset (Arch);
i := 1;
while not eof(Arch) do
Write(Arch);Read(ArregloA[i]);
i := i + 1;
End;
Begin
CargadorVectorialdeArchivo(ArregloA);
for i := 1 to 14 do
WriteLn(ArregloA[i]:3);
End.
As i said, there are no error messages, just the prompt and no output. I have to CTRL-Z to get it out of this "loop". The expected output would be the numbers of the array, one on each line.
Rewrite the procedure as this:
Procedure CargadorVectorialdeArchivo (var ArregloA:Arreglo);
var
Arch:text;
i:integer;
Begin
assign (Arch,'Numeros.txt');
reset (Arch);
i := 1;
while not eof(Arch) do
begin
Read(Arch,ArregloA[i]);
i := i + 1;
end;
End;
Putting Arch in front of the file tells the compiler that you want to read the contents from that file, not from the keyboard.
1.this is my code i want to read a record from a text file into array in pascal my program is about making a hotel helper and i already have a text file with the data of the hotel then i should read it from the text file and store it in array .. but i am facing error 103 exit code (file not open).... any help Please . :)
program Hotel1(input,output);
const max =10; MaxFloor =10;
type
Date = record
day :1..31;
month:1..12;
year:integer;
end;
Booking = record
Guest:string[20];
S_Date:date;
E_date:date;
end;
Booking_Mat= array[1..max] of Booking;
History_Booking = record
B_num:integer;
B_Mat:Booking_Mat;
end;
Room = record
Num:integer;
Bed_num:integer;
Price:integer;
Status:Boolean;
H:History_Booking;
end;
Data = record
Ro:Room;
m:integer;
end;
Data_mat= array [1..max] of Data;
Procedure Read_Data(filename:string; var table:Data_mat);
var df:text; i,j :integer;
n,m,num,GN:integer;
Bed_num,Price:integer;
f:text;
s,e:Date;
Gname:string[20];
ok:boolean;
a:Data_mat;
c:char;
Begin
writeln('Reading ',filename,' records into array.... ');
assign(df,filename);
reset(df);
i:=0;
while (not eof) do
begin
i:=i+1;
Read (f,num);
a[i].Ro.num:=num;
Read (f,Bed_num);
a[i].Ro.Bed_num:=Bed_num;
Read (f,Price);
a[i].Ro.Price:=Price;
Read(f,c);
if (c ='Y') then
a[i].Ro.status:= true
else
a[i].Ro.status:= false;
readln;
End; {while eof}
close(df);
End; {Read_Data}
You've declared two variables of type Text, (df and f) in your var block.
You open df with these lines:
assign(df,filename);
reset(df);
You then read from f (which is not the file you opened above) in several lines, such as this one:
Read (f, num);
It's interesting to note that you actually manage to close the file you really opened, even though you never use it in your loop:
close(df);
The solution to all of these issues is to delete the declaration of either f or df, and then fix the compiler errors you get by correcting the code to use the remaining text variable. (Two important lessons here are
Only declare the variables you actually need.
Use the variables you declare.
Your loop is also invalid, because you're using while not eof with no file provided for which to test the end. Your loop should read while not Eof(df) do instead.
It's also much better to follow the typical naming convention of prefixing types with a T. It makes it clear that it's a type and not a variable, and allows you to read the code more easily. For instance, I'd change your definition of Data to TRoomData, and change the other type declarations accordingly. Here's an example - note that TRoomData now has a field (member) named Room of type TRoom:
TRoomData = record
Room: TRoom;
m: Integer;
end;
TRoom is defined as
TRoom = record
Num: Integer;
Bed_num: Integer;
Price: Integer;
Status: Boolean;
H: THistory_Booking;
end;
And so forth. This allows you to write code more clearly:
var
RoomData: TRoomData;
begin
RoomData.Room.Num := 1;
RoomData.Room.Price := 50;
// etc.
end;
With all that being said, your file does not contain text, and therefore you're using the wrong file type by using df: Text in the first place. You should use a File of TRoomData, allowing you to read and write entire records at a time. Here's an example of doing so:
var
DF: File of TRoomData;
RoomData: TRoomData;
i: Integer;
const
DataFileName = 'D:\TempFiles\RoomData.dat';
Writing it:
// Put some data into the record
RoomData.Room.Num := 1;
RoomData.Room.Bed_num := 1;
RoomData.Room.Price := 40;
RoomData.Room.Status := True;
RoomData.Room.H.B_num := 1;
for i := 1 to Max do
begin
RoomData.Room.H.B_Mat[1].Guest := Format('Guest %d', [i]);
RoomData.Room.H.B_Mat[1].S_Date.Year := 2014;
RoomData.Ro.H.B_Mat[1].S_Date.Month := i;
RoomData.Ro.H.B_Mat[1].S_Date.Day := i;
end;
// Write it out to the file
AssignFile(DF, DataFileName);
try
Rewrite(DF);
Write(DF, RoomData);
finally
CloseFile(DF);
end;
Reading it back in:
AssignFile(DF, DataFileName);
try
Reset(DF);
Read(DF, RoomData);
finally
CloseFile(DF);
end;
(Or, better yet: If the version of Pascal you're using supports it, move away from the old file I/O routines and start using TFileStream instead.)
Last but not least, learn to properly format your code. It makes it much easier to debug and maintain, and it's much easier to read when you can follow the execution path clearly.
I am working on a particular scenario, where I have to read from a Text File, parse it, extract meaningful information from it, perform SQL queries with the information and then produce a reponse, output file.
I have about 3000 lines of code. Everything is working as expected. However I have been thinking of a connendrum that could possibly dissrupt my project.
The text file being read (lets call it Text.txt) may consist of a single line or multiple lines.
In my case, a 'line' is identified by its segment name - say ISA, BHT, HB, NM1, etc... each segment ending is identified by a special character '~'.
Now if the file consists of multiple lines (such that each line corresponds to a single segment); say:-
ISA....... ~
NM1....... ~
DMG....... ~
SE........ ~
and so on.... then my code essentially reads each 'line' (i.e. each segment), one at a time and stores it into a temp buffer using the following command :-
ReadLn(myFile,buffer);
and then performs evaluations based on each line. Produces the desired output. No problems.
However the issue is... what if the file consists of only a single line (consisting of multiple segments), represented as:-
ISA....... ~NM1....... ~DMG....... ~SE........ ~
then with my ReadLine command I read the entire line instead of each segment, one at a time. This doesn't work for my code.
I was thinking about creating an if, else statement pair...which is based on how many lines my Txt.txt file consists of..such as:-
if line = 1:-
then extract each segment at a time...seperated by the special character '~'
perform necessary tasks (3000 lines of code)
else if line > 1:-
then extract each line at a time (corresponding to each segment)
perform necessary tasks (3000 lines of code).
now the 3000 lines of code is repeated twice and I don't find it elegant to copy and paste all of that code twice.
I would appreciate if I could get some feedback on how to possibly solve this issue, such that, regardless of a one-line file or multiple-line file...when i proceed to evaluate, i only use one segment at a time.
There are many possible ways of doing this. Which is best for you might depend on how long these files are and how important performance is.
A simple solution is to just read characters one at a time until you hit your tilde delimiter.
The routine ReadOneItem below shows how this can be done.
procedure TForm1.Button1Click(Sender: TObject);
const
FileName = 'c:\kuiper\test2.txt';
var
MyFile : textfile;
Buffer : string;
// Read one item from text file MyFile.
// Load characters one at a time.
// Ignore CR and LF characters
// Stop reading at end-of-file, or when a '~' is read
function ReadOneItem : string;
var
C : char;
begin
Result := '';
// loop continues until break
while true do
begin
// are we at the end-of-file? If so we're done
if eof(MyFile) then
break;
// read in the next character
read ( MyFile, C );
// ignore CR and LF
if ( C = #13 ) or ( C = #10 ) then
{do nothing}
else
begin
// add the character to the end
Result := Result + C;
// if this is the delimiter then stop reading
if C = '~' then
break;
end;
end;
end;
begin
assignfile ( MyFile, FileName );
reset ( MyFile );
try
while not EOF(MyFile) do
begin
Buffer := ReadOneItem;
Memo1 . Lines . Add ( Buffer );
end;
finally
closefile ( MyFile );
end;
end;
I would use a file mapping via the Win32 API CreateFileMapping() and MapViewOfFile() functions, and then just parse the raw data as-is, scanning for ~ characters and ignoring any line breaks you might encounter in between each segment. For example:
var
hFile: THandle;
hMapping: THandle;
pView: Pointer;
FileSize, I: DWORD;
pSegmentStart, pSegmentEnd: PAnsiChar;
sSegment: AnsiString;
begin
hFile := CreateFile('Path\To\Text.txt', GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0);
if hFile = INVALID_HANDLE_VALUE then RaiseLastOSError;
try
FileSize := GetFileSize(hFile, nil);
if FileSize = INVALID_FILE_SIZE then RaiseLastOSError;
if FileSize > 0 then
begin
hMapping := CreateFileMapping(hFile, nil, PAGE_READONLY, 0, FileSize, nil);
if hMapping = 0 then RaiseLastOSError;
try
pView := MapViewOfFile(hMapping, FILE_MAP_READ, 0, 0, FileSize);
if pView = nil then RaiseLastOSError;
try
pSegmentStart := PAnsiChar(pView);
pSegmentEnd := pSegmentStart;
I := 0;
while I < FileSize do
begin
if pSegmentEnd^ = '~' then
begin
SetString(sSegment, pSegmentStart, Integer(pSegmentEnd-pSegmentStart));
// use sSegment as needed...
pSegmentStart := pSegmentEnd + 1;
Inc(I);
while (I < FileSize) and (pSegmentStart^ in [#13, #10]) do
begin
Inc(pSegmentStart);
Inc(I);
end;
pSegmentEnd := pSegmentStart;
end else
begin
Inc(pSegmentEnd);
Inc(I);
end;
end;
if pSegmentEnd > pSegmentStart then
begin
SetString(sSegment, pSegmentStart, Integer(pSegmentEnd-pSegmentStart));
// use sSegment as needed...
end;
finally
UnmapViewOfFile(pView);
end;
finally
CloseHandle(hMapping);
end;
end;
finally
CloseHandle(hFile);
end;
Is there any way to block the Keyboard input completely ? This should also block key combos like WIN+E.
I found this Code, is there anyway to change it to block only keyboard input (Mouse needs to work)
procedure TForm1.Button1Click(Sender: TObject) ;
function FuncAvail(dllName, funcName: string; var p: pointer): boolean;
var
lib: THandle;
begin
result := false;
p := nil;
if LoadLibrary(PChar(dllName)) = 0 then exit;
lib := GetModuleHandle(PChar(dllName)) ;
if lib <> 0 then
begin
p := GetProcAddress(lib, PChar(funcName)) ;
if p <> nil then Result := true;
end;
end;
var
BlockInput : function(Block: BOOL): BOOL; stdcall;
begin
if FuncAvail('USER32.DLL', 'BlockInput', #BlockInput) then
begin
ShowMessage('Your Mouse and Keyboard will be blocked for 5 seconds!') ;
BlockInput(true) ;
Sleep(5000) ;
BlockInput(false) ;
end;
end;
end.
Would this code also work with WIN keys etc ?
Thanks!
You're thinking way too hard.
The appropriate way to set up a kiosk that can be controlled by the mouse and not the keyboard is to not have a keyboard attached. (This also makes it impossible for an unscrupulous kiosk-user to steal your keyboard.)
This also means that, if you need to perform administrative tasks, you can attach a keyboard (or remote in) and everything will work fine.
If for some reason removing the keyboard is not a feasible option, there is an unsupported way of doing this in software: remove the UpperFilters value from
HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Class\{4D36E96B-E325-11CE-BFC1-08002BE10318}
This disables input from all normal keyboard devices, but the Remote Desktop virtual keyboard will still work, so you may want to ensure that Remote Desktop is configured and working first.
For your reference, should you want to reverse the process, UpperFilters is normally a REG_MULTI_SZ containing a single string "kbdclass" (without the quote marks).