-
Content Count
1406 -
Joined
-
Last visited
-
Days Won
22
Everything posted by programmerdelphi2k
-
grep -dincl "Form1" *.* // find "Form1" in any file, counting occurrences, in sub-dirs, no case
-
Interface Reference counting
programmerdelphi2k replied to Incus J's topic in RTL and Delphi Object Pascal
implementation uses System.SysUtils, Vcl.Dialogs; { TMyClassX } destructor TMyClassX.Destroy; begin ShowMessage('calling TMyClass.Destroy...'); /// how many times is called? // inherited; end; // verifying pointer function TMyClassX.Hello(AValue: string = ''): string; begin result := 'Pointer: ' + integer(Self).ToString + ' ' + 'Hello World: ' + AValue + ' ref-Counting: (' + Self.RefCount.ToString + ') '; end; -
Interface Reference counting
programmerdelphi2k replied to Incus J's topic in RTL and Delphi Object Pascal
as you want "have" a obj-reference in your function( var XXXX ):boolean.... you should use function( out XXXX):boolean; the scope should be the same then "var definition" on caller procedure!!! if "the var is LOCAL (into proceudre) then the life is local", else if the var is "unit-GLOBAL", then, the obj is alive while unit is alive. unit uMyInterfX; interface type IMyInterfX = interface ['{AE871A32-4B6A-4E4B-B825-92B762493D3F}'] function Hello(AValue: string = ''): string; function HelloObj(out MyObjOUT: IMyInterfX): boolean; end; TMyClassX = class(TInterfacedObject, IMyInterfX) private public function Hello(AValue: string = ''): string; function HelloObj(out MyObjOUT: IMyInterfX): boolean; end; implementation uses System.SysUtils; { TMyClassX } function TMyClassX.Hello(AValue: string = ''): string; begin result := 'Hello World: ' + AValue + ' ref-Counting: (' + Self.RefCount.ToString + ') '; end; function TMyClassX.HelloObj(out MyObjOUT: IMyInterfX): boolean; begin result := false; // try MyObjOUT := TMyClassX.Create; // created locally, but will be refereced in "caller Obj"-scope!! result := true; except // ? end; end; end. var Form1: TForm1; implementation {$R *.dfm} uses uMyInterfX; var LMyInterfXGLOBALForUnit: IMyInterfX; LObjGlobal : IMyInterfX; procedure MyOtherProc(const AObj: IMyInterfX); begin if (AObj <> nil) then ShowMessage(AObj.Hello(' AObj from MyOtherProc')); end; procedure TForm1.Button1Click(Sender: TObject); var LMyInterfXLOCALForProcedure: IMyInterfX; LObj : IMyInterfX; // local obj interfaced but will created into "TMyClass interfaced" ... it is gone too! LObj2 : IMyInterfX; begin LMyInterfXLOCALForProcedure := TMyClassX.Create; // ...try ShowMessage(LMyInterfXLOCALForProcedure.Hello + ' LMyInterfXLOCALForUnit'); // finally // ...LMyInterfXLOCALForProcedure.FREE; // does not works in Interfaced object!!! // ...end; // if LMyInterfXLOCALForProcedure.HelloObj(LObj) and (LObj <> nil) then ShowMessage(LObj.Hello(' from LObj (Local)')); // MyOtherProc(LObj); LObj2 := LObj; MyOtherProc(LObj); // // LMyInterfXGLOBALForUnit := TMyClassX.Create; // ShowMessage(LMyInterfXLOCALForProcedure.Hello + ' LMyInterfXGLOBALForUnit'); // if LMyInterfXGLOBALForUnit.HelloObj(LObjGlobal) and (LObjGlobal <> nil) then ShowMessage(LObjGlobal.Hello(' from LObj (Global)')); // // summary: // LMyInterfXLOCALForProcedure is done when this procedure out-of-scope // LMyInterfXGLOBALForUnit still alive same that this procedure is out-of-scope... until unit is gone! end; procedure TForm1.Button2Click(Sender: TObject); var LObj2: IMyInterfX; begin // ShowMessage(LMyInterfXLOCALForProcedure.Hello + ' LMyInterfXLOCALForUnit'); // not works because it's a LOCAL definition // if (LMyInterfXGLOBALForUnit <> nil) then begin ShowMessage(LMyInterfXGLOBALForUnit.Hello + ' LMyInterfXGLOBALForUnit is alive'); // if (LObjGlobal <> nil) then ShowMessage(LObjGlobal.Hello(' Obj Global its alive ')) else ShowMessage('Obj Global is nil'); end else ShowMessage('LMyInterfXGLOBALForUnit is nil'); // MyOtherProc(LObjGlobal); LObj2 := LObjGlobal; MyOtherProc(LObjGlobal); end; initialization ReportMemoryLeaksOnShutdown := true; end. -
General Help Indeed...a long-shot here....
programmerdelphi2k replied to S1ack's topic in General Help
You need find "WHERE" the TParts class is defined... not where it is used!!! for example: any class is defined like this: Txxxxxx = class( .... ).... then, you need find "what unit (Pas file) is defining your class desired, in case "TParts" then, you can put the path (c:\xxxx\xxxx) folder on "Search Path", for example. TIP: look at "USES" clause and see the unit names... maybe you can find a peculiar name... like, uMyParts -- you understand? not necessary this name of course! -
TDate convertion for default (0) value to empty string (livebinding)
programmerdelphi2k replied to JohnF's topic in RTL and Delphi Object Pascal
LiveBinding allow that you create yourself "Methods / Conversors" to use in your projects: Create a new package (DPK) to create your procedure, for example: unit uMyMethodInvokable; interface // more info: RAD Studio HELP SYSTEM: Creating Custom LiveBindings Methods implementation uses System.SysUtils, System.Bindings.Methods, System.Bindings.EvalProtocol, System.Bindings.Consts, System.TypInfo, // System.Rtti, System.MaskUtils, System.DateUtils; // function named: MakeMethod"XXXXXXXXXXX" convention LiveBinding!!! function MyMakeMethodDateAsStringEmpty: IInvokable; begin // return a "anonimous-function "Invokable" type... result := MakeInvokable( { } function(Args: TArray<IValue>): IValue var InputValue: IValue; // receive the value in "%s" passed InputString, OutputString: string; begin // ensure only one argument is received... not more or less!!! => "%s" ---> not "%s, %s" etc... if (Length(Args) <> 1) then raise EEvaluatorError.Create(sFormatArgError); // // ensure that the received argument InputValue := Args[0]; // // if not(InputValue.GetType.Kind in [tkString, tkWideString, tkWChar, tkWString]) then // raise EEvaluatorError.Create('Error 2: ' + sFormatExpectedStr); // // my output will be a "string" with Date text!!! if InputValue.GetType.Kind = tkFloat then begin OutputString := InputValue.GetValue.ToString; // if (OutputString = '30/12/1899') then OutputString := ''; end else OutputString := '01/01/1981'; // // return the output as "IValue", expected by LiveBinding calls!!! result := TValueWrapper.Create(OutputString); end); end; initialization TBindingMethodsFactory.RegisterMethod( { AMethodDescription : TMethodDescription } TMethodDescription.Create( { } MyMakeMethodDateAsStringEmpty, { AInvokable : IInvokable } 'MyDateAsStringEmptyCustom', { AID : string } 'MyDateAsStringEmptyCustom', { Name : string } 'uMyMethodInvokable', { AUnitName : string } true, { ADefaultEnabled : boolean } sFormatDesc, { ADescription : string } nil { AFrameWorkClass : TPersistentClass } ) { } ); finalization TBindingMethodsFactory.UnRegisterMethod('MyDateAsStringEmptyCustom' { AID : string } ); end. Now, build and install the new package ... "MyDateAsStringEmptyCustom" methods is avaliable for use in any project using LiveBindings, now! now, just use it in your LiveBinding field, like this: Vcl.StdCtrls {} , uMyMethodInvokable {my custom method} ; type TForm1 = class(TForm) PrototypeBindSource1: TPrototypeBindSource; BtnEditRecord: TButton; BindingsList1: TBindingsList; StringGridPrototypeBindSource1: TStringGrid; LinkGridToDataSourcePrototypeBindSource1: TLinkGridToDataSource; NavigatorPrototypeBindSource1: TBindNavigator; Label1: TLabel; procedure BtnEditRecordClick(Sender: TObject); procedure FormShow(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.BtnEditRecordClick(Sender: TObject); var LDate: TArray<TDate>; i : integer; begin LDate := [ StrToDate('30/12/1899'), StrToDate('30/12/1900') ]; // i := random(2); Label1.Caption := 'Current value: ' + DateToStr(LDate[i]); // PrototypeBindSource1.DataGenerator.Edit; PrototypeBindSource1.DataGenerator.Fields.Items[0].SetTValue(LDate[i]); PrototypeBindSource1.DataGenerator.Fields.Items[1].SetTValue(LDate[i]); end; procedure TForm1.FormShow(Sender: TObject); begin StringGridPrototypeBindSource1.DefaultColWidth := 200; end; -
General Help Indeed...a long-shot here....
programmerdelphi2k replied to S1ack's topic in General Help
These classes do not belong to Delphi, they will be defined in external units, that is, they are defined in some other file accessed by your project in Delphi5... check all the units (.Pas files) inside the project folders. In Delphi you can ask it to search for some text in all project files, check the "Find in files..." option in the Edit menu, if it exists in Delphi5. If they are found, then you need to add their path in the project settings -> Project, Options, --> Library Path... This way, the compiler will be able to find and compile without errors. -
Dealing with multiple component versions using the same ide
programmerdelphi2k replied to Gonzalo Fernandez's topic in Delphi IDE and APIs
in fact, using "R" param, nothing (files) it's really duplicated or similar... just a new key will be created on Registry to new session. this create a "RAD" session with only "default" references... that way, you can install your components using: if you want create your binary (DCU, BPL, DCP, etc...) ---> do it as expected, open DPK build and install! you can define "where" (folder) you desire use creating a "DPROJ" for each IDE (same that the "same") as Delphi do it! so, each "DPK" can have itself setup! (as it was a other-IDE) you see? if you have a installer (for example, DevExpress install), then, you can use just "Component -> Install Component" and indicated where is the BPL/DCP/DCU/PAS files, not needs re-Build again! You see? Do it that way, YOU DONT need re-Duplicate files for each IDE-session! at end, you'll have "many IDE-sessions" and using the same binary files, or, at last case, (when have distincts IDEs) each components in itself folders, as default when we have many IDEs using same component suites! nothing different.... if dont needs anymore the "new session IDE", just delete it from Registry! (and any other residual files used in your "components installations" -- if you do it) -
Dealing with multiple component versions using the same ide
programmerdelphi2k replied to Gonzalo Fernandez's topic in Delphi IDE and APIs
I dont know if I understood... but the RAD allow that run a session with a new name (like MSWin login user), then you would can install your components in each "session"... Each session it's just a new key Embarcadero on registry tree... look at HCU...Embarcadero see on help how to use -R param on BDS.EXE command ...\bds.exe -r MyNewSesstionName -
another BIG TIP... when you're posting a "CODE" like above use the button and choice "Delphi" as your language and "Insert..." next, next...
-
more one tip: "IF" (I said "IF") possible, forget "WITH" usage... mainly when for while... it's very confused... when you are a "master", then, all it's allowed 🙂
-
you can use "Format(...)" function to replace values in your string: you can try use "MACRO" in FireDAC, too:
-
your initial error is in .Add('select Stock_pack,stockOrder = 1 from ValuePackLinks where Pack_component1 = ' +stocknummm ) ; try some like this: procedure TForm1.Button1Click(Sender: TObject); const LSQLSelect: string = 'SELECT xFieldx from xTablex WHERE yFieldy = %d'; var LValues : TArray<integer>; LSQLText: string; begin for var i: integer := 1 to 10 do // just for test values... not necessar! LValues := LValues + [i]; // LSQLText := ''; // for var i in LValues do // more quick than use a component.property LSQLText := LSQLText + '***' + Format(LSQLSelect, [i]); // + slinebreak + ' UNION ' + slinebreak; // if not(LSQLText.IsEmpty) then begin // LSQLText := LSQLText.Remove(0, 3); // remove 3 chars on init... '***'; LSQLText := LSQLText.Remove(0, 3).Replace('***', slinebreak + ' UNION ' + slinebreak); // replace '***' for another text // Memo1.Text := LSQLText; // // if all it's ok, then you can use it: MyFDQuery.SQL.Text := LSQLText; // directly end; end; end.
-
if the "text desired" is in "text format (not coded, hex, binary, etc...) then, you can try use the "Search in Files" in Edit menu from Delphi... Text to find = << your text >> (not whole world...) Search in ALL FILES in PROJECT... file mask = (empty or *.* ) dir = << your project fodler >> is this?
-
Delphi's __recovery folder
programmerdelphi2k replied to David Schwartz's topic in Delphi IDE and APIs
double click on Recovery list and choice last-saved changes... you can choice "discart or not" when closing window tip: look the time used for save changes (backups) https://docwiki.embarcadero.com/RADStudio/Sydney/en/Saving_and_Desktop it's possible that the file be overrided when discarted, then no chance to undelete... or be a 'symbolic link' to real folder used. -
How to change color of Title Bar without TTitleBar
programmerdelphi2k replied to GP_23's topic in VCL
try this 2 articles by https://delphihaven.wordpress.com/2010/04/19/setting-up-a-custom-titlebar/ https://delphihaven.wordpress.com/category/glass/ -
VCL or FMX: My sample using Thread running in another forms for some tasks...
programmerdelphi2k posted a topic in General Help
My sample using Thread running in another forms some tasks... not 100% perfect or SAFE... but works if you take a care about my "little code" of course, needs to know "what going on..." and to do some changes for a specific usage... then, dont blame me, this it's just a simple sample. ok? take the idea and do better!!! maybe a "container using Observer Pattern" would help here, but "arrays" was good for me in this time! try close all forms, or simply the mainform 🙂 you CAN click many time on Button and raise yourS threadS... 1x, 2x, 3x, etc... dont abuse :))) // ---- FormMain ----- var MainForm : TMainForm; LHowManyThreadRunning: integer = 0; // Global vars was just for my test... dont use it, at all!!! implementation {$R *.dfm} uses uFormWithThread; var LArrForms: TArray<TForm>; LTop : integer = 0; LLeft : integer = 0; procedure MyDestroyForms; begin for var F in LArrForms do if (F <> nil) then FreeAndNil(F); end; procedure TMainForm.Bnt_Call_Form_ThreadClick(Sender: TObject); var i: integer; begin i := Length(LArrForms); LArrForms := LArrForms + [TFormWithThread.Create(nil)]; LArrForms[i].Top := LTop; LArrForms[i].Left := LLeft; LArrForms[i].Show; // LTop := LTop; LLeft := LLeft + LArrForms[i].Width; end; procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean); begin CanClose := LHowManyThreadRunning = 0; end; procedure TMainForm.FormDestroy(Sender: TObject); begin MyDestroyForms; end; procedure TMainForm.Btn_Try_Close_All_Form_ShowingClick(Sender: TObject); begin for var F in LArrForms do if (F <> nil) then F.Close; end; initialization ReportMemoryLeaksOnShutdown := true; end. // --- Secondary Forms... var FormWithThread: TFormWithThread; implementation {$R *.dfm} uses uMyThread, uFormMain; var LArrThreads: TArray<TMyThread>; function MyCanClose: Boolean; begin result := false; // while (Length(LArrThreads) > 0) do begin // trying kill the thread... LArrThreads[0].Terminate; LArrThreads[0].WaitFor; LArrThreads[0].Free; // // if ok, remove it from list delete(LArrThreads, 0, 1); end; // LHowManyThreadRunning := Length(LArrThreads); result := LHowManyThreadRunning = 0; end; procedure TFormWithThread.Btn_RunThreadClick(Sender: TObject); var i: integer; begin i := Length(LArrThreads); LArrThreads := LArrThreads + [TMyThread.Create(MyUpdateButtonCaption)]; // Memo1.Lines.Add(TimeToStr(now) + ' CurrentThread: ' + TThread.CurrentThread.ThreadID.ToString + ' ... App'); // LArrThreads[i].Start; // LHowManyThreadRunning := LHowManyThreadRunning + 1; MyAnimation.StartAnimation; end; procedure TFormWithThread.FormCloseQuery(Sender: TObject; var CanClose: Boolean); begin LHowManyThreadRunning := Length(LArrThreads); CanClose := LHowManyThreadRunning = 0; // if not CanClose then CanClose := MyCanClose; end; procedure TFormWithThread.MyUpdateButtonCaption(const AValue: string); begin Memo1.Lines.Add(TimeToStr(now) + ' CurrentThread: ' + TThread.CurrentThread.ThreadID.ToString + ' ' + AValue); end; end. unit uMyThread; interface uses System.SysUtils, System.Classes, System.Threading; type TMyProcReference = reference to procedure(const AValue: string); TMyThread = class(TThread) strict private FProc : TMyProcReference; FLCounter : integer; FLThreadID: string; protected procedure Execute; override; procedure DoTerminate; override; public constructor Create(const AProc: TMyProcReference = nil); overload; end; implementation { TMyThread } constructor TMyThread.Create(const AProc: TMyProcReference = nil); begin inherited Create(true); // FProc := AProc; FLThreadID := ThreadID.ToString; FLCounter := 0; end; procedure TMyThread.DoTerminate; begin FLThreadID := ThreadID.ToString; // if Assigned(FProc) then TThread.Queue(nil, procedure begin FProc('This is the end! FLThreadID: ' + FLThreadID + ' LCounter: ' + FLCounter.ToString); end); end; procedure TMyThread.Execute; begin while not Terminated do begin FLThreadID := ThreadID.ToString; // if (FLCounter = 100) then break; // if Assigned(FProc) then TThread.Queue(nil, procedure begin FProc('FLThreadID: ' + FLThreadID + ' LCounter: ' + FLCounter.ToString); end); // // simulating a process... "LCounter just for test n process" FLCounter := FLCounter + 1; sleep(500); end; end; end. -
D 11.3: [FireDAC][DatS]-2. Object [myfileld] is not found
programmerdelphi2k replied to jesu's topic in Databases
RAD 11.3 --> No problem with FDMemtables and LoadFiles JSON/XML types! type TForm1 = class(TForm) DBGrid1: TDBGrid; DataSource1: TDataSource; Button1: TButton; FDStanStorageBinLink1: TFDStanStorageBinLink; FDStanStorageXMLLink1: TFDStanStorageXMLLink; FDStanStorageJSONLink1: TFDStanStorageJSONLink; Button2: TButton; Button3: TButton; Button4: TButton; FDMemTable1: TFDMemTable; DBMemo1: TDBMemo; procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); procedure Button3Click(Sender: TObject); procedure Button4Click(Sender: TObject); private procedure FDMemTableOpenMyFile(const AFileName: string); public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.FDMemTableOpenMyFile(const AFileName: string); begin DBMemo1.DataSource := nil; // FDMemTable1.LoadFromFile(AFileName); // if FDMemTable1.FieldDefs.IndexOf('myBlob') > -1 then begin DBMemo1.DataSource := DataSource1; DBMemo1.DataField := 'myBlob'; end; end; procedure TForm1.Button1Click(Sender: TObject); begin FDMemTableOpenMyFile('..\..\MyData.json'); // id-integer, names-string end; procedure TForm1.Button2Click(Sender: TObject); begin FDMemTableOpenMyFile('..\..\MyData.xml'); // birthday-date, money-currency end; procedure TForm1.Button3Click(Sender: TObject); begin FDMemTableOpenMyFile('..\..\MyData2.json'); // blob, id, names end; procedure TForm1.Button4Click(Sender: TObject); begin FDMemTableOpenMyFile('..\..\MyData2.xml'); // blob, id, names end; end. -
VCL or FMX: My sample using Thread running in another forms for some tasks...
programmerdelphi2k replied to programmerdelphi2k's topic in General Help
Neither did I, regarding your insistence! After all, you must have something much more important to do, right? Or are you not sure about that either (too)? 😂 -
if you see in "source code", you should can ignored this, in better choice! better would be, directly "if LVar.Trim.Length = 0 then ...", no pain, no gain.... no trap!
-
you try create TLB from DLL file, then you can it as a procedure Delphi... IDE - Components... Import Components....etc... see help! in command-line: TLibImp.exe (32 and 64bits versions in ..\bin and ...\bin64 folders) with param -P to create Pascal files.
-
Impossilbe to find entry point for WinSATGetScore in WinSATAPI.dll
programmerdelphi2k replied to Silver Black's topic in Windows API
the RAD has a TLibImp exe 32/64 that allow create your TLB in command-line (IDE show dll 32bits). param -P allow create your Delphi Pascal imports RADStudio\11.0\bin64\tlibimp.exe” -P My64bit.DLL -
Impossilbe to find entry point for WinSATGetScore in WinSATAPI.dll
programmerdelphi2k replied to Silver Black's topic in Windows API
I dont know so much about DLL exportations, but many DLL (system) using export the procedure by "name" or "index"... then maybe you can try some like this: -
you can create yourself "helpers" too... if the class/type dont have it... Vcl.Grids, Vcl.StdCtrls; type TSGMyHelper = class helper for TStringGrid type TMyHack = class(TStringGrid); procedure MyRowMove(IdxFrom, IdxTo: integer); end; TForm1 = class(TForm) StringGrid1: TStringGrid; Button1: TButton; procedure FormCreate(Sender: TObject); procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} { TSGMyHelper } procedure TSGMyHelper.MyRowMove(IdxFrom, IdxTo: integer); begin TMyHack(Self).RowMoved(IdxFrom, IdxTo); end; { Form1 } procedure TForm1.FormCreate(Sender: TObject); begin for var i: integer := 0 to (StringGrid1.RowCount - 1) do StringGrid1.Cells[1, i] := 'hello ' + i.ToString; end; procedure TForm1.Button1Click(Sender: TObject); begin StringGrid1.MyRowMove(3, 1); end; end.
-
VCL or FMX: My sample using Thread running in another forms for some tasks...
programmerdelphi2k replied to programmerdelphi2k's topic in General Help
I beg a billion apologies, "oh universal wisdom and Master of all Mages" 🤧, for forgetting to use "Synchronism" in the "Execute" procedure... You forgive me please, I won't know how to live without your forgiveness.... 😁 NOTE: The "Start procedure" exists for a reason, doesn't it? (I like him) -
hi @Ian Branch try my sample here https://en.delphipraxis.net/topic/8653-vcl-or-fmx-my-sample-using-thread-running-in-another-forms-for-some-tasks/