programmerdelphi2k

ShameMem in DLL / Project (view-source Project1) // DLL function MyHttp2(AValue: string): string; // stdcall; begin result := 'hello world'; end; exports MyHttp2; var Form1: TForm1; // function MyHttp2(AValue: string): string; stdcall; external 'MyDLL.DLL'; function MyHttp2(AValue: string): string; external 'MyDLL.DLL'; implementation {$R *.dfm} procedure TForm1.BtnLoadLibraryDLLClick(Sender: TObject); var MyF: function(AValue: string): string; H : THandle; begin H := LoadLibrary(PWideChar('MyDLL.DLL')); // dynamic call // if H > 0 then try MyF := GetProcAddress(H, PWideChar('MyHttp2')); // if (@MyF <> nil) then Caption := MyF('hi'); finally FreeLibrary(H); end; end; procedure TForm1.BtnCallDLLStaticBindedClick(Sender: TObject); begin Caption := MyHttp2('hi'); // static call end;

hi @DanishMale you forgot the STDCALL in DLL exportation:

did try debug the DLL to see if any error happens there?

LogFn: function GetExtWEB2(theURL: String): String;

look this: https://en.delphipraxis.net/topic/8132-using-writeln-in-dll/?do=findComment&amp;comment=68661

how you call this dll?

no... here uses ShareMem, .... ;

maybe use a temp string-var to receive and pass to restult, instead obj-NetHttp?

a little fix for "OutPutString" function MyMakeMethodDateAsStringEmpty: IInvokable; var i: integer; 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 i := Length(Args); // // ensure only one argument is received... not more or less!!! => "%s" ---> not "%s, %s" etc... if (i <> 1) then raise EEvaluatorError.Create(sFormatArgError); // // ensure that the received argument InputValue := Args[0]; // OutputString := InputValue.GetValue.ToString; // // my output will be a "string" with Date text!!! if (InputValue.GetType.Kind = tkFloat) and (OutputString = '30/12/1899') then OutputString := ''; // // return the output as "IValue", expected by LiveBinding calls!!! result := TValueWrapper.Create(OutputString); end); end;

let's try it

if you dont get, try upload 3 files above and I can try install it in my IDE and see the problem... ok? "SPPro.pas, SBProReg.pas and include file, DELPHIAREA.INC" if exists others, upload it too! zip...

old IDE dont used "namespaces" when using external unit on "USES" clause, like this: current modern IDE, use "namespaces" OR NOT, to reference the unit, like this: both above, have the same resulted by default in new modern IDE, like RAD XE...10.XX this way, it's just to (Embarcadero) "organize" the unit the belong to same scope of usage! for example: Vcl.xxx, Vcl.yyy = belong to VCL framework! this said, try use or remove the "namespaces" before unit name in your "USES" clause! look at the "magic" happens when you dont use the "namespaces" in unit name:

if your "component" use a particular folder to store your BPL, you can try use default place (just let empty the OutPut to BPL/DCP on Project-Options-Compiling...) then the BPL/DCP goes to c:\users\PUBLIC\..Embarcadero folders (the default) you can look if your unit "Register" use any special name to register your class to any specific pallete (look "RegisterComponents('Page Name', [<<array of class-compnents] )" and try changed for any other name not used

@nglthach it works in RAD 11.3 🙂 but @Remy Lebeau was more simple way and works too! 🙂 procedure TForm1.CheckBox1Click(Sender: TObject); begin MainMenu1.OwnerDraw := not MainMenu1.OwnerDraw; end; procedure TForm1.Printer1AdvancedDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState); begin // pop the HDC state that TForm saved... RestoreDC(ACanvas.Handle, -1); // Prevent the OS from drawing the arrow... ExcludeClipRect(ACanvas.Handle, ARect.Left, ARect.Top, ARect.Right, ARect.Bottom); // save the new state so TForm will restore it... SaveDC(ACanvas.Handle); end; procedure TForm1.Printer1DrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; Selected: Boolean); var LText: string; begin LText := TMenuItem(Sender).Caption; ACanvas.Brush.Style := bsSolid; ACanvas.Brush.Color := clRed; ACanvas.Rectangle(ARect); ACanvas.TextRect(ARect, LText, []); // // OnAdvancedDrawItem is fired after OnDrawItem, so don't exclude here... ExcludeClipRect(ACanvas.Handle, ARect.Left, ARect.Top, ARect.Right, ARect.Bottom); end;

