I am trying to open a form and close the form behind it in Delphi 10 [duplicate] - forms

Application has a Login form and a Main form.
Applications DPR file has code to load Login form first, and when Login form returns successful login, then Main form is created and loaded.
When user logs out via a menu command in Main form, it should close the Main form and load the Login form.
Application exits only when user selects Exit in the Main form (or when user Cancels out of the Login form).
Using code in the application's DPR file, is it possible to code this?
Here is the code that presently exists:
program H;
uses
Forms,
SysUtils,
Registry,
MidasLib,
Dialogs,
Controls,
uDatamod in 'uDatamod.pas' {datamod: TDataModule} ,
uMain in 'uMain.pas' {fMain} ,
uMtlUpd in 'uMtlUpd.pas' {fMtlUpd} ,
uReportPrv in 'uReportPrv.pas' {fReportPrv} ,
uCamera in 'uCamera.pas' {fCamera} ,
uConfig in 'uConfig.pas' {fConfig} ,
uFuncs in 'uFuncs.pas',
uLogin in 'uLogin.pas' {fLogin} ,
uAdmin in 'uAdmin.pas' {fAdmin};
// MidasLib is required.
{$R *.res}
begin
Application.Initialize;
Application.MainFormOnTaskbar := True;
Application.Title := 'HTech';
if ((ParamCount = 1) and (UpperCase(ParamStr(1)) = '/CONFIG')) or
(getHServerHostName = EmptyStr) then
begin
Application.CreateForm(TfConfig, fConfig);
Application.Run;
end
else
begin
if not testHServerConnection then
begin
ShowMessage('Error: Could not connect to HServer');
Exit;
end;
Application.CreateForm(Tdatamod, Datamod);
while not TerminateApplicationFlag do
begin
fLogin := TfLogin.Create(Application);
try
if fLogin.ShowModal = mrOk then
begin
LoggedInEmployeeID := fLogin.FEmployeeID;
LoggedInEmployeeNm := fLogin.edtFirstName.Text + ' ' +
fLogin.edtLastName.Text;
AdminLogin := fLogin.FAdminUser;
FinanceLogin := fLogin.FFinanceUser;
end
else
begin
FreeAndNil(fLogin);
FreeAndNil(Datamod);
Exit;
end;
finally
// FreeAndNil(fLogin);
end;
if AdminLogin then
Application.CreateForm(TfAdmin, fAdmin)
else
begin
FreeAndNil(fLogin);
if not Assigned(fMain) then
Application.CreateForm(TfMain, fMain);
fMain.FHServerHost := getHServerHostName;
end;
Application.Run;
end;
end;
end.
The problem with the above code is that after one iteration (after user performs Logout in Main form), the application exits (control is returned to the operating system) because " fLogin.ShowModal " exits without showing the Login form.
Here is the code from the Main form:
Procedure LogoutProcedure;
begin
TerminateApplicationFlag := False;
Close;
end;
Procedure ExitProcedure;
begin
TerminateApplicationFlag := True;
Close;
end;
I'm stuck with this and would appreciate any advice or corrections in getting it to work.
Thank you in advance.
Regards,
Steve Faleiro

Maybe this very simple solution is sufficient:
The project file:
program Project1;
uses
Forms,
FMain in 'FMain.pas' {MainForm},
FLogin in 'FLogin.pas' {LoginForm};
{$R *.res}
var
MainForm: TMainForm;
begin
Application.Initialize;
Application.CreateForm(TMainForm, MainForm);
Login;
Application.Run;
end.
The main form:
unit FMain;
interface
uses
Classes, Controls, Forms, StdCtrls, FLogin;
type
TMainForm = class(TForm)
LogoutButton: TButton;
procedure LogoutButtonClick(Sender: TObject);
end;
implementation
{$R *.dfm}
procedure TMainForm.LogoutButtonClick(Sender: TObject);
begin
Login;
end;
end.
And the login form:
unit FLogin;
interface
uses
Classes, Controls, Forms, StdCtrls;
type
TLoginForm = class(TForm)
LoginButton: TButton;
CancelButton: TButton;
procedure FormCreate(Sender: TObject);
end;
procedure Login;
implementation
{$R *.dfm}
procedure Login;
begin
with TLoginForm.Create(nil) do
try
Application.MainForm.Hide;
if ShowModal = mrOK then
Application.MainForm.Show
else
Application.Terminate;
finally
Free;
end;
end;
procedure TLoginForm.FormCreate(Sender: TObject);
begin
LoginButton.ModalResult := mrOK;
CancelButton.ModalResult := mrCancel;
end;
end.
Now, this answer works here, quite well with Delphi 7, but I suspect problems with more recent versions were Application.MainFormOnTaskbar and Application.ShowMainForm are True by default. When so, try to set them to False.

