Jump to content

programmerdelphi2k

Members
  • Content Count

    1406
  • Joined

  • Last visited

  • Days Won

    22

Everything posted by programmerdelphi2k

  1. programmerdelphi2k

    Access TStringGrid InplaceEditor

    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;
  2. programmerdelphi2k

    RADStudio 10 Seattle v. 23 - Delphi - Corel Draw 2018 v.20 - OLE Automation

    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!
  3. programmerdelphi2k

    Feedback Request - FastReports vs ReportBuilder?

    No doubt, FastReport is a great choice VCL... and price E299 < U$498 = single, no sources!
  4. programmerdelphi2k

    RADStudio 10 Seattle v. 23 - Delphi - Corel Draw 2018 v.20 - OLE Automation

    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)
  5. programmerdelphi2k

    RADStudio 10 Seattle v. 23 - Delphi - Corel Draw 2018 v.20 - OLE Automation

    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...
  6. programmerdelphi2k

    RADStudio 10 Seattle v. 23 - Delphi - Corel Draw 2018 v.20 - OLE Automation

    where is the "VGCore_TLB.pas"
  7. programmerdelphi2k

    Run process with normal user privileges from elevated process

    ... failed in another test... deleted!
  8. programmerdelphi2k

    W1057 during D7 -> D11 conversion

    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;
  9. programmerdelphi2k

    BindLinkFMXProject, where is the data?

    @patcat open your "FORM" as text and see the "data" embedded
  10. programmerdelphi2k

    TImage inside TComponent serializaton

    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;
  11. programmerdelphi2k

    Show tedit box while typing

    @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
  12. 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.
  13. 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;
  14. programmerdelphi2k

    Load HTML from string in TWebBrowser in Firemonkey

    as rule, any "critical action" should be in another place... but if strictly necessary use it!
  15. programmerdelphi2k

    Load HTML from string in TWebBrowser in Firemonkey

    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
  16. programmerdelphi2k

    Access TStringGrid InplaceEditor

    @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;
  17. programmerdelphi2k

    combining two characters to a string switches them

    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
  18. programmerdelphi2k

    combining two characters to a string switches them

    and using "System.CONCAT( a, b, c, d, e, .... ); string1 := Concat( char1, char2);
  19. 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
  20. @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/
  21. 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"
  22. 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)
  23. programmerdelphi2k

    search between two dates

    for that, you has the "Date" property:
  24. programmerdelphi2k

    BlockRead & BlockWrite - E2010 error

    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.
×