unit uGameWindow; interface type TEnumGameSpeed = (gsOne, gsTwo, gsThree); TClassGameSpeed = class private FGameSpeed: TEnumGameSpeed; // store the current value // function GetGameSpeed: TEnumGameSpeed; // get value procedure SetGameSpeed(const Value: TEnumGameSpeed); // set value public // allow change or review value property GameSpeed: TEnumGameSpeed read GetGameSpeed write SetGameSpeed; end; implementation { TClassGameSpeed } function TClassGameSpeed.GetGameSpeed: TEnumGameSpeed; begin result := FGameSpeed; end; procedure TClassGameSpeed.SetGameSpeed(const Value: TEnumGameSpeed); begin FGameSpeed := Value; end; end. unit uLemGame; interface uses uGameWindow; // necessary here because the FGameSpeed field on class! type TClassGame = class private FGameSpeed: TClassGameSpeed; public constructor Create; destructor Destroy; override; // procedure Start(AReplay: boolean = false); end; implementation { TClassGame } constructor TClassGame.Create; begin FGameSpeed := TClassGameSpeed.Create; // object created end; destructor TClassGame.Destroy; begin FGameSpeed.Free; // object destroyed // inherited; end; procedure TClassGame.Start(AReplay: boolean); begin // object in usage... if AReplay then FGameSpeed.GameSpeed := TEnumGameSpeed.gsOne else FGameSpeed.GameSpeed := TEnumGameSpeed.gsTwo; end; end.

"Circular Reference" example: unit Unit1; interface uses // < ---- WARNING Unit3; // Unit1 uses Unit3 --> Unit3 uses Unit2 --> Unit2 uses Unit1 // code... implementation {$R *.dfm} // uses Unit3; // <---- usage OK end. unit Unit2; interface // < ---- WARNING uses Unit1; // Unit1 uses Unit3 --> Unit3 uses Unit2 --> Unit2 uses Unit1 <---- WONT COMPILE // code... implementation //uses Unit1; // <---- usage OK end. unit Unit3; interface // < ---- WARNING uses Unit2; // Unit1 uses Unit3 --> Unit3 uses Unit2 --> Unit2 uses Unit1 // code... implementation // uses Unit2; // <---- usage OK end.

1) "Interface" session ( unit top) is public to another units see all type/var/classes/etc... defined there... here occurs the "circular references" 2) "Implementation" session ( where your code is done ) is private for "this unit" ... (others dont see it) 3) the "circular references" happens when "unitA" call "unitB", and "unitB" call "unitA", same that INDIRECTLY!!! for example: A call C, B call A, C call B... but this "USES" is in "Interface" session. in "Implementation" session this dont occurs, because it's "privative" of each unit... you see? 4) you can only see, in others units, type/var/classes that it's defined on "Interface" session of each unit. 5) if a class, use any "private Type" into this class, then, you needs to do reference to the "class" that define the others types/class/fields/etc... you see?

if your problem can be some component (3rd party) installed, for example, you can try see on REGISTRY in HKEY_CURRENT_USER\Software\Embarcadero\BDS\<<NN.0>>\Known IDE Packages HKEY_CURRENT_USER\Software\Embarcadero\BDS\<<NN.0>>\Known Packages and delete the line where any package non-RAD and try run again... if the problem is here, just try recompile/reinstall the problematic package (3rd party component) you see?

the "arrow" is drawed by OS, here a C code that you study how manipulate it... https://www.codeguru.com/cplusplus/owner-drawing-the-submenu-arrow/