Related

Inno Setup: Access to custom control from OnClick event of another control

I have next code for Inno Setup:
procedure CheckBoxClick(Sender: TObject);
begin
{ How to make BrowseButton visible from here? }
end;
procedure CreateTheWizardPage;
var
Page: TWizardPage;
BrowseButton, FormButton: TNewButton;
CheckBox: TNewCheckBox;
Memo: TNewMemo;
begin
Page := PageFromID(wpReady);
BrowseButton := TNewButton.Create(Page);
CheckBox := TNewCheckBox.Create(Page);
CheckBox.OnClick := #CheckBoxClick;
end;
I'm wondering how can I access custom controllers on the wizard page from handler procedure for one of them?
You have to make the BrowseButton variable global and define it before the event handler:
var
BrowseButton: TButton;
procedure CheckBoxClick(Sender: TObject);
begin
{ Now you can use the BrowseButton here }
end;
procedure CreateTheWizardPage;
var
Page: TWizardPage;
FormButton: TNewButton;
CheckBox: TNewCheckBox;
Memo: TNewMemo;
begin
Page := PageFromID(wpReady);
BrowseButton := TNewButton.Create(Page);
CheckBox := TNewCheckBox.Create(Page);
CheckBox.OnClick := #CheckBoxClick;
end;
Related question: Reading values from custom Inno Setup wizard pages without using global variables

delphi Activex and parented forms error

i try to fix up my activex project and i had errors , i have 2 forms in my activex project first form hold tmemo and button to call second form as parented form every thing works fine till now but i cannot set any record from second form to first form control always get access violation so i decided to show result before set tmemo.text control in the first form and actually result is showing but but cannot be set into the first form here is my project code
unit main1;
{$WARN SYMBOL_PLATFORM OFF}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ActiveX, AxCtrls, embed_TLB, StdVcl, Vcl.StdCtrls;
type
Tform1 = class(TForm, Iform1)
Button1: TButton;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
protected
{ Protected declarations }
public
{ Public declarations }
procedure showEmo(L,T:Integer);
end;
var
Form1 : Tform1;
implementation
uses ComObj, ComServ, main2;
{$R *.DFM}
{ Tform1 }
procedure Tform1.Button1Click(Sender: TObject);
var
Rect: TRect;
begin
GetWindowRect(Self.button1.Handle, Rect);
showEmo(Rect.Left + 70,(Rect.Top - 290));
end;
procedure Tform1.FormCreate(Sender: TObject);
begin
Form2 := TForm2.Createparented(0);
end;
procedure TForm1.showEmo(L,T:Integer);
var
Rect: TRect;
begin
try
GetWindowRect(button1.Handle, Rect);
begin
Form2.FormStyle := fsStayOnTop;
end;
Form2.Left := L;//Rect.Left;
Form2.top := T;//Rect.Top - emo.Height;
finally
Form2.Visible := not (Form2.visible);
end;
end;
initialization
TActiveFormFactory.Create(
ComServer,
TActiveFormControl,
Tform1,
Class_form1,
0,
'',
OLEMISC_SIMPLEFRAME or OLEMISC_ACTSLIKELABEL,
tmApartment);
end.
Form 2
unit main2;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.OleCtrls, SHDocVw_EWB, EwbCore,
EmbeddedWB, MSHTML_EWB, Vcl.StdCtrls;
type
TForm2 = class(TForm)
ewbpage: TEmbeddedWB;
load: TMemo;
procedure FormCreate(Sender: TObject);
procedure ewbpageBeforeNavigate2(ASender: TObject; const pDisp: IDispatch;
var URL, Flags, TargetFrameName, PostData, Headers: OleVariant;
var Cancel: WordBool);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form2: TForm2;
implementation
uses main1;
{$R *.dfm}
procedure TForm2.ewbpageBeforeNavigate2(ASender: TObject; const pDisp: IDispatch;
var URL, Flags, TargetFrameName, PostData, Headers: OleVariant;
var Cancel: WordBool);
var
MousePos: TPoint;
HtmlElement: IHTMLElement;
iHTMLDoc: IHtmlDocument2;
begin
if Pos('#sm',URL)>0 then
begin
if Supports(ewbpage.Document, IHtmlDocument2, iHTMLDoc) then
begin
if GetCursorPos(MousePos) then
begin
MousePos := ewbpage.ScreenToClient(MousePos);
HtmlElement := iHTMLDoc.ElementFromPoint(MousePos.X, MousePos.Y);
if Assigned(HtmlElement) then
showmessage(HtmlElement.getAttribute('id', 0));
form1.Memo1.Text := HtmlElement.getAttribute('id', 0);
Cancel := True;
Self.Close;
end;
end;
end;
end;
procedure TForm2.FormCreate(Sender: TObject);
begin
ewbpage.LoadFromStrings(load.Lines);
end;
end.
and the question is why i get this error
Access violation at address 07C734FC in module 'EMBEDA~1.OCX'. Read of
address 000003B4.
at this line
form1.Memo1.Text := HtmlElement.getAttribute('id', 0);
why i cannot set result from second form to first form ? what i did wrong here is the full project for better understand
http://www.mediafire.com/download/zn7hzoxze2390a3/embeddedactivex.zip
You will see this issue once you start to format your code properly
procedure TForm2.ewbpageBeforeNavigate2(ASender: TObject; const pDisp: IDispatch;
var URL, Flags, TargetFrameName, PostData, Headers: OleVariant;
var Cancel: WordBool);
var
MousePos: TPoint;
HtmlElement: IHTMLElement;
iHTMLDoc: IHtmlDocument2;
begin
if Pos('#sm',URL)>0 then
begin
if Supports(ewbpage.Document, IHtmlDocument2, iHTMLDoc) then
begin
if GetCursorPos(MousePos) then
begin
MousePos := ewbpage.ScreenToClient(MousePos);
HtmlElement := iHTMLDoc.ElementFromPoint(MousePos.X, MousePos.Y);
// if we have a valid HtmlElement ...
if Assigned(HtmlElement)
then // show a message
showmessage(HtmlElement.getAttribute('id', 0));
// now we do not care about if HtmlElement is valid or not
form1.Memo1.Text := HtmlElement.getAttribute('id', 0);
Cancel := True;
Self.Close;
end;
end;
end;
end;
To only solve your current access violation you simply put a begin end block around all the lines that will use HtmlElement.
HtmlElement := iHTMLDoc.ElementFromPoint( MousePos.X, MousePos.Y );
if Assigned( HtmlElement )
then
begin
showmessage( HtmlElement.getAttribute( 'id', 0 ) );
form1.Memo1.Text := HtmlElement.getAttribute( 'id', 0 );
end;
But there are some more issues in your code. You should not use the global variables form1 and form2. Instead pass the form instance to the created TForm2 instance or even better a callback method.

