i have create mainform (auto create form) and Form1 (available form).
the method that i use to call form1 is like this
procedure Tmainform.Button2Click(Sender: TObject);
var
f : Tform1;
begin
f:=Tform1.create(self);
f.parent:=Tabsheet1;
f.visible:=true;
f.align:=alClient;
end;
the question is why KeyPreview in Form1 does not work, even though I have activated his KeyPreview be true?
in function TWinControl.DoKeyDown(var Message: TWMKey): Boolean; the call is delegated to the parent if existing.
The Procedure
procedure TWinControl.KeyDown(var Key: Word; Shift: TShiftState);
begin
if Assigned(FOnKeyDown) then FOnKeyDown(Self, Key, Shift);
end;
will not be called if Form is parented
function TWinControl.DoKeyDown(var Message: TWMKey): Boolean;
var
ShiftState: TShiftState;
Form, FormParent: TCustomForm;
LCharCode: Word;
begin
Result := True;
{ First give the immediate parent form a try at the Message }
Form := GetParentForm(Self, False);
if (Form <> nil) and (Form <> Self) then
begin
// >> -- the DoKeyDown of the parent (not of your form) will be called
if Form.KeyPreview and TWinControl(Form).DoKeyDown(Message) then
Exit;
{ If that didn't work, see if that Form has a parent (ie: it is docked) }
if Form.Parent <> nil then
begin
FormParent := GetParentForm(Form);
if (FormParent <> nil) and (FormParent <> Form) and FormParent.KeyPreview and
TWinControl(FormParent).DoKeyDown(Message) then
Exit;
end;
end;
......
Related
I have an event procedure that checks the OnKeyUp key press for two objects/controls (TNewEdit and TNewComboBox). Both objects need to be completed before a TNewButton gets enabled.
However, I cannot find a way to know how to get the type of the Sender: TObject, if that is TNewEdit or TNewComboBox.
Anyone can help?
You should not need to know the type/class for anything.
Such a need is a sign of a bad design.
If the handling of the event is different for each type/class, create a separate handler for each.
If part of the handling is common, call the common handler from the specific handlers.
var
Edit: TNewEdit;
ComboBox: TNewComboBox;
procedure CommonKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
Log('Common handling');
end;
procedure EditKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
Log('Edit key up');
CommonKeyUp(Sender, Key, Shift);
end;
procedure ComboBoxKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
Log('Combo box key up');
CommonKeyUp(Sender, Key, Shift);
end;
procedure InitializeWizard();
begin
{ ... }
Edit.OnKeyUp := #EditKeyUp;
Combobox.OnKeyUp := #ComboBoxKeyUp;
end;
Though as you actually have two controls, you probably want to distinguish, what control raised the event.
That's, what the Sender argument is for. The following code shows how to use it. But again, in general, this is not the right way to go.
var
Edit: TNewEdit;
ComboBox: TNewComboBox;
procedure ControlKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
if Sender = Edit then
begin
Log('Edit key up');
end
else
if Sender = ComboBox then
begin
Log('Combo box key up');
end
else
begin
Log('Other key up');
end;
end;
procedure InitializeWizard();
begin
{ ... }
Edit.OnKeyUp := #ControlKeyUp;
Combobox.OnKeyUp := #ControlKeyUp;
end;
Though still I do not understand, what you need this for.
You have to check both controls every time, so why do you need to know, what control, was the one that changed?
Also, to detect a change, do not use OnKeyUp, use OnChange. That way you capture all changes (key press, drag&drop, copy&paste, anything).
var
Edit: TNewEdit;
ComboBox: TNewComboBox;
Button: TNewButton;
procedure ControlChange(Sender: TObject);
begin
Button.Enabled := (Edit.Text <> '') and (ComboBox.Text <> '');
end;
procedure InitializeWizard();
begin
{ ... }
Edit.OnChange := #ControlChange;
Combobox.OnChange := #ControlChange;
end;
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.
I have a TObjectList, which I am trying to write to disk. Although I end up with a file (54 bytes), when I change the FNAME property value to something really long, the size of the file never changes, and I get nil when I try to read it. I am at a loss as to what is wrong. Sorry for the long code snippet. it is easy to understand what is going on, just I can't figure out why it's not doing what I want.
type
{ Declare a new object type. }
TNewObject = class(TComponent)
private
FName: String;
public
property BizName: String read FName write FName;
constructor Create(const AName: String);
destructor Destroy(); override;
end;
Declare a Global var for my TObjectList
var
Form1: TForm1;
List: TObjectList<TNewObject>;
Declare my constructors and destructors..
constructor TNewObject.Create(const AName: String);
begin
FName := AName;
end;
destructor TNewObject.Destroy;
begin
inherited;
end;
Now add a button to create my objects...
procedure TForm1.CreateButtonClick(Sender: TObject);
var
Obj: TNewObject;
begin
{ Create a new List. }
{ The OwnsObjects property is set by default to true -- the list will free the owned objects automatically. }
List := TObjectList<TNewObject>.Create();
{ Add some items to the List. }
List.Add(TNewObject.Create('One'));
List.Add(TNewObject.Create('Two'));
{ Add a new item, but keep the reference. }
Obj := TNewObject.Create('Three');
List.Add(Obj);
end;
Now add a SAVE Button
procedure TForm1.SaveButtonClick(Sender: TObject);
var
i: Integer;
fs: TfileStream;
begin
if SaveDialog1.Execute then
begin
fs := TfileStream.Create(SaveDialog1.FileName, fmCreate);
try
for i := 0 to List.Count - 1 do
begin
ShowMessage(List[i].BizName);
fs.WriteComponent(TNewObject(List[i]));
end;
finally
fs.Free;
end;
end;
end;
CAVEATS: I know that only PUBLIC properties will be saved... which should be BIZNAME. The 3 entries do show up in the SHOWMESSAGE when it is being saved....
I did remember my Class Registration.
Initialization
RegisterClass(TNewObject);
For completeness sake, here is my Load Routine as well...
procedure TForm1.LoadButtonClick(Sender: TObject);
var
i: Integer;
fs: TfileStream;
vRecord: TNewObject;
begin
if OpenDialog1.Execute then
begin
List.Clear; // clear list
fs := TfileStream.Create(OpenDialog1.FileName, fmopenRead);
try
while fs.Position < fs.size do
begin
vRecord := TNewObject(fs.ReadComponent(nil));
ShowMessage(vRecord.FName);
List.Add(vRecord);
end;
finally
fs.Free;
end;
ShowMessage(IntToStr(List.Count));
end;
end;
Thank you for your help.
Component streaming system only streams published properties, you need to publish 'BizName'.
Alternatively you can override DefineProperties to decide what else to stream.
type
TNewObject = class(TComponent)
private
FName: String;
procedure ReadName(Reader: TReader);
procedure WriteName(Writer: TWriter);
protected
procedure DefineProperties(Filer: TFiler); override;
public
property BizName: String read FName write FName;
...
procedure TNewObject.ReadName(Reader: TReader);
begin
FName := Reader.ReadString;
end;
procedure TNewObject.WriteName(Writer: TWriter);
begin
Writer.WriteString(FName);
end;
procedure TNewObject.DefineProperties(Filer: TFiler);
begin
inherited;
Filer.DefineProperty('bizname', ReadName, WriteName, FName <> '');
end;
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;
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]))