When I open a pdf document using the AcroPDF component, AcroPDF steals the focus of my edit component (edSuchName)...
the only way that I found to get it back is the following, but I'm not really glad with it. So I'm searching for something better
TMainForm = class(TForm)
AcroPDF1: TAcroPDF;
tmrBringFocusBack: TTimer;
edSearchName: TEdit;
procedure tmrBringFocusBackTimer(Sender: TObject);
procedure OpenDocument;
end;
// ...
procedure TMainform.tmrBringFocusBackTimer(Sender: TObject);
begin
tmrBringFocusBack.Enabled := False;
edSearchName.SetFocus;
end;
procedure TMainform.OpenDocument;
begin
AcroPDF1.LoadFile(AFilename);
AcroPDF1.setShowToolbar(false);
AcroPDF1.setPageMode('none');
AcroPDF1.Show;
tmrBringFocusBack.Interval:= 200; // and sometimes more (when trying, 20 is too less)
tmrBringFocusBack.Enabled := True; // <<<< I have to trigger this timer <<<<
end;
Does anybody know a better way?
Related
I am facing a strange issue. I have set of buttons in a panel and I want to show tooltip for each button. For that I am using TPopUp, but whenever mouse enter, I can observe that memory is increasing for the application. But if I comment the mouse enter and mouse leave events then memory doesn't increase. Did I miss something?
Whenever the mouse enters the button, I can see 0.3MB increase in my task manager.
TfrmEncode = class(TForm)
pnlTop: TPanel;
btnSaveToJSON: TButton;
procedure FormCreate(Sender: TObject);
procedure btnSaveToJSONMouseEnter(Sender: TObject);
procedure btnSaveToJSONMouseLeave(Sender: TObject);
private
{ Private declarations }
pop : TPopup;
cb : TColorBox;
labelText: TLabel;
public
{ Public declarations }
end;
implementation
{$R *.fmx}
procedure TfrmEncode.btnSaveToJSONMouseEnter(Sender: TObject);
begin
Pop.IsOpen := True;
end;
procedure TfrmEncode.btnSaveToJSONMouseLeave(Sender: TObject);
begin
Pop.IsOpen := False;
end;
procedure TfrmEncode.FormCreate(Sender: TObject);
begin
try
pop := TPopup.Create(self);
pop.Parent:= self;
pop.Width:=200;
cb := TColorBox.Create(pop);
cb.Align := TAlignLayout.Client;
cb.Color := TAlphaColors.White;
pop.AddObject(cb);
labelText := TLabel.Create(pop);
labelText.Align :=TAlignLayout.alClient;
labelText.Parent := pop;
labelText.Text := 'This is the hint This is the hint This is the hint This is the hint This is the hint This is the hint This is the hint This is the hint This is the hint This is the hint';
pop.AddObject(labelText);
pop.PlacementTarget := btnSaveToJSON;
pop.Placement:=TPlacement.BottomCenter;
finally
end;
end;
procedure TfrmEncode.FormDestroy(Sender: TObject);
begin
FreeAndNil(pop);
end;
There is a bug in TPopup control. Reported as RSP-21438
TPopup internally creates new TCustomPopupForm every time popup is open. However, that form does not get released when popup is closed (as it should) but only when popup control itself is destroyed.
There are few workarounds
1. Create new TPopup control on open and free it on close
2. Fix FMX.Controls and FMX.Forms
Error can be fixed in implementation section of the above units. That means you can copy FMX.Controls and FMX.Forms into your project folder and Delphi will use those fixed units instead of default ones.
Fix following code:
FMX.Controls - change constructor parameter from False to True - it means popup form will be automatically released on close.
function TPopup.CreatePopupForm: TFmxObject;
...
NewForm := TCustomPopupForm.Create(Self, NewStyle, PlacementTarget, True);
FMX.Forms - assign AutoFree parameter to field.
constructor TCustomPopupForm.Create(AOwner: TComponent; AStyleBook: TStyleBook = nil; APlacementTarget: TControl = nil;
AutoFree: Boolean = True);
var
NewStyleBook: TStyleBook;
begin
FAutoFree := AutoFree;
....
I was looking for an easy way to use RichtText in a default combobox, but found nothing.
So I wrote this little Delphi(7) component, that is working so far.
How is works:
I'm calling "init" to replace the "Edit"-window inside a default combobox with a
runtime-created RichEdit. Size is taken from the Edit, and Edit is finally hidden.
Some event-handlers are included for change-detection and so on.
Problem:
If I click an item of the dropdown-list, the text is shown in the RichEdit.
If some text is entered inside the RichEdit and the dropdown-button is pressed again,
the dropdown-list is opened and closed in the next moment. After some clicks, the list
remains open and is working as expected.
Every time I click the list and change the RichEdit again, the same is happening.
Maybe I have to sent some messages to the combobox to get that fixed ?
I didn't find any solution on the web, so far. Maybe you have an idea.
Thanks for your help !
unit RichTextComboBox;
interface
uses SysUtils, Classes, Controls, StdCtrls, Windows, Messages, forms, Graphics, ComCtrls;
type
TRichTextComboBox = class(TComboBox)
private
FOnChange :TNotifyEvent;
EditHandle :Integer;
procedure proc_FOnComboChange(Sender: TObject);
protected
public
Rich :TRichEdit; // accessable from outside
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Init; // replace Edit in combobox with RichEdit
published
end;
procedure Register;
implementation
constructor TRichTextComboBox.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
end;
// click in Combo-Drop-Down-List
procedure TRichTextComboBox.proc_FOnComboChange(Sender :TObject);
begin
if Rich.Text <> Items.Strings[ItemIndex] then begin
Rich.Text:= Items.Strings[ItemIndex];
end;
if assigned (FOnChange) then FOnChange(sender);
end;
procedure Register;
begin
RegisterComponents('TEST', [tRichTextComboBox]);
end;
destructor TRichTextComboBox.Destroy;
begin
if Rich <> nil then begin
RemoveControl(rich);
Rich.destroy;
end;
inherited Destroy;
end;
// Replace "Edit" with "RichEdit" in ComboBox
//
procedure TRichTextComboBox.init;
var h :integer;
rect :trect;
wndpos :TWindowPlacement;
begin
h:= FindWindowEx(
self.Handle,
0, // handle to a child window
'Edit', // class name
nil
);
Rich:= TRichEdit.create(self);
rich.Parent:= self;
if h <> 0 then begin
EditHandle:= h;
GetWindowRect(h, rect);
// configure RichEdit
GetWindowPlacement(h, #wndpos); // RichEdit with position and size of Edit
rich.BorderStyle:= bsNone;
rich.Text:= self.Text;
rich.Font.Style:= [fsbold, fsItalic];
rich.Top:= wndpos.rcNormalPosition.top;
rich.Left:= wndpos.rcNormalPosition.Left;
rich.Width:= rect.Right - rect.Left;
rich.Height:= rect.Bottom-rect.Top;
rich.WantReturns:= false; // just one line
rich.WordWrap:= false; // just one line
rich.ParentColor:= true; // just one line
rich.Visible:= true;
showwindow(h, sw_hide); // hide Edit
end;
// if drop-down-combo-list is clicked
// change the string of the RichEdit
FOnChange:= self.OnChange; // save original OnChange of ComboBox
rich.OnChange:= FOnChange;
self.OnChange:= proc_FOnComboChange;
end;
end.
Finally I found the solution :-)
The RichEdit is holding the Focus, which causes the drop-down-list not to stay open after entering s.th. in the RichEdit.
This procedure sets the Focus back to the Combobox before it is opening. So everything works as expected.
Code to be inserted:
after protected enter:
procedure DropDown; override;
the procedure looks like this:
procedure TRichTextComboBox.DropDown;
begin
Self.SetFocus;
inherited DropDown;
end;
I prefer this approach, because I don't want to mess around with the OwnerDraw-problems that we can read on many pages. (Some things are still missing: Upkey/Downkey...)
Using the code below, or maybe modifying it, possible to achive my goal?
Or not by using this code, but it must be joystick buttons using when form is hidden in tray.
Thanks
type
TForm125 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
HotKey1 : Integer;
procedure WMHotKey(var Msg: TWMHotKey); message WM_HOTKEY;
public
end;
var
Form125: TForm125;
implementation
{$R *.dfm}
procedure TForm125.FormCreate(Sender: TObject);
begin
HotKey1 := GlobalAddAtom('MyAppHotkey1');//create a unique value for identify the hotkey
if not RegisterHotKey(Handle, HotKey1, MOD_CONTROL, VK_F1) then //register the hotkey CTRL + F1
ShowMessage('Sorry can not register the hotkey');
end;
procedure TForm125.FormDestroy(Sender: TObject);
begin
UnRegisterHotKey(Handle, HotKey1);//unregister the hotkey
GlobalDeleteAtom(HotKey1);//remove the atom
end;
procedure TForm125.WMHotKey(var Msg: TWMHotKey);
begin
if Msg.HotKey = HotKey1 then
ShowMessage('Hello'); // do your stuff
end;
Sorry, this is a follow up on Chris' answer, but it seems OP needs a little more assistance.
I also believe that the use of a joystick component is the way to go.
For example, NLDJoystick. The installation instructions are included, as well as a mini manual.
You will need to follow these steps:
Place the component on your form,
Set Active to True (this won't succeed when there is no joystick attached),
Implement the OnButtonDown event, as follows:
procedure TForm1.NLDJoystick1ButtonDown(Sender: TNLDJoystick;
const Buttons: TJoyButtons);
begin
Beep;
end;
The TJoyButtons type is a set of JoyBtn1..JoyBtn32, so if you wish you can react to a specific button, or a combination of multiple pressed buttons:
procedure TForm1.NLDJoystick1ButtonDown(Sender: TNLDJoystick;
const Buttons: TJoyButtons);
begin
if JoyBtn1 in Buttons then Beep;
//or:
if Buttons = [JoyBtn1, JoyBtn2] then Beep;
end;
Note that if Advanced is False (the default setting) that there are only 4 buttons supported.
You can check the state of the buttons of your joystick(s) when you need to check them... if works even if the form is hidden:
uses ..., MMSystem;
const
iJoystick = 1; // ID of the joystick
var
myjoy : TJoyInfoEx;
begin
myjoy.dwSize := SizeOf(myjoy);
myjoy.dwFlags := JOY_RETURNALL;
if (joyGetPosEx(iJoystick, #myjoy) = JOYERR_NOERROR) then
begin
if (myjoy.wbuttons and joy_button1) > 0 then // you can do it for all the buttons you need
begin
ShowMessage('button 1 down');
end;
end;
end;
Eventually, you can create a timer which often checks their status to know if the status has change and trigger what you need...
In Form1 I have PageControl. At run time my program creates tab sheets. In each TabSheet I create Form2. In Form2 I have a Memo1 component. How can I add text to Memo1?
You could do something like this:
(PageControl1.Pages[0].Controls[0] as TForm2).Memo1.Lines.Add('text');
If I get right what are you doing,
procedure TForm1.Button1Click(Sender: TObject);
var
View: TForm;
Memo1, Memo2: TMemo;
Page: TTabSheet;
I: Integer;
begin
View:= TForm2.Create(Form1);
View.Parent:= PageControl1.Pages[0];
View.Visible:= True;
View:= TForm2.Create(Form1);
View.Parent:= PageControl1.Pages[1];
View.Visible:= True;
// find the first memo:
Page:= PageControl1.Pages[0];
Memo1:= nil;
for I:= 0 to Page.ControlCount - 1 do begin
if Page.Controls[I] is TForm2 then begin
Memo1:= TForm2(Page.Controls[I]).Memo1;
Break;
end;
end;
Page:= PageControl1.Pages[1];
// find the second memo:
Memo2:= nil;
for I:= 0 to Page.ControlCount - 1 do begin
if Page.Controls[I] is TForm2 then begin
Memo2:= TForm2(Page.Controls[I]).Memo1;
Break;
end;
end;
if Assigned(Memo1) then Memo1.Lines.Add('First Memo');
if Assigned(Memo2) then Memo2.Lines.Add('Second Memo');
end;
I see one big problem with this code--Memo2 is going to have exactly the same value as Memo1 as there's no difference in the search loops. Also, if this code is complete then there's nothing but the form on the page, there's no reason for a search loop at all.
VilleK's answer should compile and run, I don't see what you are asking for.
So, I solved my problem with your help. This is my code:
var
ID, I: integer;
Tekstas: string;
View: TForm2;
Memo: TMemo;
Page: TTabSheet;
begin
...
Page := PageControl.Pages[ID];
for i := 0 to Page.ControlCount - 1 do
begin
(PageControl.Pages[ID].Controls[0] as TKomp_Forma).Memo.Lines.Add('['+TimeToStr(Time)+']'+Duom[ID].Vardas+': '+Tekstas);
end;
end;
Hope this helps someone else
So I have a TMenuItem attached to a TAction on a TPopupMenu for a TDBGrid (actually 3rd party, but you get the idea). Based on the selected row in the grid, the TAction is enabled or disabled. What I want is to be able to display a hint to the user explaining why the item is disabled.
As far as why I want a hint on a disabled menu item, lets just say I am in agreement with Joel.
All TMenuItem's have a hint property, but as best I can tell they are only used the the TApplicationEvent.OnHint event handler to stick the hint in a TStatusBar or some other special processing. I found an article on how to create your own even window for a TMainMenu's TMenuItems, but it doesn't work on a TPopupMenu's TMenuItem. It works by handling the WM_MENUSELECT message, which as far as I can tell is not sent on a TPopupMenu.
WM_MENUSELECT is indeed handled for menu items in popup menus also, but not by the windows proc of the form containing the (popup) menu, but by an invisible helper window created by Menus.PopupList. Luckily you can (at least under Delphi 5) get at this HWND via Menus.PopupList.Window.
Now you can use the old-fashioned way to subclass a window, as described for example in this CodeGear article, to handle WM_MENUSELECT also for popup menus. The HWND will be valid from after the first TPopupMenu is created to before the last TPopupMenu object is destroyed.
A quick test with the demo app in the linked article in the question should reveal whether this is going to work.
Edit: It does indeed work. I changed the linked example to show hints also for the popup menu. Here are the steps:
Add a handler for OnDestroy, a member variable for the old window proc and a method for the new window proc to the form:
TForm1 = class(TForm)
...
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure ApplicationEvents1Hint(Sender: TObject);
private
miHint : TMenuItemHint;
fOldWndProc: TFarProc;
procedure WMMenuSelect(var Msg: TWMMenuSelect); message WM_MENUSELECT;
procedure PopupListWndProc(var AMsg: TMessage);
end;
Change the OnCreate handler of the form to subclass the hidden PopupList window, and implement the proper restoration of the window proc in the OnDestroy handler:
procedure TForm1.FormCreate(Sender: TObject);
var
NewWndProc: TFarProc;
begin
miHint := TMenuItemHint.Create(self);
NewWndProc := MakeObjectInstance(PopupListWndProc);
fOldWndProc := TFarProc(SetWindowLong(Menus.PopupList.Window, GWL_WNDPROC,
integer(NewWndProc)));
end;
procedure TForm1.FormDestroy(Sender: TObject);
var
NewWndProc: TFarProc;
begin
NewWndProc := TFarProc(SetWindowLong(Menus.PopupList.Window, GWL_WNDPROC,
integer(fOldWndProc)));
FreeObjectInstance(NewWndProc);
end;
Implement the subclassed window proc:
procedure TForm1.PopupListWndProc(var AMsg: TMessage);
function FindItemForCommand(APopupMenu: TPopupMenu;
const AMenuMsg: TWMMenuSelect): TMenuItem;
var
SubMenu: HMENU;
begin
Assert(APopupMenu <> nil);
// menuitem
Result := APopupMenu.FindItem(AMenuMsg.IDItem, fkCommand);
if Result = nil then begin
// submenu
SubMenu := GetSubMenu(AMenuMsg.Menu, AMenuMsg.IDItem);
if SubMenu <> 0 then
Result := APopupMenu.FindItem(SubMenu, fkHandle);
end;
end;
var
Msg: TWMMenuSelect;
menuItem: TMenuItem;
MenuIndex: integer;
begin
AMsg.Result := CallWindowProc(fOldWndProc, Menus.PopupList.Window,
AMsg.Msg, AMsg.WParam, AMsg.LParam);
if AMsg.Msg = WM_MENUSELECT then begin
menuItem := nil;
Msg := TWMMenuSelect(AMsg);
if (Msg.MenuFlag <> $FFFF) or (Msg.IDItem <> 0) then begin
for MenuIndex := 0 to PopupList.Count - 1 do begin
menuItem := FindItemForCommand(PopupList.Items[MenuIndex], Msg);
if menuItem <> nil then
break;
end;
end;
miHint.DoActivateHint(menuItem);
end;
end;
This is done for all popup menus in a loop, until the first matching item or submenu is found.
Not sure if it helps, but I have created my own multi-line hint window (for Delphi7) to be able to show more then just one line of text.
It's open source and you can find it here.
There is some work involved showing it on the right location on the screen, but you have full control over it.