Jump to content

programmerdelphi2k

Members
  • Content Count

    1406
  • Joined

  • Last visited

  • Days Won

    22

Everything posted by programmerdelphi2k

  1. programmerdelphi2k

    Find all mentions of the database

    grep -dincl "Form1" *.* // find "Form1" in any file, counting occurrences, in sub-dirs, no case
  2. programmerdelphi2k

    Interface Reference counting

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

    Interface Reference counting

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

    General Help Indeed...a long-shot here....

    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!
  5. 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;
  6. programmerdelphi2k

    General Help Indeed...a long-shot here....

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

    Dealing with multiple component versions using the same ide

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

    Dealing with multiple component versions using the same ide

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

    Must have multiple var sections

    another BIG TIP... when you're posting a "CODE" like above use the button and choice "Delphi" as your language and "Insert..." next, next...
  10. programmerdelphi2k

    Must have multiple var sections

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

    Must have multiple var sections

    you can use "Format(...)" function to replace values in your string: you can try use "MACRO" in FireDAC, too:
  12. programmerdelphi2k

    Must have multiple var sections

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

    Find all mentions of the database

    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?
  14. programmerdelphi2k

    Delphi's __recovery folder

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

    How to change color of Title Bar without TTitleBar

    try this 2 articles by https://delphihaven.wordpress.com/2010/04/19/setting-up-a-custom-titlebar/ https://delphihaven.wordpress.com/category/glass/
  16. 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.
  17. programmerdelphi2k

    D 11.3: [FireDAC][DatS]-2. Object [myfileld] is not found

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

    VCL or FMX: My sample using Thread running in another forms for some tasks...

    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)? 😂
  19. programmerdelphi2k

    IsNullOrWhiteSpace???

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

    Printing PDF

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

    Impossilbe to find entry point for WinSATGetScore in WinSATAPI.dll

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

    Impossilbe to find entry point for WinSATGetScore in WinSATAPI.dll

    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:
  23. programmerdelphi2k

    Bugs - where to write to fix it?

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

    VCL or FMX: My sample using Thread running in another forms for some tasks...

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

    Not Threadsafe??

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