Its intention, in fact, would be to allow only one instance of the application, and allow only "n" reconnection attempts to the DB when the connection fails? CreateMutex is one of the easiest ways to do this, so maybe a "Singleton" class could help you here. As for trying to reconnect to the DB, if using FireDAC, you can make use of the "OnLost, OnRecover, OnRestored" properties and events suitable for this type of situation, however, don't expect 100%... you will need to adapt it to your application in question! unit uMySingleAppInstance; interface type IMyOneInstance = interface ['{----- GUID -------- Ctrl+G }'] procedure MyAppInstanceFree; function MyAppIsRunning(AMutexName: string; out AMsg: string): boolean; end; TMyOneInstance = class(TInterfacedObject, IMyOneInstance) strict private class { class var'S ... } var FMyInstance : IMyOneInstance; FMutexAppHandle: THandle; FMutexAppName : string; private constructor Create; procedure MyAppInstanceFree; public destructor Destroy; override; // class function GetMyAppInstance: IMyOneInstance; // function MyAppIsRunning(AMutexName: string; out AMsg: string): boolean; end; implementation uses System.SysUtils, Winapi.Windows; // MSWindows tests... { TMyOneInstance } constructor TMyOneInstance.Create; begin // just for hide it from "public" end; destructor TMyOneInstance.Destroy; begin CloseHandle(FMutexAppHandle); // inherited; end; class function TMyOneInstance.GetMyAppInstance: IMyOneInstance; begin if (FMyInstance = nil) then FMyInstance := TMyOneInstance.Create; // result := FMyInstance; end; procedure TMyOneInstance.MyAppInstanceFree; begin FMyInstance := nil; end; function TMyOneInstance.MyAppIsRunning(AMutexName: string; out AMsg: string): boolean; var LOSLastError: cardinal; begin result := true; // // an exclusive name... if FMutexAppName.IsEmpty then begin if AMutexName.Trim.IsEmpty then FMutexAppName := 'MyAppMutextNameExclusive' else FMutexAppName := AMutexName.Trim; end; // try FMutexAppHandle := CreateMutex(nil, false, PWideChar(FMutexAppName)); // AMsg := 'Mutex: ' + FMutexAppName + '=' + FMutexAppHandle.ToString; // if (FMutexAppHandle = 0) then // Couldn't open handle at all RaiseLastOSError; // LOSLastError := GetLastError; // if not(LOSLastError = ERROR_ALREADY_EXISTS) then // We are not the first instance. result := false; except on E: Exception do // generic exception AMsg := 'Error: ' + E.Message; end; end; initialization ReportMemoryLeaksOnShutdown := true; finalization var LAppInstanceToFree := TMyOneInstance.GetMyAppInstance; // if LAppInstanceToFree <> nil then LAppInstanceToFree.MyAppInstanceFree; end. unit uMyDBConnectionTry; interface uses FireDAC.Stan.Intf, FireDAC.Stan.Option, FireDAC.Stan.Error, FireDAC.UI.Intf, FireDAC.Phys.Intf, FireDAC.Stan.Def, FireDAC.Stan.Pool, FireDAC.Stan.Async, FireDAC.Phys, FireDAC.VCLUI.Wait, Data.DB, FireDAC.Comp.Client; type TMyProcReference = reference to procedure(const AMsg: string); function MyTryingDBConnect(const ADBConn: TFDConnection; out AMsg: string; { } const AProc: TMyProcReference; ATries: byte = 3; const AInterval: word = 2000): boolean; implementation uses System.SysUtils; // it should be in a "THREAD" to release your UI... No need "Timers" // // if using FireDAC, you can use the "events" for Lost, Recover, Restore connection + properties! // FireDAC try do it automatically!!! function MyTryingDBConnect(const ADBConn: TFDConnection; out AMsg: string; { } const AProc: TMyProcReference; ATries: byte = 3; const AInterval: word = 2000): boolean; var LCounter : word; LInterval: word; begin result := false; AMsg := 'DB connected'; LCounter := 1; LInterval := AInterval; // if (ADBConn = nil) then begin AMsg := 'AConn = nil'; exit; // end; // if not(ATries in [1 .. 5]) then ATries := 3; // if (AInterval < 1000) or (AInterval > 10000) then LInterval := 2000; // while (LCounter <= ATries) do begin if Assigned(AProc) then AProc('Try = ' + LCounter.ToString); // try ADBConn.Connected := true; result := true; break; except on E: exception do AMsg := 'Try = [' + LCounter.ToString + ']' + slinebreak + E.Message; end; // LCounter := LCounter + 1; // sleep(LInterval); // waiting a while... dont abuse! end; end; end. program Project1; uses Vcl.Forms, uMainForm in 'uMainForm.pas' {FormMain}, uFormPassWord in 'uFormPassWord.pas' {PasswordDlg}, uMySingleAppInstance in 'uMySingleAppInstance.pas', uMyDBConnectionTry in 'uMyDBConnectionTry.pas'; {$R *.res} var LText: string; begin if TMyOneInstance.GetMyAppInstance.MyAppIsRunning('MyAppNameExclusive', LText) then exit; // Application.Initialize; Application.MainFormOnTaskbar := True; Application.CreateForm(TFormMain, FormMain); Application.Run; end. var FormMain: TFormMain; implementation {$R *.dfm} uses uMySingleAppInstance, uMyDBConnectionTry; procedure MyProcForTest(const AMsg: string); begin FormMain.Button1.Caption := AMsg; end; procedure TFormMain.Button1Click(Sender: TObject); var LMsg: string; begin if not MyTryingDBConnect(FDConnection1, LMsg, MyProcForTest, 3, 1500) then ShowMessage(LMsg); end; end.

