-
Content Count
1406 -
Joined
-
Last visited
-
Days Won
22
Everything posted by programmerdelphi2k
-
the "OnKeyDown" event works, you need to be on column desired. type TForm1 = class(TForm) StringGrid1: TStringGrid; // ComboBox1: TComboBox; not necessary because will be create on-the-fly StringColumn1: TStringColumn; StringColumn2: TStringColumn; StringColumn3: TStringColumn; Memo1: TMemo; procedure StringGrid1CreateCustomEditor(Sender: TObject; const Column: TColumn; var Control: TStyledControl); private function MyComboBoxToGridCustomEditor(AOwner: TComponent { TForm - Form1 } ): TComboBox; { Private declarations } procedure MyComboBoxKeyDown(Sender: TObject; var Key: Word; var KeyChar: Char; Shift: TShiftState); ... implementation {$R *.fmx} procedure TForm1.MyComboBoxKeyDown(Sender: TObject; var Key: Word; var KeyChar: Char; Shift: TShiftState); begin Caption := Format('%s, Key=%d, KeyChar=%s ', [TimeToStr(now), Key, KeyChar]); end; function TForm1.MyComboBoxToGridCustomEditor(AOwner: TComponent { TForm - Form1 } ): TComboBox; begin result := TComboBox.Create(AOwner); // now, you access the properties/events/etc.. // result.Items.AddStrings(['hello', 'world']); // result.OnKeyDown := MyComboBoxKeyDown; end; procedure TForm1.StringGrid1CreateCustomEditor(Sender: TObject; const Column: TColumn; var Control: TStyledControl); begin // Control is nil (???) = using default controls as defined on grid // Sender is TStyledGrid; // if Column.Index = 0 then // now using my ComboBox Control := MyComboBoxToGridCustomEditor(Self); // destroyed when out scope this procedure... end;
-
RADStudio 10 Seattle v. 23 - Delphi - Corel Draw 2018 v.20 - OLE Automation
programmerdelphi2k replied to Matteo Paolo Conte's topic in VCL
here Im using RAD 11.3 and using your new TLB, now, just 53 errros when trying compile it... as above, there are not many procedures in the classes imported from CorelDraw, and in your "CorelDRAW_TLB.pas" exists many errors informed by Delphi... property Point1: IVGSnapPoint read Get_Point1 write Set_Point1; <--- Set_Point1, does not exist in the class declaration, possibly due to the many errors encountered when Delphi tries to import them! "VGCore_TLB.pas" compile without errors! -
Feedback Request - FastReports vs ReportBuilder?
programmerdelphi2k replied to DBlueDev's topic in VCL
No doubt, FastReport is a great choice VCL... and price E299 < U$498 = single, no sources! -
RADStudio 10 Seattle v. 23 - Delphi - Corel Draw 2018 v.20 - OLE Automation
programmerdelphi2k replied to Matteo Paolo Conte's topic in VCL
I think there may be some incompatibility between your RAD and the version of CorelDraw you have installed... So, Delphi may not be translating the information well... Have you tried importing the CorelDraw lib in a more up-to-date version of Delphi? (ex. using a VM if dont have another pc, you can use a trial-edition for tests) -
RADStudio 10 Seattle v. 23 - Delphi - Corel Draw 2018 v.20 - OLE Automation
programmerdelphi2k replied to Matteo Paolo Conte's topic in VCL
I dont have CorelDraw, but if you see on CorelDraw_TLB exists many error reported... constructor Create(AOwner: TComponent); override; // ---> constructor Create(AOwner: TComponent); {override; compile but "hide" ancestral constructor} --> 101 errors goes to 56 errors property Center: IVGSnapPoint read Get_Center write Set_Center; ---> some methos does not exits on class declaration others below, etc... -
RADStudio 10 Seattle v. 23 - Delphi - Corel Draw 2018 v.20 - OLE Automation
programmerdelphi2k replied to Matteo Paolo Conte's topic in VCL
where is the "VGCore_TLB.pas" -
Run process with normal user privileges from elevated process
programmerdelphi2k replied to PawelPepe's topic in Windows API
... failed in another test... deleted! -
W1057 during D7 -> D11 conversion
programmerdelphi2k replied to Bart Verbakel's topic in Algorithms, Data Structures and Class Design
a simple parse can help you... and you dont need raise a exception! procedure TForm1.Button1Click(Sender: TObject); var LJSONValue: TJSONValue; begin try // '', use bool, raise Exception params LJSONValue := TJSONValue.ParseJSONValue('[', true, false); // any string: empty, valid, invalid try if (LJSONValue <> nil) then Memo1.Text := LJSONValue.ToJSON else Memo1.Text := 'JSON nil'; finally LJSONValue.Free; end; except on E: Exception do ShowMessage('JSON invalid: ' + E.Message); end; end; -
@patcat open your "FORM" as text and see the "data" embedded
-
TImage inside TComponent serializaton
programmerdelphi2k replied to isola's topic in RTL and Delphi Object Pascal
... -
TImage inside TComponent serializaton
programmerdelphi2k replied to isola's topic in RTL and Delphi Object Pascal
or more simple way; you can use only "Memory streams instead save on file" procedure TForm1.Button1Click(Sender: TObject); var LMemStream: TMemoryStream; LStrStream: TStringStream; begin LMemStream := TMemoryStream.Create; try LMemStream.WriteComponent(Image1); LMemStream.SaveToFile('myTImage.bin'); // LStrStream := TStringStream.Create; try LMemStream.Position := 0; ObjectBinaryToText(LMemStream, LStrStream); LStrStream.Position := 0; Memo1.Text := LStrStream.DataString; // showing the propers finally LStrStream.Free; end; // Image1.Picture.Bitmap := nil; // just for test... finally LMemStream.Free; end; end; procedure TForm1.Button2Click(Sender: TObject); var LMemStream: TMemoryStream; begin LMemStream := TMemoryStream.Create; try LMemStream.LoadFromFile('myTImage.bin'); LMemStream.ReadComponent(Image1); finally LMemStream.Free; end; end; -
@grantful see on Demos RAD Object Pascal\Multi-Device Samples\User Interface\ScrollableForm here blog from Fernando Rizzato, MVP Embarcadero Brazil Controlling keyboard on mobile - https://www.google.com/amp/s/blogs.embarcadero.com/pt/controlando-o-teclado-no-mobile-com-firemonkey/amp/ https://github.com/flrizzato/coding/tree/master/ScrollableForm
-
My TStringList custom SORTing, trying to mimic Windows Explorer way
programmerdelphi2k posted a topic in Algorithms, Data Structures and Class Design
Please don't be harsh with the comments... The principle is to identify the digits (numbers) contained in the text, add a bunch of "zeros" (to imitate the conversion into numerical values, but avoiding an "overflow" if using any text-to-number conversion function) and then represent them as their numerical value through the "ORD()" function. In this way, we avoid a possible "overflow exception", and we will be able to compare the strings (re-created for comparison purposes only) that are stored in a StringList or similar... I don't know if I managed to explain it well, but it needs testing... maybe in other languages. unit uMyTools; interface function MyNormalizeString(AStr: string; ASizeValue: byte = 10): string; function MyReCreatingMyString(AString: string): string; implementation uses System.SysUtils, System.StrUtils; const LMyDigits: TSysCharSet = ['0', '1', '2', '3', '4', '5', '6', '7', '8', '9']; function MyNormalizeString(AStr: string; ASizeValue: byte = 10): string; var LStr: string; LVal: string; LEnd: integer; begin LStr := ''; LVal := ''; LEnd := AStr.Length; // if not(ASizeValue in [10 .. 20]) then ASizeValue := 10; // for var i: integer := 1 to LEnd do begin if CharInSet(AStr[i], LMyDigits) then begin LVal := LVal + AStr[i]; // if ((i + 1) <= LEnd) then begin if not(CharInSet(AStr[i + 1], LMyDigits)) then begin LStr := LStr + DupeString('0', ASizeValue - LVal.Length) + LVal; LVal := ''; end; end; end else begin LStr := LStr + AStr[i]; end; end; // if not LVal.IsEmpty then LVal := DupeString('0', ASizeValue - LVal.Length) + LVal; // result := LStr + LVal; end; function MyReCreatingMyString(AString: string): string; var LStr: string; begin result := ''; // LStr := MyNormalizeString(AString); // for var C in LStr do begin if CharInSet(C, LMyDigits) then result := result + ord(C).ToString else result := result + C; end; end; end. Testing.... implementation {$R *.dfm} uses uMyTools; function MyStringListCustomSort(SL: TStringList; ALeft, ARight: integer): integer; var LCLeft, LCRight : string; CmpLeft, CmpRight: string; begin LCLeft := LowerCase(SL[ALeft]); LCRight := LowerCase(SL[ARight]); // CmpLeft := MyReCreatingMyString(LCLeft); CmpRight := MyReCreatingMyString(LCRight); // result := CompareStr(CmpLeft, CmpRight); // if (result = 0) then result := CompareStr(LCLeft, LCRight); end; procedure TForm1.Btn_CustomSortClick(Sender: TObject); var SL: TStringList; begin Memo1.Lines.Clear; // SL := TStringList.Create; try SL.Sorted := false; SL.Duplicates := TDuplicates.dupAccept; // SL.Add('Delphi1World1Hello Windows'); // 1 space SL.Add('hello2'); SL.Add('hello10'); SL.Add('hello1'); SL.Add('hello4'); SL.Add('delphi 2'); // 2 spaces SL.Add('hello 000'); // 1 space SL.Add('delphi'); SL.Add('hello3'); SL.Add('Delphi3 World2023'); // 1 space SL.Add('Custom'); SL.Add('delphi 2'); // 1 space SL.Add('Delphi1.5World10 11'); // 1.5 - 1 space SL.Add('World'); SL.Add('Delphi 1'); // 1 space SL.Add('A B C'); // 1 space + 1 space SL.Add('hello000'); // 0 space SL.Add('abc'); SL.Add('delphi 2'); // 1 space SL.Add(''); // EMPTY!!! SL.Add('Delphi10'); SL.Add('Delphi1'); SL.Add('Delphi13'); SL.Add('Delphi1.5World10 21'); // 1.5 - 1 space SL.Add('Delphi001'); SL.Add('Delphi3'); SL.Add('Delphi3World2023'); SL.Add('Delphi3 Hi!'); // 1 space SL.Add('Delphi 5'); // 1 space SL.Add('Delphi1.2World1Hello Windows'); // 1 space SL.Add('Delphi2'); SL.Add('Delphi01'); SL.Add('Delphi 3World2023'); // 1 space SL.Add('Delphi 1'); // 1 space SL.Add('Delphi12'); SL.Add('Delphi4'); SL.Add('Delphi2.5World2022'); // 2.5 SL.Add('Hello3.5'); // SL.CustomSort(@MyStringListCustomSort); // Memo1.Lines.AddStrings(SL); finally SL.Free; end; end; initialization ReportMemoryLeaksOnShutdown := true; end.- 5 replies
-
- tstinglist
- sort
-
(and 2 more)
Tagged with:
-
My TStringList custom SORTing, trying to mimic Windows Explorer way
programmerdelphi2k replied to programmerdelphi2k's topic in Algorithms, Data Structures and Class Design
my intention was not to teach the masters, it was just to expose an idea. Also, because I don't have enough knowledge to debate with MS engineers, even if they provide their own bugs! So, I usually created "each variable" to expose the phases that I take into account, and thus show my elaboration to those who don't have much more knowledge than I do. Naturally, in a production deployment, things won't be coded in this foul way, and, that makes some people cry... (either in anger or in laughter) maybe this crazy omelete stay better... function MyStringListCustomSort(SL: TStringList; ALeft, ARight: integer): integer; begin result := CompareStr(MyNormalizeString(LowerCase(SL[ALeft])), MyNormalizeString(LowerCase(SL[ARight]))); // if (result = 0) then result := CompareStr(LowerCase(SL[ALeft]), LowerCase(SL[ARight])); end;- 5 replies
-
- tstinglist
- sort
-
(and 2 more)
Tagged with:
-
Load HTML from string in TWebBrowser in Firemonkey
programmerdelphi2k replied to jerik's topic in FMX
as rule, any "critical action" should be in another place... but if strictly necessary use it! -
Load HTML from string in TWebBrowser in Firemonkey
programmerdelphi2k replied to jerik's topic in FMX
procedure TForm1.Button1Click(Sender: TObject); var HTML: string; BURL: string; begin BURL := ''; // // HTML := TResourceStream.Create(HInstance, 'index', RT_RCDATA).ToString(); HTML := '<!DOCTYPE html> <html lang="en">' + { } '<head> <meta charset=utf-8> ' + { } '<title>Test</title><style>body {background:red;}</style> ' + { } '</head><body> ' + { } '<h1>TEST</h1> <p>Dette er en tekst!</p> ' + { } '</body> </html>'; // WebBrowser1.LoadFromStrings(HTML, BURL); end; CONST X LITERAL -
@Mike Warren question: doesn't the "inplace editor" have the mission of showing a "custom" control to edit the value of what is shown in the grid? That is, when associating the variable "Control" to a new control, couldn't you simply access the properties of this "control"? function MyComboBoxToGridCustomEditor(AOwner: TComponent { TForm - Form1 } ): TComboBox; begin result := TComboBox.Create(AOwner); // now, you access the properties/events/etc.. // result.Items.AddStrings(MyAllEnumsNames); // result.OnChange := Form1.MyComboBoxChange; end; procedure TForm1.Grid1CreateCustomEditor(Sender: TObject; const Column: TColumn; var Control: TStyledControl); begin // Control is nil (???) = using default controls as defined on grid // Sender is TStyledGrid; // if Column.Index = 1 then // now using my ComboBox Control := MyComboBoxToGridCustomEditor(Self); // destroyed when out scope this procedure... end;
-
combining two characters to a string switches them
programmerdelphi2k replied to dummzeuch's topic in RTL and Delphi Object Pascal
When evaluating an expression, is not correct: first evaluate the end (if the result OK then... after evaluating the beginning That is, in the short circuit we must know whether or not we continue evaluating the expression, exactly as Delphi does when evaluating from "left to right" whether a boolean expression continues or not. However, we can only concatenate the values if we know the result of the final part, and then concatenate with the initial part. This happens with "consts" but is not easy see because the breakpoint does not stop/use it! I don't know if I explained it right (using google) NOTE: CONCAT do the same! with 2 functions = rigth to left order... with 3+ functions, the correct order happens: f1 + f2 + f3 s1 := afterThis + mid_func + firstTHIS; s1 := Format('%s %s', [firstTHIS, afterThis]); // force the correct order -
combining two characters to a string switches them
programmerdelphi2k replied to dummzeuch's topic in RTL and Delphi Object Pascal
and using "System.CONCAT( a, b, c, d, e, .... ); string1 := Concat( char1, char2); -
TFDMongoQuery data type mismatch. Current type [WideString], new type [ADT]
programmerdelphi2k replied to plv's topic in Databases
look, a JSON Object can contains another objects or array of objects when an array contains another arrays, is like "Master-Details" tables way... then, you can you can scan any item in an array and verify if objects exist or another items-of-arrays = (Master-Detail) so, you can use 2 or more Datasets with your relationship.. table2 -> depend table1 record selected -
Delphi code for reading a .ply file
programmerdelphi2k replied to dummzeuch's topic in Algorithms, Data Structures and Class Design
@dummzeuch I dont know this format, but here have a sample in C step-by-step (if help you) https://imkaywu.github.io/blog/2016/04/ply/ -
TFDMongoQuery data type mismatch. Current type [WideString], new type [ADT]
programmerdelphi2k replied to plv's topic in Databases
the "MAP" can be used based on "domain name in table" or on "type of fields"... for example: all fields type "WideString" will be used like "AnsiString".., all field named/like "xTimex" (a field type "TIME" in another format) it will be used like "TimeStamp" you see? here my sample test done long time ago... // in my example I have a field named: FDMemTable1MyFieldSQLTimeStamp // { MytabletestTable.FormatOptions.OwnMapRules := true; // MytabletestTable.FormatOptions.MapRules.Clear; // lFDMRules := MytabletestTable.FormatOptions.MapRules.Add; lFDMRules.DisplayName := 'MyMapToOracleDateTimeStamp'; lFDMRules.SourceDataType := TFDDataType.dtDateTimeStamp; lFDMRules.TargetDataType := TFDDataType.dtDateTimeStamp; // // default values lFDMRules.PrecMax := -1; // Maximum numeric precision is the maximum number of digits in the number data types lFDMRules.PrecMin := -1; // Minimum numeric precision is the minimum number of digits in the number data types lFDMRules.ScaleMax := -1; // Maximum numeric scale is the maximum number of digits after the decimal point in the number data types. Zero specifies an integer data type lFDMRules.ScaleMin := -1; // Minimum numeric scale is the minimum number of digits after the decimal point in number data types // lFDMRules.SizeMin := -1; // The length is in characters for ANSI and Unicode string data types and in bytes for byte string data types. // lFDMRules.SizeMax := -1; // The length is in characters for ANSI and Unicode string data types and in bytes for byte string data types } // // see more help in your Help System because exist more than this basic info here! // { If you need a rule to be used by more than one column, then you create a generic rule and use the properties "NameMask" and "TypeMask" so that all columns that match the given names are reached by the mapping informed above. } { lFDMRules.NameMask := 'colunmname'; // if used for many columns, use the operators as in "LIKE" lFDMRules.NameMask := '%columnname%'; // column that contain "colunmname" in its name lFDMRules.NameMask := 'colunm_me'; // column that "start" by "column" + "any char" + "me" in the end name // // The TypeMask property is useful for the databases that support domain based types, such as: // InterBase, Firebird and PostgreSQL. // lFDMRules.TypeMask have a same format than "NameMask" // } // lFDMRules.NameMask := 'HIRE%'; // all column-name started by "HIRE" -
TFDMongoQuery data type mismatch. Current type [WideString], new type [ADT]
programmerdelphi2k replied to plv's topic in Databases
Have you tried using "mapping" fields if using FireDAC components? The mapping can be done in any of the phases of the hierarchy, that is: --- FDManager ------ FDConnection ------------- FDQuery/Table/etc... then, you can inform "what it will be the type used as result" (if compatible, of course) -
search between two dates
programmerdelphi2k replied to Analyste2023's topic in RTL and Delphi Object Pascal
for that, you has the "Date" property: -
BlockRead & BlockWrite - E2010 error
programmerdelphi2k replied to Jud's topic in RTL and Delphi Object Pascal
As in many other places, the obscurity of the compiler is beyond the reach of mortals... probably, there is a bridge between "_BlockWrite" (function) and "BlockWrite" (procedure), however, the different procedures use different initial parameters: ( _BlockWrite( F: TRecFile...) and (BlockWrite( F: File...), in addition to the return of the first one. The "pointer" part is used by the other function used in the task: "WriteFile / ReadFile" from MS Windows api. unit Unit2; interface uses System.SysUtils, System.Classes, System.Types, Winapi.Windows; function _BlockWrite(var F: TFileRec; Buffer: Pointer; RecCnt: Integer; RecsWritten: PInteger): Integer; // function WriteFile(hFile: THandle; const Buffer; nNumberOfBytesToWrite: DWORD; var lpNumberOfBytesWritten: DWORD; lpOverlapped: POverlapped): BOOL; stdcall; // {$EXTERNALSYM WriteFile} implementation type {$IFDEF MSWINDOWS} TIOProc = function(hFile: THandle; Buffer: Pointer; nNumberOfBytesToWrite: DWORD; var lpNumberOfBytesWritten: DWORD; lpOverlapped: Pointer): BOOL; stdcall; {$ENDIF MSWINDOWS} {$IFDEF POSIX} TIOProc = function(Handle: Integer; Buffer: Pointer; Count: size_t): ssize_t; cdecl; {$ENDIF POSIX} function BlockIO(var F: TFileRec; Buffer: Pointer; RecCnt: Integer; RecsDone: PInteger; ModeMask: Integer; IOProc: TIOProc; ErrorNo: Integer): Integer; // Note: RecsDone ptr can be nil! {$IFDEF MSWINDOWS} var Res: DWORD; {$ENDIF MSWINDOWS} {$IFDEF POSIX} var Res: ssize_t; {$ENDIF POSIX} begin if (F.Mode and ModeMask) = ModeMask then // fmOutput or fmInOut / fmInput or fmInOut begin {$IFDEF POSIX} Res := IOProc(F.Handle, Buffer, ssize_t(RecCnt) * ssize_t(F.RecSize)); if Res = -1 then {$ENDIF POSIX} {$IFDEF MSWINDOWS} if not IOProc(F.Handle, Buffer, Cardinal(RecCnt) * F.RecSize, Res, nil) then {$ENDIF MSWINDOWS} begin SetInOutRes(GetLastError); Result := 0; end else begin {$IFDEF POSIX} Result := Integer(Res div ssize_t(F.RecSize)); {$ELSE} Result := Integer(Res div F.RecSize); {$ENDIF} if RecsDone <> nil then RecsDone^ := Result else if Result <> RecCnt then begin SetInOutRes(ErrorNo); Result := 0; end end; end else begin SetInOutRes(103); // file not open Result := 0; end; end; {$WARNINGS off} {$HINTS off} function _BlockWrite(var F: TFileRec; Buffer: Pointer; RecCnt: Integer; RecsWritten: PInteger): Integer; var xFile : TFileRec; xBuffer : Pointer; xRecCnt : Integer; xRecsWritten: PInteger; // zFile : NativeUInt; zBuffer : Pointer; zBytesToWrite: Cardinal; zBytesToRead : Cardinal; zByteWritten : Cardinal; zByteRead : Cardinal; zOverlapped : POverlapped; begin // function WriteFile; external kernel32 name 'WriteFile'; WriteFile(zFile, zBuffer, zBytesToWrite, zByteWritten, zOverlapped); // LongBool // BlockIO(var F: TFileRec; Buffer: Pointer; RecCnt: Integer; RecsDone: PInteger; ModeMask: Integer; IOProc: TIOProc; ErrorNo: Integer): Integer; BlockIO(xFile, xBuffer, xRecCnt, xRecsWritten, fmOutput, {$IFDEF MSWINDOWS} @WriteFile, {$ENDIF} {$IFDEF POSIX} __write, {$ENDIF} 100); (* Result := xxxBlockIO(F, Buffer, RecCnt, RecsWritten, fmOutput, {$IFDEF MSWINDOWS} WriteFile, {$ENDIF} {$IFDEF POSIX} __write, {$ENDIF} 101); *) end; function _BlockRead(var F: TFileRec; Buffer: Pointer; RecCnt: Integer; RecsRead: PInteger): Integer; var xFile : TFileRec; xBuffer : Pointer; xRecCnt : Integer; xRecsWritten: PInteger; // zFile : NativeUInt; zBuffer : Pointer; zBytesToWrite: Cardinal; zBytesToRead : Cardinal; zByteWritten : Cardinal; zByteRead : Cardinal; zOverlapped : POverlapped; begin ReadFile(zFile, zBuffer, zBytesToRead, zByteRead, zOverlapped); // LongBool // BlockIO(xFile, xBuffer, xRecCnt, xRecsWritten, fmOutput, {$IFDEF MSWINDOWS} @ReadFile, {$ENDIF} {$IFDEF POSIX} __read, {$ENDIF} 101); end; procedure abcdef; var rI : Integer; rLB: LongBool; // xFile : File; xBuffer: Pointer; xCount : Integer; xResult: Integer; begin BlockWrite(xFile, xBuffer, xCount, xResult); BlockRead(xFile, xBuffer, xCount, xResult); end; end.