I am developing an application using Lazarus and I have to get the characters of a text that the user has entered in a TMemo component. I am using the following code to fetch the characters one by one (here mmText is the name of the TMemo component):
var
I, J: Integer;
Line: String;
Symbol: Char;
begin
for I := 0 to mmText.Lines.Count-1 do
begin
Line := mmText.Lines[I];
for J := 1 to Length(Line) do
begin
Symbol := Line[J];
ShowMessage(Symbol); //this line is for debugging purposes
...
When latin characters are entered in the TMemo component, popup messages with each letter appear but when the cycle reaches a cyrillic character there is nothing in the popup message box.
Could you give me advice what I should do to achieve the desired result?
For those who are interested, the answer is here:
http://forum.lazarus.freepascal.org/index.php?topic=29146.msg183536#msg183536
Related
I am trying to use the DSiGetHtmlFormatFromClipboard function from the well known DSiWin32 library.
Edit: There is a much newer version of DSIWin32.pas 1.94 from 2016-10-19 which is contained in the current version of OmniThreadLibrary_3.07.1. The one I've linked to in the first line of my question is much older: 1.66 from 2012-04-20. However, also in this newer version of DSIWin32.pas the function DSiGetHtmlFormatFromClipboard does not work although I've made sure that no other clipboard programs are running.
So I put some text on the clipboard which includes the HTML format e.g. by copying some text from Chrome web-browser.
And then I use this code to get the HTML format from the clipboard:
if DSiWin32.DSiIsHtmlFormatOnClipboard then
begin
CodeSite.Send('HTML-Format string:', DSiWin32.DSiGetHtmlFormatFromClipboard);
end;
While the DSiIsHtmlFormatOnClipboard function does work (it gives back True if there is HTML Format on the clipboard and gives back False if there is no HTML Format on the clipboard), the DSiGetHtmlFormatFromClipboard function always gives back an empty string although there is HTML Format in the clipboard:
So I debugged function DSiGetHtmlFormatFromClipboard: string; in DSiWin32.pas:
On this line:
hClipData := GetClipboardData(GCF_HTML);
hClipData is always 0, so the following code is not executed.
GetClipboardData is a function from Winapi.Windows and according to MSDN documentation:
Retrieves data from the clipboard in a specified format. The clipboard
must have been opened previously.
Which is the case in the DSiWin32 code.
So why does the DSiGetHtmlFormatFromClipboard always give back an empty string?
OS: Windows 7 x64
GetLastError retrieved immediately after the line hClipData := GetClipboardData(GCF_HTML);:
ERROR_CLIPBOARD_NOT_OPEN 1418 (0x58A) Thread does not have a
clipboard open.
This is strange because the preceding line is: Win32Check(OpenClipboard(0)); and it does not fail.
Here is the relevant parts of the MCVE:
var
GCF_HTML: UINT;
function DSiIsHtmlFormatOnClipboard: boolean;
begin
Result := IsClipboardFormatAvailable(GCF_HTML);
end; { DSiIsHtmlFormatOnClipboard }
function DSiGetHtmlFormatFromClipboard: string;
var
hClipData : THandle;
idxEndFragment : integer;
idxStartFragment: integer;
pClipData : PChar;
begin
Result := '';
if DSiIsHtmlFormatOnClipboard then
begin
Win32Check(OpenClipboard(0));
try
hClipData := GetClipboardData(GCF_HTML);
if hClipData = 0 then
RaiseLastOSError;
pClipData := GlobalLock(hClipData);
Win32Check(assigned(pClipData));
try
idxStartFragment := Pos('<!--StartFragment-->', pClipData); // len = 20
idxEndFragment := Pos('<!--EndFragment-->', pClipData);
if (idxStartFragment >= 0) and (idxEndFragment >= idxStartFragment) then
Result := Copy(pClipData, idxStartFragment + 20, idxEndFragment - idxStartFragment - 20);
finally GlobalUnlock(hClipData); end;
finally Win32Check(CloseClipboard); end;
end;
end; { DSiGetHtmlFormatFromClipboard }
procedure TForm1.Button1Click(Sender: TObject);
begin
if DSiIsHtmlFormatOnClipboard then
ShowMessage(DSiGetHtmlFormatFromClipboard)
else
ShowMessage('No HTML Format on Clipboard');
end;
initialization
GCF_HTML := RegisterClipboardFormat('HTML Format');
end.
I'm using the following code added to my DBGrid - OnCellClick event
procedure TForm2.DBGrid1CellClick(Column: TColumn);
begin
if dbmodule.comenziDataSet.Active then
begin
if not Assigned(dbgridCelulaForm) then
begin
dbgridCelulaForm := TdbgridCelulaForm.Create(Self);
dbgridCelulaForm.DBMemoCelula.DataSource := dbmodule.comenziSource;
end;
dbgridCelulaForm.Visible := False;
dbgridCelulaForm.Visible := True;
dbgridCelulaForm.DBMemoCelula.DataField := Column.FieldName;
dbgridCelulaForm.Caption := Format('%s / randul: %d',[Column.FieldName, DBGrid1.DataSource.DataSet.RecNo]);
end;
end;
dbgridCelulaForm = name of the form containing the TDBMemo
DBMemoCelula = name of the TDBMemo
dbmodule.comenziDataSet = comenziDataSet is the name of the DataSet and dbmodule is the name of a data module (unit, like forms) - the DataSet is on the data module, so, dbmodule.comenziDataSet
dbmodule.comenziSource = same as data set, a DataSource on a data module, the source is named comenziSource
Ok so what this code does:
Once I click a cell on my DBGrid it pops up a form (named dbgridCelulaForm) which contains a TBMemo (named DBMemoCelula) and it shows me the information contained in that cell (like, a Customer Name for example, or whatever the cell is holding, in my db)
This is fine, my problem is I can't select rows now in DBGrid, well, I can but once I do the 1st place I click (a cell, any) on the particular row I want to select with my mouse, then cell activates and the form pops up.
Is it possible to use this code in DBGrid - OnDblClick event instead of the OnCellClick ?
Meaning once i double click a row / cell the form should pop up and show me the info, but double click - not single click.
That way, I can still select the row and still view the info in the cell if I need to.
Or any other way/place to use/receive this functionality.
Any thoughts?
I can post a quick video of everything if my explanation is ambiguous and you think that would help, just tell me in the comment / answer.
Also, I'm using RAD Studio 10 Seattle and dbexpress components for the database - if that helps.
Thanks!
The following code shows how to access the Column and Row coordinates of a dbl-clicked cell of a TDBGrid, and the string value of the cell contents.
As written, it displays the cell's Column and Row number + string contents on the form's caption. Up to you what you actually do with these values.
It work because the dataset cursor on the dataset connected to the DBGrid is moved to the dataset row corresponding to the cell where the mouse pointer is.
type
TMyDBGrid = class(TDBGrid);
procedure TForm1.DBGrid1DblClick(Sender: TObject);
var
ARow,
ACol : Integer;
Pt : TPoint;
CellValue : String;
begin
// First, get the mouse pointer coordinates
Pt.X := Mouse.CursorPos.X;
Pt.Y := Mouse.CursorPos.Y;
// Translate them into the coordinate system of the DBGrid
Pt := DBGrid1.ScreenToClient(Pt);
// Use TDBGrids inbuilt functionality to identify the Column and
// row number.
ACol := DBGrid1.MouseCoord(Pt.X, Pt.Y).X -1;
ARow := DBGrid1.MouseCoord(Pt.X, Pt.Y).Y;
CellValue := DBGrid1.Columns[ACol].Field.AsString;
Caption := Format('Col:%d Row:%d Cell Value:%s', [ACol, ARow, CellValue]);
end;
Note that I've used the Caption property of the form to display the grid cell info just as a quick n dirty way of showing the information somewhere. Of course you could equally well display it on another area of the form or somewhere on a different form entirely. The above code will work equally well in the grid's OnCellClick event, btw.
As noted in a comment, you can use the grid's SelectedField property instead of the above, but personally I think the above is more instructive of how to work with a DBGrid, because it shows how to get the cell's Column and Row coordinates. See the DBGrid's SelectedField, SelectedIndex and SelectedRows properties in the Online Help for more info on useful properties of the TDBGrid.
Update You asked in a comment for an example of showing the information on another form. Let's suppose this form is called OtherForm, is in a unit OtherFormu.Pas and is created before the DBGrid1DblClick evenbt is called. You need to use this unit in the Useslist of the unit which contains the DBGrid. Let's suppose this other form contains a TMemo control called Memo1. Then, you could write your DBGrid1DblClick hanndler like this:
procedure TForm1.DBGrid1DblClick(Sender: TObject);
[as above]
begin
[ as above ]
CellValue := DBGrid1.Columns[ACol].Field.AsString;
OtherForm.Memo1.Lines.Add(Format('Col:%d Row:%d Cell Value:%s', [ACol, ARow, CellValue]));
end;
I have problem inserting sql results into TStringGrid.I have following code:
var i:Integer;
begin
SqlQuery1.SQL.Text:= 'SELECT * FROM `users`';
SqlQuery1.Open;
MySql55Connection1.Open;
i:= 0;
while not SQLQUERY1.EOF do
begin
i:= i+1;
StringGrid1.Cells[0,i]:= SqlQuery1.FieldByName('Username').AsString;
StringGrid1.Cells[1,i]:= SqlQuery1.FieldByName('Password').AsString;
StringGrid1.Cells[2,i]:= SqlQuery1.FieldByName('id').AsString;
end;
end;
So in my database only one line. But program adding a lot of copies of this line in StringGrid and it causes error(Index out of bounds).
Danger
It appears you are storing passwords in plain text form in a database.
This is an extremely bad idea.
Never store passwords in a database.
Use salted hashes instead.
See: How do I hash a string with Delphi?
There are a couple of other problems in your code:
You don't ensure that the stringgrid has enough rows to hold your data.
You're not moving to the next line in the query.
You're opening the query before the connection is open.
You're using FieldByName inside a loop, this is going to be very slow.
Simple solution
Use a DBGrid.
If you insist on using a StringGrid
I suggest refactoring the code like so:
var
i,a:Integer;
FUsername, FPasswordHash, Fid, FSalt: TField;
begin
if not(MySQl55Connection.Active) then MySql55Connection1.Open;
SqlQuery1.SQL.Text:= 'SELECT * FROM users'; //only use backticks on reserved words.
SqlQuery1.Open;
FUsername:= SqlQuery1.FieldByName('Username');
//do not use plain text passwords!!
FPasswordHash:= SQLQuery1.FieldByName('SaltedPasswordHashUsingSHA256');
FId:= SqlQuery1.FieldByName('id');
FSalt:= SQLQuery1.FieldByName('SaltUsingCryptoRandomFunction');
a:= StringGrid1.FixedRowCount;
if SQLQuery1.RecordCount = -1 then StringGrid1.RowCount = 100 //set it to something reasonable.
else StringGrid1.RowCount:= a + SQLQuery1.RecordCount;
//SQLQuery1.DisableControls
try
i:= StringGrid1.FixedRowCount;
while not(SQLQuery1.EOF) do begin
if i >= StringGrid1.RowCount then StringGrid1.RowCount:= i;
StringGrid1.Cells[0,i]:= FUserName.AsString;
StringGrid1.Cells[1,i]:= FPasswordHash.AsString;
StringGrid1,Cells[3,i]:= FSaltInHex.AsString;
StringGrid1.Cells[2,i]:= FId.AsString;
SQLQuery1.Next; //get next row.
Inc(i);
end; {while}
finally
//just in case you want to do endupdate or close the SQLQuery or do SQLQuery1.EnableControls
end;
end;
Basic security example
Here's how to hash a password:
Download Lockbox3.
Put a THash on your form and set the hash property to SHA-512.
Use the following code to produce a hash result.
function StringToHex(const input: string): AnsiString;
var
NumBytes, i: Integer;
B: Byte;
W: word;
Wa: array[0..1] of byte absolute W;
begin
NumBytes := input.length * SizeOf(Char);
SetLength(Result, NumBytes * 2);
for i := 1 to NumBytes do begin
if SizeOf(Char) = 1 then begin
B:= Byte(input[i]);
BinToHex(#B, #Result[(I*2)+1], 1);
end else begin
W:= Word(input[i]);
BinToHex(#Wa[0], #Result[(i*4+0)],1);
BinToHex(#Wa[1], #Result[(i*4+1)],1);
end; {else}
end;
end;
function TForm1.HashPassword(var Password: string; const Salt: string): string;
var
KillPassword: pbyte;
begin
Hash1.HashString(StringToHex(Password)+StringToHex(Salt));
KillPassword:= PByte(#Password[1]);
FillChar(KillPassword^, Length(Password)*SizeOf(Char), #0); //remove password from memory.
Password:= ''; //Now free password.
end;
function GenerateSalt( ByteCount: integer = 32): string;
var
Buffer: TMemoryStream;
begin
Buffer := TMemoryStream.Create;
try
Buffer.Size := ByteCount;
RandomFillStream( Buffer);
result := Stream_to_Base64( Buffer);
finally
Buffer.Free
end;
end;
This is the minimum amount of work you can get away with whilst still having things secure.
Do not think that your passwords are unimportant because you just have a toy database, because people reuse passwords and thus your toy passwords end up being the same passwords used for online banking and such.
People are lazy....
I'm working on a Free Pascal-Lazarus (1.4.4) project where I need to highlight (using HTML tags) all occurrences of a string with another string. However, I only want to replace the string if it is text, i.e. I must ignore occurrences inside HTML tags.
For example:
I want to highlight all ocurrences of word grid (must be case insensitive):
<p class="Body"><span style="layout-grid-mode: line;" lang="EN-GB">Rome was the most important city in the world. Grid just for test. Grid again...</span></p>
Like This:
<p class="Body"><span style="layout-grid-mode: line;" lang="EN-GB">Rome was the most important city in the world. <span style="background-color: #FA8072 ; color: #ffffff;">Grid</span> just for test. <span style="background-color: #FA8072 ; color: #ffffff;">Grid</span> again...</span></p>
Please, observe that I have to ignore the word grid inside the HTML tag and change only the text.
Best regards
Here is a rustic solution using regular expressions. I assumed 1° that in text the word "grid" is neither preceded nor followed by a hyphen; 2° that in tags the word "grid" is always preceded or followed by an hyphen. If these assumptions are true, maybe this code could be a way to solve your problem.
{$APPTYPE CONSOLE}
{$IFDEF FPC}{$MODE DELPHI}{$ENDIF}
uses
regexpr;
const
SUBJECT = '<p class="Body"><span style="layout-grid-mode: line;" lang="EN-GB">Rome was the most important city in the world. Grid just for test. Grid again...</span></p>';
PATTERN = '([^-])([Gg][Rr][Ii][Dd])([^-])';
REPLACEMENT = '$1<span style="background-color: #FA8072 ; color: #ffffff;">$2</span>$3';
var
result: string;
begin
result := ReplaceRegExpr(
PATTERN,
SUBJECT,
REPLACEMENT,
TRUE // Use substitution
);
WriteLn(result);
ReadLn;
end.
fpc has a nice html parser in the unit "fasthtmlparser". It provides an event OnFoundText which fires whenever the parser finds html text (outside tags). This text is provided as a parameter, you can search the "Grid" in it and replace by whatever you want. Then you append this modified text to the previously found/modified texts.
Here is a working console project. For simplicity I am only calling StringReplace() to find the "Grid", but of course this will also replace "Grid" if contained inside a word - but you can apply Roland Chastain's RegExpr solution to avoid this.
program Project1;
{$mode objfpc}{$H+}
uses
fasthtmlparser, SysUtils;
type
TMyHTMLParser = class(THTMLParser)
private
FModifiedText: String;
procedure FoundTextHandler(Text: string);
public
property ModifiedText: String read FModifiedText write FModifiedText;
end;
procedure TMyHTMLParser.FoundTextHandler(Text: String);
begin
Text := StringReplace(Text,
'Grid',
'<span style="background-color: #FA8072 ; color: #ffffff;">Grid</span>',
[rfReplaceAll, rfIgnoreCase]
);
FModifiedText := FModifiedText + Text;
end;
const
html =
'<p class="Body">' +
'<span style="layout-grid-mode: line;" lang="EN-GB">' +
'Rome was the most important city in the world. '+
'Grid just for test. Grid again...'+
'</span>'+
'</p>:';
var
parser: TMyHTMLParser;
begin
parser := TMyHTMLParser.Create(html);
try
parser.ModifiedText := '';
parser.OnFoundText := #parser.FoundTextHandler;
parser.Exec;
WriteLn(parser.ModifiedText);
finally
parser.Free;
end;
end.
I need to go through a HTML string and replace characters with 0 (zero), except tags, spaces and line breaks. I created this code bellow, but it is too slow. Please, can someone help me to make it faster (optimize)?
procedure TForm1.btn1Click(Sender: TObject);
var
Txt: String;
Idx: Integer;
Tag: Boolean;
begin
Tag := False;
Txt := mem1.Text;
For Idx := 0 to Length(Txt) - 1 Do
Begin
If (Txt[Idx] = '<') Then
Tag := True Else
If (Txt[Idx] = '>') Then
Begin
Tag := False;
Continue;
end;
If Tag Then Continue;
If (not (Txt[Idx] in [#10, #13, #32])) Then
Txt[Idx] := '0';
end;
mem2.Text := Txt;
end;
The HTML text will never have "<" or ">" outside tags (in the middle of text), so I do not need to worry about this.
Thank you!
That looks pretty straightforward. It's hard to be sure without profiling the code against the data you're using, (which is always a good idea; if you need to optimize Delphi code, try running it through Sampling Profiler first to get an idea where you're actually spending all your time,) but if I had to make an educated guess, I'd guess that your bottleneck is in this line:
Txt[Idx] := '0';
As part of the compiler's guarantee of safe copy-on-write semantics for the string type, every write to an individual element (character) of a string involves a hidden call to the UniqueString routine. This makes sure that you're not changing a string that something else, somewhere else, holds a reference to.
In this particular case, that's not necessary, because you got the string fresh in the start of this routine and you know it's unique. There's a way around it, if you're careful.
CLEAR AND UNAMBIGUOUS WARNING: Do not do what I'm about to explain without making sure you have a unique string first! The easiest way to accomplish this is to call UniqueString manually. Also, do not do anything during the loop that could assign this string to any other variable. While we're doing this, it's not being treated as a normal string. Failure to heed this warning can cause data corruption.
OK, now that that's been explained, you can use a pointer to access the characters of the string directly, and get around the compiler's safeguards, like so:
procedure TForm1.btn1Click(Sender: TObject);
var
Txt: String;
Idx: Integer;
Tag: Boolean;
current: PChar; //pointer to a character
begin
Tag := False;
Txt := mem1.Text;
UniqueString(txt); //very important
if length(txt) = 0 then
Exit; //If you don't check this, the next line will raise an AV on a blank string
current := #txt[1];
dec(current); //you need to start before element 1, but the compiler won't let you
//assign to element 0
For Idx := 0 to Length(Txt) - 1 Do
Begin
inc(current); //put this at the top of the loop, to handle Continue cases correctly
If (current^ = '<') Then
Tag := True Else
If (current^ = '>') Then
Begin
Tag := False;
Continue;
end;
If Tag Then Continue;
If (not (current^ in [#10, #13, #32])) Then
current^ := '0';
end;
mem2.Text := Txt;
end;
This changes the metaphor. Instead of indexing into the string as an array, we're treating it like a tape, with the pointer as the head, moving forward one character at a time, scanning from beginning to end, and changing the character under it when appropriate. No redundant calls to UniqueString, and no repeatedly calculating offsets, which means this can be a lot faster.
Be very careful when using pointers like this. The compiler's safety checks are there for a good reason, and using pointers steps outside of them. But sometimes, they can really help speed things up in your code. And again, profile before trying anything like this. Make sure that you know what's slowing things down, instead of just thinking you know. If it turns out to be something else that's running slow, don't do this; find a solution to the real problem instead.
Edit: Looks like I was wrong - UniqueString is not the problem. The actual bottleneck seems to be accessing the string by character. Given that my entire answer was irrelevent, I've completely replaced it.
If you use a PChar to avoid recalculating the string offset, while still updating the string via Txt[Idx], the method is much faster (5 seconds down to 0.5 seconds in my test of 1000 runs).
Here's my version:
procedure TForm1.btn1Click(Sender: TObject);
var
Idx: Integer;
Tag: Boolean;
p : PChar;
Txt : string;
begin
Tag := False;
Txt := Mem1.Text;
p := PChar(txt);
Dec(p);
For Idx := 0 to Length(Txt) - 1 Do
Begin
Inc(p);
If (not Tag and (p^ = '<')) Then begin
Tag := True;
Continue;
end
Else If (Tag and (p^ = '>')) Then
Begin
Tag := False;
Continue;
end;
If Tag Then Continue;
If (not (p^ in [#10, #13, #32])) Then begin
Txt[Idx] := '0';
end;
end;
mem2.Text := Txt;
end;
I did some profiling and came up with this solution.
A test for > #32 instead of [#10,#13,#32] gains some speed (thanks #DavidHeffernan).
A better logic in the loop also gives a bit extra speed.
Accessing the string exclusively with the help of a PChar is more effective.
procedure TransformHTML( var Txt : String);
var
IterCnt : Integer;
PTxt : PChar;
tag : Boolean;
begin
PTxt := PChar(Txt);
Dec(PTxt);
tag := false;
for IterCnt := 0 to Length(Txt)-1 do
begin
Inc(PTxt);
if (PTxt^ = '<') then
tag := true
else
if (PTxt^ = '>') then
tag := false
else
if (not tag) and (PTxt^ > #32) then
PTxt^ := '0';
end;
end;
This solution is about 30% more effective than Mason's solution and 2.5 times more effective than Blorgbeard's.