How do I enable ribbon buttons which are disabled after clicking the more commands button in a quickaccessbar using Delphi?
This is a known bug
Quality Central report 70342:
When using Ribbon Controls, if one
adds a quick access toolbar, and then
at runtime chooses "More Commands" to
customize the quick access toolbar,
many (although not always all) of the
action components in various ribbon
groups will become permanently
disabled.
Please see the report itself for more information:
http://qc.embarcadero.com/wc/qcmain.aspx?d=70342
The report is still open, so I it may not have been solved in D2011 either, but Quality Central could be lagging behind a bit.
Update
The report states there is no work around, but Jack Sudarev posted one in the comments:
procedure TForm6.ActionManager1StateChange(Sender: TObject);
begin
UpdateActions(ActionManager1);
end;
procedure TForm6.UpdateActions(ActionManager: TActionManager);
var
i: Integer;
begin
if not Assigned(ActionManager) then
Exit;
for i := 0 to ActionManager.ActionCount - 1 do
begin
(ActionManager.Actions[i] as TAction).Enabled := False;
(ActionManager.Actions[i] as TAction).Enabled := True;
end;
end;
This is what i did:
procedure TmainTranslatform.MyUpdateActions(ActionManager: TActionManager);
var
i: Integer;
begin
if not Assigned(ActionManager) then
Exit;
for i := 0 to ActionManager.ActionCount - 1 do
begin
if (ActionManager.Actions[i] is TFileOpen) then
begin
(ActionManager.Actions[i] as TFileOpen).Enabled := False;
(ActionManager.Actions[i] as TFileOpen).Enabled := True;
end;
if (ActionManager.Actions[i] is TAction) then
begin
(ActionManager.Actions[i] as TAction).Enabled := False;
(ActionManager.Actions[i] as TAction).Enabled := True;
end;
end;
end;
Related
We have a Indy (version 10.6.1.5235) TIdHttpServer "service" that has worked well for years with Delphi 2007. After the most recent Windows Update (KB4338815 and KB4338830) we noticed the service freezes when TIdHttpServer is set to false.
I have included source code where TIdHttpServer is created. In our service "Stop" handler we set IdHttpServer1.Active to False and this is where it freezes. It seems Indy hangs when it is trying to close the http connections. Is there a work around?
Update One Per Remy Lebeau, I have created a Minimal, Complete, and Verifiable example. Here it is:
procedure TMainForm.Button1Click(Sender: TObject);
begin
memo1.clear;
iCall := 0;
IdHTTPServer1 := TIdHTTPServer.Create;
IdHTTPServer1.MaxConnections := 10;
IdHTTPServer1.AutoStartSession := True;
IdHTTPServer1.SessionState := True;
IdHTTPServer1.OnCommandGet := IdHTTPServer1CommandGet;
IdHTTPServer1.KeepAlive := False;
idHttpServer1.DefaultPort := 80;
if ReuseSocket.checked then
IDHTTPSERVER1.ReuseSocket := rsTrue;
IdHTTPServer1.Active := True;
end;
procedure TMainForm.IdHTTPServer1CommandGet(AContext: TIdContext;
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
begin
iCall := iCall + 1;
if iCall mod 100 = 0 then
memo1.lines.add(inttostr(iCall)+ ' calls made');
AResponseInfo.ContentText := '<html><body>Hello There</body></html';
end;
procedure TMainForm.StopClick(Sender: TObject);
begin
try
IdHTTPServer1.Active := False;
memo1.lines.add('IdHTTPServer1.Active := False;');
except
on e: exception do
memo1.lines.add('Exception on IdHTTPServer1.Active := False; Message:'+e.message);
end;
end;
Application will run fine but once you click the "Stop" button which sets the IdHttpServer Active property to False it hangs.
You might have encountered this similar issue:
Windows 2012 R2 closesocket() hangs on listening socket
The issue was brought by patch from Microsoft KB4338815, which caused closesocket tо hang forever on Intel Xeon processors
That issue was fixed by uninstalling KB4338815, which you do have installed. So try uninstalling that KB on your system and see if it solves your issue.
I am looking to find out which services/interface I need to use to add an item to the right-click menu of a source file in the Delphi IDE.
For example, if I right-click on a unit's tab, it has items to "Close page", "Close all other pages", "Properties", etc. I want to add custom items to that menu, if possible.
I looked over the ToolsAPI unit but I have no clue where to begin. I assume there's an interface I can use to enumerate items and add items, but I dont know where to start looking.
If that's not possible, I'd settle for the code editor's context menu.
Maybe there's some samples online for this, but I'm still looking and have found none.
Any help appreciated.
Remy Lebeau has pointed you in exactly the right directions with his link to
the GExperts guide.
If you've not done this sort of stuff before, it can still
be a bit of a performance to get started on writing your own IDE add-in, so
I've set out below a minimal example of how to add an item to the code editor's
pop-up menu.
What you do, obviously, is to create a new package, add the unit below to it,
and then install the package in the IDE. The call to Register in the unit
does what's necessary to install the new item in the editor pop-up menu.
Make sure that the code editor is open at the time you install the package. The
reason is that, as you'll see, the code checks whether there is an active editor
at the time. I've left how to ensure that the pop-up item gets added even if there
is no code editor active at the time. Hint: if you look at the ToolsAPI.Pas unit for whichever
version of Delphi you're using, you'll find that it includes various kinds of notifier,
and you can use a notification from at least one of them to defer checking if there
is an editor active until one is likely to be.
Btw, the code adds the menu item to the context menu which pops up over the editor window itself rather than the active tab. Part of the fun with IDE add-ins is the fun of experimenting to see if you can get exactly what you want. I haven't tried it myself, but I doubt that adding the menu item to the context menu of one of the editor tabs would be that difficult - seeing as the Delphi IDE is a Delphi app, as you can see from the code below, you can use FindComponent (or just iterate over a Components collection) to find what you want. However, it is better, if you can, to locate things via the ToolsAPI interfaces. See Update below.
interface
uses
Classes, Windows, Menus, Dialogs, ToolsAPI;
type
TIDEMenuItem = class(TNotifierObject, IOTAWizard, IOTAMenuWizard)
function GetName: string;
function GetIDString: string;
function GetMenuText: string;
function GetState: TWizardState;
procedure Execute;
end;
TIDEMenuHandler = class(TObject)
procedure HandleClick(Sender: TObject);
end;
procedure Register;
implementation
var
MenuItem: TMenuItem;
IDEMenuHandler: TIDEMenuHandler;
EditorPopUpMenu : TPopUpMenu;
procedure TIDEMenuItem.Execute;
begin
ShowMessage('Execute');
end;
function TIDEMenuItem.GetIDString: string;
begin
Result := 'IDEMenuItemID';
end;
function TIDEMenuItem.GetMenuText: string;
begin
Result := 'IDEMenuItemText';
end;
function TIDEMenuItem.GetName: string;
begin
Result := 'IDEMenuItemName';
end;
function TIDEMenuItem.GetState: TWizardState;
begin
Result := [wsEnabled];
end;
procedure TIDEMenuHandler.HandleClick(Sender: TObject);
begin
ShowMessage(TIDEMenuItem(Sender).GetName + ' Clicked');
end;
procedure AddIDEMenu;
var
NTAServices: INTAServices40;
EditorServices: IOTAEditorServices;
EditView: IOTAEditView;
begin
NTAServices := BorlandIDEServices as INTAServices40;
EditorServices := BorlandIDEServices as IOTAEditorServices;
EditView := EditorServices.TopView;
if Assigned(EditView) then begin
EditorPopUpMenu := TPopUpMenu(EditView.GetEditWindow.Form.FindComponent('EditorLocalMenu'));
Assert(EditorPopUpMenu <>Nil);
IDEMenuHandler := TIDEMenuHandler.Create;
MenuItem := TMenuItem.Create(Nil);
MenuItem.Caption := 'Added IDE editor menu item';
MenuItem.OnClick := IDEMenuHandler.HandleClick;
EditorPopUpMenu.Items.Add(MenuItem)
end
else
ShowMessage('Code editor not active');
end;
procedure RemoveIDEMenu;
begin
if MenuItem <> Nil then begin
EditorPopUpMenu.Items.Remove(MenuItem);
FreeAndNil(MenuItem);
IDEMenuHandler.Free;
end;
end;
procedure Register;
begin
RegisterPackageWizard(TIDEMenuItem.Create);
AddIDEMenu;
end;
initialization
finalization
RemoveIDEMenu;
end.
Update: The following code finds the TabControl of the editor window and adds the menu item to its context menu. However, note that it does not account for there being a second editor window open.
procedure AddIDEMenu;
var
NTAServices: INTAServices40;
EditorServices: IOTAEditorServices;
EditView: IOTAEditView;
TabControl : TTabControl;
function FindTabControl(AComponent : TComponent) : TTabControl;
var
i : Integer;
begin
Result := Nil;
if CompareText(AComponent.ClassName, 'TXTabControl') = 0 then begin
Result := TTabControl(AComponent);
exit;
end
else begin
for i := 0 to AComponent.ComponentCount - 1 do begin
if CompareText(AComponent.Components[i].ClassName, 'TXTabControl') = 0 then begin
Result := TTabControl(AComponent.Components[i]);
exit;
end
else begin
Result := FindTabControl(AComponent.Components[i]);
if Result <> Nil then
exit;
end;
end;
end;
end;
begin
NTAServices := BorlandIDEServices as INTAServices40;
EditorServices := BorlandIDEServices as IOTAEditorServices;
EditView := EditorServices.TopView;
if Assigned(EditView) then begin
TabControl := FindTabControl(EditView.GetEditWindow.Form);
Assert(TabControl <> Nil, 'TabControl not found');
EditorPopUpMenu := TabControl.PopupMenu;
Assert(EditorPopUpMenu <> Nil, 'PopUP menu not found');
//EditorPopUpMenu := TPopUpMenu(EditView.GetEditWindow.Form.FindComponent('EditorLocalMenu'));
Assert(EditorPopUpMenu <>Nil);
IDEMenuHandler := TIDEMenuHandler.Create;
MenuItem := TMenuItem.Create(Nil);
MenuItem.Caption := 'Added IDE editor menu item';
MenuItem.OnClick := IDEMenuHandler.HandleClick;
EditorPopUpMenu.Items.Add(MenuItem)
end
else
ShowMessage('No editor active');
end;
I want my application to minimize to the system tray, and not be visible on the taskbar. I followed the suggestions from this and this answer and changed the MainFormOnTaskBar property in the project source:
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.MainFormOnTaskBar := False;
Application.Run;
end.
Next I tried this:
procedure TForm1.Button1Click(Sender: TObject);
begin
Self.Hide;
WindowState := wsMinimized;
TrayIcon1.Visible := True;
end;
and this variant:
procedure TForm1.ApplicationEvents1Minimize(Sender: TObject);
begin
Self.Hide;
WindowState := wsMinimized;
TrayIcon1.Visible := True;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
Application.Minimize;
end;
but while the tray icon shows correctly the application still shows in the taskbar. What am I doing wrong?
David suggests that what I see in the taskbar is not my main form, but my application. Following his advice I hid that using ShowWindow:
procedure TForm1.Button1Click(Sender: TObject);
begin
Self.Hide;
WindowState := wsMinimized;
TrayIcon1.Visible := True;
ShowWindow(Application.Handle, SW_Hide);
end;
Problem solved. Thanks, David.
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;
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;