I have a TWebBrowser object which is created in runtime and used in background, that is, not visible. The problem is that events like OnDocumentComplete dont work or are not triggered in Delphi2009. Any advice?
procedure TfrmMain.FormCreate(Sender: TObject);
begin
FWebBrowser:= TWebBrowser.Create(Self);
FWebBrowser.RegisterAsBrowser:= True;
FWebBrowser.OnDocumentComplete:= WhenDocIsCompleted;
end;
procedure TfrmMain.WhenDocIsCompleted(ASender: TObject; const pDisp: IDispatch;
var URL: OleVariant);
begin
ShowMessage('Doc is completed!');
end;
There is any difference important between Navigate and Navigate2? How can I enable cookies here?
Thanks in advance.
TWinControl(FWebBrowser).Parent := Form1; // Parent property is read-only unless cast
You may have this issue because the TWebBrowser internally works closely together with the handle of the parent form to get messages posted from windows. Try using a hidden form with the TWebBrowser on (optionally run-time created as well), and/or investigate if the HandleAllocated and HandleNeeded methods could help you.
Call for the OnDocumentComplete Problem:
WebBrowser1.HandleNeeded;
or in your case:
FWebBrowser.HandleNeeded;
before webBrowser.Navigate
A component working perfectly with web-pages cookies is TEmbeddedWB from EmbeddedWB and is free.
procedure TForm1.ReCreateBrowser();
begin
if(WebBrowser <> NIL) then
begin
WebBrowser.Stop;
WebBrowser.Destroy;
end;
WebBrowser := TWebBrowser.Create(Form1);
TWinControl(WebBrowser).Name := 'WebBrowser';
TWinControl(WebBrowser).Parent := Form1; //set parent...can be panel, tabs etc
WebBrowser.Silent := true; //don't show JS errors
WebBrowser.Visible:= true; //visible...by default true
//don't set width/heigh/top/left before TWinControl(WebBrowser).Parent := Form1;
WebBrowser.Top := 10;
WebBrowser.Left := 10;
WebBrowser.Height := 600;
WebBrowser.Width := 800;
WebBrowser.OnDocumentComplete := WebBrowserDocumentComplete;
//WebBrowser.OnNavigateComplete2 := WebBrowserNavigateComplete2;
end;
Related
I would like to create a non visual component (like TTimer for example) that I can drop on the form and that I can set up directly from the Object Inspector, but I don't want to see its icon on the form (it'd just obstruct anything). For example TFloatAnimation works like this but I don't understand how.
The GExperts library (http://www.gexperts.org/) has a plug-in which can toggle the visibility
of non-visual components on a form, and it is apparently not Delphi-version-specific but it is
not exactly trivial.
The method which does this is
procedure THideNonVisualCompsExpert.ToggleNonVisualVisible(Form: TCustomForm);
const
NonVisualClassName = 'TContainer';
var
VisibleState: Boolean;
FormHandle: THandle;
CompHandle: THandle;
WindowClass: string;
FirstCompFound: Boolean;
WinControl: TWinControl;
ChildControl: TWinControl;
i: Integer;
begin
Assert(Assigned(Form));
Assert(Form.Handle > 0);
FirstCompFound := False;
WinControl := Form;
if InheritsFromClass(WinControl.ClassType, 'TWinControlForm') then
begin
for i := WinControl.ComponentCount - 1 downto 0 do
begin
if WinControl.Controls[i] is TWinControl then
begin
ChildControl := WinControl.Controls[i] as TWinControl;
if InheritsFromClass(ChildControl.ClassType, 'TCustomFrame') then
begin
WinControl := ChildControl;
Break;
end;
end;
end;
end;
FormHandle := GetWindow(WinControl.Handle, GW_CHILD);
CompHandle := GetWindow(FormHandle, GW_HWNDLAST);
VisibleState := False;
GxOtaClearSelectionOnCurrentForm;
while (CompHandle <> 0) do
begin
WindowClass := GetWindowClassName(CompHandle);
if AnsiSameText(WindowClass, NonVisualClassName) then
begin
if not FirstCompFound then
begin
VisibleState := not IsWindowVisible(CompHandle);
FirstCompFound := True;
end;
if VisibleState then
ShowWindow(CompHandle, SW_SHOW)
else
ShowWindow(CompHandle, SW_HIDE);
end;
CompHandle := GetWindow(CompHandle, GW_HWNDPREV);
end;
end;
in the unit GX_HideNonVisualComps.Pas.
As written, it toggles the visibility of all the non-visual components on the
target form, but looking at the code of the ToggleNonVisualVisible method it looks like it
ought to be possible (but I have not tried) to adapt it to operate on a selected component class and
force instances of the class to a non-visible state. Once you have done that, you would probably
need to experiment with how and when to invoke the method at design-time; if I was doing it, I would probably start
with somewhere like the target component's Loaded method.
(I would feel more comfortable posting this "answer" as a comment but obviously it would be too long)
I have thought about this. A Non Visual Component does not do any painting, in a Windows environment (like the IDE) it has no Window, and therefore cannot influence how the IDE chooses to render it.
One approach would be to derive from TWinControl, making your component a Visual Component, and then to ensure that it is not drawn. Try setting the positioning properties to be non-published, and when you are parented, always set your position outside the parent window. This means that your control is always clipped and never painted.
I haven't tried this, but I can see no reason why it wouldn't work.
You can also use this approach to have an apparently non visual component that renders information in the IDE at designtime, but not at runtime.
Delphi v7
Let me preface my remedial question by saying that I am not a real programer. I am a Deputy Sheriff and I write an occasional project to help us do what we do.
My current project contains several TDBRichEdit controls. I have assigned various formatting processes to toolbar buttons. I would like to be able to change the RichEdit font using a ComboBox. The combobox is populated with the font list, but it does not affect the font of the TDBRichEdit control. I have been trying to figure this out for over a week and I cannot see the problem.
This is what I have done:
Form OnCreate procedure
procedure TForm1.FormCreate(Sender: TObject);
begin
PageControl1.ActivePage:= TabSheet1;
GetFontNames;
SelectionChange(Self);
CurrText.Name := DefFontData.Name;
CurrText.Size := -MulDiv(DefFontData.Height, 72, Screen.PixelsPerInch);
end;
Form Selection Change
procedure TForm1.SelectionChange(Sender: TObject);
begin
if ActiveControl is TDBRichEdit then
with ActiveControl as
TdbRichEdit do begin
try
Ctrlupdating := True;
Size.Text := IntToStr(SelAttributes.Size);
cmbFont.Text := SelAttributes.Name;
finally
Ctrlupdating := False;
end;
end;
end;
Functions (Except for the "ActiveControl part these are not my functions and I don't have enough knowledge to completely understand them.)
Function TForm1.CurrText: TTextAttributes;
begin
if ActiveControl is TDBRichEdit then
with ActiveControl as
TdbRichEdit do begin
if SelLength > 0 then Result := SelAttributes
else Result := DefAttributes;
end;
end;
function EnumFontsProc(var LogFont: TLogFont; var TextMetric: TTextMetric;
FontType: Integer; Data: Pointer): Integer; stdcall;
begin
TStrings(Data).Add(LogFont.lfFaceName);
Result := 1;
end;
OnDraw event of the combobox
procedure TForm1.cmbFontDrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
begin
with (Control as TComboBox).Canvas do
begin
Font.Name := Screen.Fonts.Strings[Index];
FillRect(Rect) ;
TextOut(Rect.Left, Rect.Top, PChar(Screen.Fonts.Strings[Index]));
end;
end;
OnChange event for the combobox
procedure TForm1.cmbFontChange(Sender: TObject);
begin
if Ctrlupdating then Exit;
CurrText.Name := cmbFont.Items[cmbFont.ItemIndex];
end;
Any Ideas?
In your code you try to modify the text attributes in this code:
procedure TForm1.cmbFontChange(Sender: TObject);
begin
if Ctrlupdating then Exit;
CurrText.Name := cmbFont.Items[cmbFont.ItemIndex];
end;
When this code executes, ActiveControl will be cmbFont. Now look at CurrText.
if ActiveControl is TDBRichEdit then
with ActiveControl as TdbRichEdit do
begin
if SelLength > 0 then
Result := SelAttributes
else
Result := DefAttributes;
end;
So, the first if block will not be entered.
In fact your function appears not to assign anything to Result in this case. You must always assign to Result. The compiler will tell you this when you enable warnings and hints.
Instead of using ActiveControl you should specify the rich edit instance directly. I don't know how your form is arranged, but you'll need to use some other means to work out which rich edit control the change is to be applied to. Perhaps based on the active page of the page control.
I managed to get the combobox working. My code is probably very awkward, but it works. Thank you for your help. I would not have been able to solve this problem without it.
I wrote a separate function for each of the richedit contols. With FormCreate I had to add lines for each of the functions
procedure TForm1.FormCreate(Sender: TObject);
begin
PageControl1.ActivePage:= TabSheet1;
GetFontNames;
SelectionChange(Self);
**CurrText.Name := DefFontData.Name;
CurrText.Size := -MulDiv(DefFontData.Height, 72, Screen.PixelsPerInch);**
end;
In SelectionChange I had to make a call to the PARAGRAPH attributes of the rich edit control. I was not able to do that collectively. I addressed the rich edit control “reProc” only. The others seem to work fine with that one line. I would like to understand that one.
Form Selection Change
procedure TForm1.SelectionChange(Sender: TObject);
begin
if ActiveControl is TDBRichEdit then
with reProc.Paragraph do begin
try do begin
You gave me the idea. I was not able to address all the richedit controls collectively, so I wrote a function for each of the richedit controls separately.
function TForm1.CurrText: TTextAttributes;
begin
if reProc.SelLength > 0 then Result := reProc.SelAttributes
else Result := **reProc.DefAttributes;**
For the OnChange event for the combobox I had to add lines for each of the functions
procedure TForm1.cmbFontChange(Sender: TObject);
begin
if Ctrlupdating then Exit;
**CurrText.Name := cmbFont.Items[cmbFont.ItemIndex];**
end;
Although I realise that in addition to the included Delphi docking demo there are other and better docking libraries available such as the Developer Express Library and the JVCL Docking Library, but for a specific demonstration project I am restricted to use only the Delphi built-in capability (despite some of the noted flaws).
My question relates to adding persistence to the docking state. I see from examining Controls.pas that TDockTree is the default dock manager and it has Stream I/O routines. Digging around on SO and in various forums though I cant see how anyone has called these routines. I've tried loading and saving to a file from the relevant Create and OnDrop events but I'm stabbing in the dark. I am happy saving and restoring form sizes and states but am struggling with the concepts of what I should be saving. Would any kind person give me a starting place?
I'm using Delphi XE3, so all (?) things are possible!
Many thanks.
I'm using Toolbar 2000 from J. Russels. It is providing panels, toolwindow's and toolbar's.
That one provides functions like TBRegSavePositions and TBRegSavePositions to store the user customization into registry.
Loading a "view" get's easily done by on code line:
TBRegLoadPositions(self, HKEY_CURRENT_USER, c_BaseUserRegKey);
in this case self is my form.
You can load and save your docking configuration with the LoadFromStream and SaveToStream methods by storing the data in a string.
Therefore, the following methods are required:
save the current docking configuration to a string
load the current docking configuration from a string
Here is some code to do this:
function GetDockString(const AManager: IDockManager): AnsiString;
var
LStream: TMemoryStream;
begin
LStream := TMemoryStream.Create();
try
AManager.SaveToStream(LStream);
SetLength(Result, 2 * LStream.Size);
BinToHex(LStream.Memory, PAnsiChar(Result), LStream.Size);
finally
FreeAndNil(LStream);
end;
end;
procedure ReadDockString(const ADockString: AnsiString; const AManager: IDockManager);
var
LStream: TMemoryStream;
begin
LStream := TMemoryStream.Create();
try
LStream.Size := Length(ADockString) div 2;
HexToBin(PAnsiChar(ADockString), LStream.Memory, LStream.Size);
LStream.Position := 0;
AManager.LoadFromStream(LStream);
finally
FreeAndNil(LStream);
end;
end;
I've used such methods in an application to create dockable windows, but the vcl provides only a very basic user experience. You can do something about it, but it is hard to test and debug - I already spent too much time to use and override TCustDockDragObject and TCaptionedTabDockTree, so I would recommend using a docking framework.
Here is a minimal example which creates two forms and reads a docking configuration.
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormDblClick(Sender: TObject);
private
FPanel: TPanel;
end;
Implementation:
procedure TForm1.FormCreate(Sender: TObject);
var
LWindow: TForm;
const
LDockExample = '0000080000000000000000000000000000000000000000000000000100000000000000000B0000004368696C6457696E646F77FFFFFFFF';
begin
FPanel := TPanel.Create(Self);
FPanel.Align := alTop;
FPanel.Height := 300;
FPanel.DockSite := true;
FPanel.Parent := Self;
LWindow := TForm.CreateNew(Self);
LWindow.Name := 'ChildWindow';
LWindow.DragKind := dkDock;
LWindow.BoundsRect:=Rect(10, 10, 400, 400);
LWindow.Color := clGreen;
LWindow.Show;
ReadDockString(LDockExample, FPanel.DockManager);
end;
procedure TForm1.FormDblClick(Sender: TObject);
begin
ShowMessage(GetDockString(FPanel.DockManager));
end;
I would like to get text width of a string before an application starts. Everything works fine until Application.MainForm canvas present. The problem is, when I try dynamically create TOrdinarium in the OnCreate event of the app. main form, "Canvas does not allow drawing" error occurs. (Application.MainForm is nil....). I tried several ways to create Canvas dynamically (one of them is written below), but it can not measure text sizes without being attached to parented control.
Is there way how to make it work somehow?
Thanx
I tried this:
TOrdinarium = class (TCustomControl)
private
function GetVirtualWidth:integer;
end;
constructor TOrdinarium.Create(AOwner:TComponent);
begin
inherited;
Width:=GetVirtualWidth;
end;
function TOrdinarium.GetVirtualWidth:integer;
var ACanvas : TControlCanvas;
begin
ACanvas := TControlCanvas.Create;
TControlCanvas(ACanvas).Control := Application.MainForm;
ACanvas.Font.Assign(Font);
result:=ACanvas.TextWidth('0');
ACanvas.Free;
end;
This works:
procedure TForm1.FormCreate(Sender: TObject);
var
c: TBitmap;
begin
c := TBitmap.Create;
try
c.Canvas.Font.Assign(self.Font);
Caption := IntToStr(c.Canvas.TextWidth('My String'));
finally
c.Free;
end;
end;
I'm not sure if this can be done, but if by "before the app starts" you mean "before the main form is displayed", you could always put your canvas-related code in the main form's OnCreate event. You'll have a valid canvas by that point.
I have a form one which I want to show a file open dialog box before the full form opens.
I already found that I can't do UI related stuff in FormShow, but it seems that I can in FormActivate (which I protect from being called a second time...)
However, if the user cancels out of the file open dialog, I want to close the form without proceeding.
But, a form close in the activate event handler generates an error that I can't change the visibility of the form.
So how does one do some UI related operation during form start up and then perhaps abort the form (or am I trying to stuff a function into the form that should be in another form?)
TIA
It would be best (i think) to show the file open dialog BEFORE you create and show the form. If you want to keep all code together you might add a public class procedure OpenForm() or something:
class procedure TForm1.OpenForm( ... );
var
O: TOpenDialog;
F: TForm1;
begin
O := TOpenDialog.Create();
try
// set O properties.
if not O.Execute then Exit
F := TForm1.Create( nil );
try
F.Filename := O.FIlename;
F.ShowModal();
finally
F.Free();
end;
finally
O.Free();
end;
end;
Set a variable as a condition of the opendialog and close the form on the formshow event if the flag is not set correctly.
procedure TForm1.FormCreate(Sender: TObject);
begin
ToClose := not OpenDialog1.Execute;
end;
procedure TForm1.FormShow(Sender: TObject);
begin
if ToClose then Close();
end;
or even more simply
procedure TForm1.FormShow(Sender: TObject);
begin
if not OpenDialog1.Execute then Close();
end;
If you want to keep the logic conditioning the opening self-contained in the Form, you can put a TOpenDialog in your Form and use a code like this in your OnShow event:
procedure TForm2.FormShow(Sender: TObject);
begin
if OpenDialog1.Execute(Handle) then
Color := clBlue
else
PostMessage(Handle, WM_CLOSE, 0, 0); // NB: to avoid any visual glitch use AlpaBlend
end;
If you don't need this encapsulation, a better alternative can be to check the condition before trying to show the form, for instance by embedding the Form2.Show call in a function that tests all the required conditions first.
Two Ways....
1. using oncreate and onactivate
create a global flag or even 2
var
aInitialized:boolean;
Set the flag to false in the oncreate handler.
aInitialized := false; //we have not performed our special code yet.
Inside onActivate have something like this
if not aInitialized then
begin
//our one time init code. special stuff or whatever
If successful
then set aInitialized := true
else aInitialized := false
end;
And how to close it without showing anything just add your terminate to the formshow. of course you need to test for some reason to close.. :)
Procedure Tmaindlg.FormShow(Sender: TObject);
Begin
If (shareware1.Sharestatus = ssExpired) or (shareware1.Sharestatus = ssTampered) Then
application.Terminate;
End;
In your DPR you will need to add a splash screen type effect. In my case I am showing progress as the application starts. You could also just show the form and get some data.
Code from the splash.pas
Procedure tsplashform.bumpit(str: string);
Begin
label2.Caption := str;
gauge1.progress := gauge1.progress + trunc(100 / items);
update;
If gauge1.progress >= items * (trunc(100 / items)) Then Close;
End;
Program Billing;
uses
Forms,
main in 'main.pas' {maindlg},
Splash in 'splash.pas' {splashform};
{$R *.RES}
Begin
Application.Initialize;
Application.Title := 'Billing Manager';
SplashForm := TSplashForm.Create(Application);
SplashForm.Show;
SplashForm.Update;
splash.items := 5;
SplashForm.bumpit('Loading Main...');
Application.CreateForm(Tmaindlg, maindlg);
SplashForm.bumpit('Loading Datamodule...');
Application.CreateForm(TfrmSingleWorkorder, frmSingleWorkorder);
SplashForm.bumpit('Loading SQL Builder...');
Application.CreateForm(TDm, Dm);
SplashForm.bumpit('Loading Security...');
Application.CreateForm(TSQLForm, SQLForm);
SplashForm.bumpit('Loading Reports...');
Application.CreateForm(Tpickrptdlg, pickrptdlg);
Application.Run;
End.