Event when all mdi forms are closed

Guys, I'd like if anyone knows any event or method that I can intercept when all MDI forms were closed.
Example:
I want to implement an event in my main form where when I close all MDI forms, such an event was triggered.
Grateful if anyone can help.
MDI child forms (in fact any form), while being destroyed, will notify the main form. You can use this notification mechanism. Example:
type
TForm1 = class(TForm)
..
protected
procedure Notification(AComponent: TComponent; Operation: TOperation);
override;
..
procedure TForm1.Notification(AComponent: TComponent; Operation: TOperation);
begin
inherited;
if (Operation = opRemove) and (AComponent is TForm) and
(TForm(AComponent).FormStyle = fsMDIChild) and
(MDIChildCount = 0) then begin
// do work
end;
end;
Catch the WM_MDIDESTROY message send to the MDI client window:
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
FOldClientWndProc: TFarProc;
procedure NewClientWndProc(var Message: TMessage);
end;
...
procedure TForm1.FormCreate(Sender: TObject);
begin
if FormStyle = fsMDIForm then
begin
HandleNeeded;
FOldClientWndProc := Pointer(GetWindowLong(ClientHandle, GWL_WNDPROC));
SetWindowLong(ClientHandle, GWL_WNDPROC,
Integer(MakeObjectInstance(NewClientWndProc)));
end;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
SetWindowLong(ClientHandle, GWL_WNDPROC, Integer(FOldClientWndProc));
end;
procedure TForm1.NewClientWndProc(var Message: TMessage);
begin
if Message.Msg = WM_MDIDESTROY then
if MDIChildCount = 1 then
// do work
with Message do
Result := CallWindowProc(FOldClientWndProc, ClientHandle, Msg, WParam,
LParam);
end;
You can have the MainForm assign an OnClose or OnDestroy event handler to each MDI child it creates. Each time an MDI client is closed/destroyed, the handler can check if any more MDI child forms are still open, and if not then do whatever it needs to do.
procedure TMainForm.ChildClosed(Sender: TObject; var Action: TCloseAction);
begin
Action := caFree;
// the child being closed is still in the MDIChild list as it has not been freed yet...
if MDIChildCount = 1 then
begin
// do work
end;
end;
Or:
const
APPWM_CHECK_MDI_CHILDREN = WM_APP + 1;
procedure TMainForm.ChildDestroyed(Sender: TObject);
begin
PostMessage(Handle, APPWM_CHECK_MDI_CHILDREN, 0, 0);
end;
procedure TMainForm.WndProc(var Message: TMessage);
begin
if Message.Msg = APPWM_CHECK_MDI_CHILDREN then
begin
if MDIChildCount = 0 then
begin
// do work
end;
Exit;
end;
inherited;
end;