YOU can call "Form1.FormShow(Self)" before "SHOW" your forms, to execute this event!!! no needs wait that it be on the screen! var LFlagFormShow: boolean = true; // false // global var no necessary good for all, then, try a property of the object! procedure TForm1.FormShow(Sender: TObject); begin if not LFlagFormShow then exit; // ... end;

this would works for you? unit uMyControlsBeforeFormCreate; interface uses System.SysUtils, System.Classes, Vcl.Controls, Vcl.Forms, Vcl.StdCtrls, Vcl.ExtCtrls, Vcl.Dialogs; procedure CreateMyPanelFromDPR(AOwner: TComponent; AParent: TWinControl; APanelName: string); procedure ComponentsOnForm1(const AForm: TForm); implementation procedure CreateMyPanelFromDPR(AOwner: TComponent; AParent: TWinControl; APanelName: string); var APanel: TPanel; begin if (AOwner = nil) then AOwner := Application; // if (AParent = nil) then AParent := Application.MainForm; // if (APanelName.IsEmpty) then APanelName := 'PanelHello'; // APanel := TPanel.Create(AOwner); APanel.Name := APanelName; APanel.Parent := AParent; // APanel.Left := 10; APanel.Top := 10; APanel.Width := 200; APanel.Height := 200; // APanel.Caption := AOwner.ToString + AParent.ToString; end; procedure ComponentsOnForm1(const AForm: TForm); var LMemo: TComponent; begin if (AForm = nil) and not(AForm is TForm) then exit; // LMemo := AForm.FindComponent('Memo1'); // if (LMemo <> nil) and (LMemo is TMemo) then begin TMemo(LMemo).Text := 'Application components'; // for var i: integer := 0 to (Application.ComponentCount - 1) do TMemo(LMemo).Lines.Add(Application.Components[i].ToString); // TMemo(LMemo).Lines.Add(slinebreak + 'Form1 components'); // for var i: integer := 0 to (AForm.ComponentCount - 1) do TMemo(LMemo).Lines.Add(AForm.Components[i].ToString); // TMemo(LMemo).Lines.Add(slinebreak + 'Form1 controls'); // for var i: integer := 0 to (AForm.ControlCount - 1) do TMemo(LMemo).Lines.Add(AForm.Controls[i].ToString); end; end; end. program Project1; uses Vcl.Forms, uFormMain in 'uFormMain.pas' {Form1} , uMyControlsBeforeFormCreate in 'uMyControlsBeforeFormCreate.pas'; {$R *.res} begin ReportMemoryLeaksOnShutdown := true; // Application.Initialize; Application.MainFormOnTaskbar := true; Application.CreateForm(TForm1, Form1); // CreateMyPanelFromDPR( { Application, Form1 } Form1, { Form1 } nil, 'PanelHello'); // ComponentsOnForm1(Form1); // Application.Run; end. type TForm1 = class(TForm) Memo1: TMemo; procedure FormShow(Sender: TObject); private procedure MyPanelClick(Sender: TObject); public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.FormShow(Sender: TObject); var LCmp: TComponent; begin LCmp := FindComponent('PanelHello'); // if (LCmp <> nil) and (LCmp is TPanel) then TPanel(LCmp).OnClick := MyPanelClick; end; procedure TForm1.MyPanelClick(Sender: TObject); begin ShowMessage('Hello Panel'); end; end.

voted

some "FILTER" checked/unchecked To-Do setup?