Delphi application form shows instead of hiding at startup

I have a program where it will not start minimized and shows a very small window on the dekstop.
Image: http://i.imgur.com/j8xus.jpg
Code:
program:
program Project4;
uses
Forms,
Unit4 in 'Unit4.pas' {Form4};
{$R *.res}
begin
Application.Initialize;
Application.MainFormOnTaskbar := false;
Application.ShowMainForm:=false;
Application.CreateForm(TForm4, Form4);
Application.Run;
end.
unit:
unit Unit4;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, AppEvnts, ExtCtrls, Menus;
type
TForm4 = class(TForm)
TrayIcon1: TTrayIcon;
ApplicationEvents1: TApplicationEvents;
PopupMenu1: TPopupMenu;
Exit1: TMenuItem;
procedure TrayIcon1DblClick(Sender: TObject);
procedure ApplicationEvents1Minimize(Sender: TObject);
procedure ApplicationEvents1Restore(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure FormCreate(Sender: TObject);
procedure Exit1Click(Sender: TObject);
private
{ Private declarations }
fCanClose: Boolean;
public
{ Public declarations }
end;
var
Form4: TForm4;
implementation
{$R *.dfm}
procedure TForm4.ApplicationEvents1Minimize(Sender: TObject);
begin
Hide();
WindowState := wsMinimized;
end;
procedure TForm4.ApplicationEvents1Restore(Sender: TObject);
begin
Show();
WindowState := wsNormal;
application.Bringtofront;
end;
procedure TForm4.Exit1Click(Sender: TObject);
begin
fcanclose:=true;
close;
end;
procedure TForm4.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
if not fCanClose then
begin
hide;
windowstate:=wsminimized;
CanClose:=false;
end
else
CanCLose:=True;
end;
procedure TForm4.FormCreate(Sender: TObject);
begin
fCanClose:=FALSE;
end;
procedure TForm4.TrayIcon1DblClick(Sender: TObject);
begin
if (windowstate = wsminimized) then
begin
Show;
windowstate := wsnormal;
application.BringToFront;
end
else
begin
hide;
windowstate:=wsminimized;
end;
end;
end.
I created your project and had the same problems until I changed the following line of code to True:
Application.MainFormOnTaskbar := True;
Now the app seems to work just fine without an minimizing to the bottom left corner of the desktop before it is hidden.

How do I save the contents of TWebBrowser, including user-entered form values?

is it possible to save entire document loaded in Webbrowser (in Delphi) as a ordinary HTML file with new values (I mean values entered by user in html's forms this document)?
I need this for reading this HTML document with all values next time when application will be used.
Sure this is possible!
Small demo App, make a new vcl forms application, drop a TWebBrowser, a TButton and a TMemo on your form and use this code (don't forget to bind OnCreate for the Form and OnClick for the Button)
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, OleCtrls, SHDocVw, StdCtrls,mshtml, ActiveX;
type
TForm1 = class(TForm)
WebBrowser1: TWebBrowser;
Button1: TButton;
Memo1: TMemo;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
//code snagged from about.com
procedure WBLoadHTML(WebBrowser: TWebBrowser; HTMLCode: string) ;
var
sl: TStringList;
ms: TMemoryStream;
begin
WebBrowser.Navigate('about:blank') ;
while WebBrowser.ReadyState < READYSTATE_INTERACTIVE do
Application.ProcessMessages;
if Assigned(WebBrowser.Document) then
begin
sl := TStringList.Create;
try
ms := TMemoryStream.Create;
try
sl.Text := HTMLCode;
sl.SaveToStream(ms) ;
ms.Seek(0, 0) ;
(WebBrowser.Document as IPersistStreamInit).Load(TStreamAdapter.Create(ms)) ;
finally
ms.Free;
end;
finally
sl.Free;
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
Doc : IHtmlDocument2;
begin
Doc := WebBrowser1.Document as IHtmlDocument2;
Memo1.Lines.Text := Doc.body.innerHTML;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
Html : String;
begin
Html := 'change value of input and press Button1 to changed DOM<br/><input id="myinput" type="text" value="orgval"></input>';
WBLoadHTML(WebBrowser1, Html);
end;
end.
Output:
EDIT
As mjn pointed out, the values of password type inputs will not be shown.
You can still can get their value though:
add these 2 lines to Button1.Click and change html
OnCreate:
Html := 'change value of input and press Button1 to changed DOM<br/><input id="myinput" type="password" value="orgval"></input>';
OnClick:
El := (Doc as IHtmlDocument3).getElementById('myinput') as IHtmlInputElement;
Memo1.Lines.Add(Format('value of password field = %s', [El.value]))