English Translation (been a while, so may not be entirely accurate; used google translate for the parts I had trouble with):
I'm working on a Visual Component in Delphi (it's not a standard Delphi component) which possesses a property called PopupMenu. I associated the property PopupMenu in the component with the PopupMenu, but when I click the right button [of the mouse], I see nothing.
I also tried to force it to display with this code:
x:= Mouse.CursorPos.X;
y:= Mouse.CursorPos.Y;
// //showmessage(inttostr(x)) PopupMenu1.Popup(x,y);
I have two questions:
How do you know that the right click of the mouse is active? Have any of you encountered this type of problem? Thank you for your answers.
Thanks
EDIT
Here is the procedure that I'm using to execute the PopupMenu1: procedure
TForm6.GeckoBrowser1DOMMouseDown(Sender: TObject; Key: Word);
var x,y:integer;
begin
if key=VK_RBUTTON then begin
x:= Mouse.CursorPos.X;
y:= Mouse.CursorPos.Y;
//showmessage(inttostr(x)) PopupMenu1.Popup(x,y);
end;
end;
This will never work. You cannot mix code in a form with the component code.
I would suggest something like this:
interface
type
TGeckoBrowser = class(....
private
FPopupmenu: TPopupMenu;
protected
...
procedure MouseUp(Sender: TObject; Key: Word); override;
...
published
property PopupMenu: TPopupMenu read FPopupMenu write FPopupMenu;
end;
implementation
....
procedure TGeckoBrowser.MouseUp(Sender: TObject; Key: Word);
var
x,y: integer;
begin
inherited;
if (key=VK_RBUTTON) and Assigned(PopupMenu) then begin
x:= Mouse.CursorPos.X;
y:= Mouse.CursorPos.Y;
PopupMenu.Popup(x,y);
end; {if}
end;
or if you do not want the OnMouseUp to fire when a popup menu appears do:
implementation
....
procedure TGeckoBrowser.MouseUp(Sender: TObject; Key: Word);
var
x,y: integer;
begin
if (key=VK_RBUTTON) and Assigned(PopupMenu) then begin
x:= Mouse.CursorPos.X;
y:= Mouse.CursorPos.Y;
PopupMenu.Popup(x,y);
end {if}
else inherited;
end;
See the difference? Popupmenu is now a part (well linked part anyway) of your component and not something that just happens to be on the same form.
Related
Closed. This question needs details or clarity. It is not currently accepting answers.
Want to improve this question? Add details and clarify the problem by editing this post.
Closed 2 years ago.
Improve this question
I have a TComboBox in Delphi 10.3. I have a Combobox with over 30 items. I need to code a different action for each item of the Combobox. At the moment I'm using if-else statements. As there are 30 different items the if statements are going to be way too long. Is there a quicker way to do this?
This entirely depends on your situation. It is almost impossible to answer your Q without knowing your precise scenario.
Nevertheless, here are a few ideas. Maybe they are relevant to your situation, maybe they are not.
Trivial parameterisation by index
In the best case scenario, your 30 actions can be parameterised. For instance, suppose the items of the combo box are
Show 1
Show 10
Show 100
Show 1000
...
which will display a message box with the given number. In this scenario, you don't need 30 different procedures (here each represented by a simple call to ShowMessage):
procedure TForm1.btnNextClick(Sender: TObject);
begin
case ComboBox1.ItemIndex of
0:
ShowMessage('1');
1:
ShowMessage('10');
2:
ShowMessage('100');
3:
ShowMessage('1000');
// ...
end;
end;
Instead, you should use only one procedure, but with a parameter:
procedure TForm1.btnNextClick(Sender: TObject);
begin
if ComboBox1.ItemIndex <> -1 then
ShowMessage(IntPower(10, ComboBox1.ItemIndex).ToString)
end;
Parameterisation by the associated object
If the action cannot be described by the item's index alone, you can use the object pointer associated with each item. Maybe it is enough to use it to store an integer:
procedure TForm1.FormCreate(Sender: TObject);
begin
ComboBox1.Items.BeginUpdate;
try
ComboBox1.Items.Clear;
ComboBox1.Items.AddObject('Show 51', TObject(51));
ComboBox1.Items.AddObject('Show 111', TObject(111));
ComboBox1.Items.AddObject('Show 856', TObject(856));
ComboBox1.Items.AddObject('Show 1000', TObject(1000));
finally
ComboBox1.Items.EndUpdate;
end;
end;
procedure TForm1.btnNextClick(Sender: TObject);
begin
if ComboBox1.ItemIndex <> -1 then
ShowMessage(Integer(ComboBox1.Items.Objects[ComboBox1.ItemIndex]).ToString);
end;
Otherwise, you can let it be a true pointer to some object with any amount of data (integers, strings, ...).
Unrelated procedures
The examples above all require that the procedures can be parameterised, i.e. replaced by a single procedure with a parameter. If this is not the case, if the procedures are completely unrelated, you need a different approach. But again, which approach is most suitable depends on your precise situation.
Here are a few examples.
Simple case statement
At design time, set the items to Play sound, Run Notepad, and Show Start Menu.
procedure PlaySound;
begin
MessageBeep(MB_ICONINFORMATION);
end;
procedure RunNotepad;
begin
ShellExecute(Form1.Handle, nil, 'notepad', nil, nil, SW_SHOWNORMAL)
end;
procedure ShowStartMenu;
begin
Form1.Perform(WM_SYSCOMMAND, SC_TASKLIST, 0)
end;
procedure TForm1.btnNextClick(Sender: TObject);
begin
case ComboBox1.ItemIndex of
0:
PlaySound;
1:
RunNotepad;
2:
ShowStartMenu;
end;
end;
Storing procedural pointers with the items
procedure PlaySound;
begin
MessageBeep(MB_ICONINFORMATION);
end;
procedure RunNotepad;
begin
ShellExecute(Form1.Handle, nil, 'notepad', nil, nil, SW_SHOWNORMAL)
end;
procedure ShowStartMenu;
begin
Form1.Perform(WM_SYSCOMMAND, SC_TASKLIST, 0)
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
ComboBox1.Items.BeginUpdate;
try
ComboBox1.Items.Clear;
ComboBox1.Items.AddObject('Play sound', TObject(#PlaySound));
ComboBox1.Items.AddObject('Run notepad', TObject(#RunNotepad));
ComboBox1.Items.AddObject('ShowStartMenu', TObject(#ShowStartMenu));
finally
ComboBox1.Items.EndUpdate;
end;
end;
procedure TForm1.btnNextClick(Sender: TObject);
begin
if ComboBox1.ItemIndex <> -1 then
TProcedure(ComboBox1.Items.Objects[ComboBox1.ItemIndex])();
end;
Benefit: no risk of confusing the indices; the actions are "attached" to the items.
Using a dictionary of commands
Maybe your application has a global set of commands, denoted by English words. Then you might want to use a dictionary to get the procedure associated with a word. This can be used for the combo box as well. At design time, let there be three items: beep, write, and start:
type
TForm1 = class(TForm)
ComboBox1: TComboBox;
btnNext: TButton;
procedure btnNextClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
FCommands: TDictionary<string, TProcedure>;
public
end;
procedure PlaySound;
begin
MessageBeep(MB_ICONINFORMATION);
end;
procedure RunNotepad;
begin
ShellExecute(Form1.Handle, nil, 'notepad', nil, nil, SW_SHOWNORMAL)
end;
procedure ShowStartMenu;
begin
Form1.Perform(WM_SYSCOMMAND, SC_TASKLIST, 0)
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FCommands := TDictionary<string, TProcedure>.Create;
FCommands.Add('beep', PlaySound);
FCommands.Add('write', RunNotepad);
FCommands.Add('start', ShowStartMenu);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
FCommands.Free;
end;
procedure TForm1.btnNextClick(Sender: TObject);
var
Cmd: TProcedure;
begin
if
(ComboBox1.ItemIndex <> -1)
and
FCommands.TryGetValue(ComboBox1.Items[ComboBox1.ItemIndex], Cmd)
then
Cmd();
end;
I'm trying to free a component when i click it. So, i've written the simplest code i could imagine to achieve this: a procedure that frees it's sender. But on Delphi 7 (Tried on Delphi XE 10 and it worked with no errors) it sometimes throws an Access Violation or Abstract Error randomly. The easiest way to replicate this is to insert like 30 Buttons and assign an onclick procedure with the code below, then click them.
I've tried the two codes below, both on onclick:
procedure FreeMe(Sender: TObject);
begin
TButton(Sender).Free;
end;
or
procedure FreeMe(Sender: TObject);
begin
(Sender as TButton).Free;
end;
You need to delay the freeing until after the button's OnClick event handier has fully exited. It is important that the freeing happens when the object being freed is idle and not in the middle of processing anything.
One way to do that is to use PostMessage(), eg:
var
MyReleaseWnd: HWND;
procedure TMyMainForm.FormCreate(Sender: TObject);
begin
MyReleaseWnd := AllocateHWnd(MyReleaseWndProc);
end;
procedure TMyMainForm.FormDestroy(Sender: TObject);
begin
DeallocateHWnd(MyReleaseWnd);
end;
procedure TMyMainForm.MyReleaseWndProc(var Message: TMessage);
begin
if Message.Msg = CM_RELEASE then
TObject(Msg.LParam).Free
else
Message.Result := DefWindowProc(MyReleaseWnd, Message.Msg, Message.WParam, Message.LParam);
end;
procedure DelayFreeMe(Sender: TObject);
begin
PostMessage(MyReleaseWnd, CM_RELEASE, 0, LPARAM(Sender));
end;
Alternatively, in 10.2 Tokyo and later, you can use TThread.ForceQueue() instead:
procedure DelayFreeMe(Sender: TObject);
begin
TThread.ForceQueue(nil, Sender.Free);
end;
Either way, you can then do this:
procedure TSomeForm.ButtonClick(Sender: TObject);
begin
DelayFreeMe(Sender);
end;
I am super newbie and tried to write following code which sets every TEdit.Text to one mentioned in code
procedure TForm2.Button1Click(Sender: TObject);
var
i : integer;
Edit : TEdit;
begin
for i := 0 to Edit.ComponentCount - 1 do
begin
with Edit.Components[i] do
begin
Text := 'Done';
end;
end;
end;
What am I doing wrong ?
Here are the mistakes that I can see:
You never assign a value to Edit.
Typically the form owns all the components, and so a TEdit will have zero owned components.
Edit.Components[i] is of type TComponent which does not have a Text property. If your code compiles, then Text is actually that of the form. The lesson you should learn from this point is never to use with ever again.
You should solve this using code like this:
procedure TForm2.Button1Click(Sender: TObject);
var
i: Integer;
Edit: TEdit;
begin
for i := 0 to ComponentCount-1 do begin
if Components[i] is TEdit then begin
Edit := TEdit(Components[i]);
Edit.Text := 'Done';
end;
end;
end;
Note that here we are using ComponentCount and Components[] from the form itself. We have removed the evil with statement. And we have had to cast the component to a reference of type TEdit, after first using the is operator to check the type of the component.
This approach will work so long as the form owns all the edits found within it. However, if you create controls dynamically, or if you use frames or parented forms, then this approach, based on ownership via Components[] will not yield all the controls. In such more complex cases you would need to iterate using the parent/child relationship using ControlCount and Controls[].
What am I doing wrong? Just about everything. What I think you are trying to achieve is to put the same text in all TEdits on the form. So you need to go through all the components in TForm (not Edit!) and and check that each is really a Tedit, and if so assign the text. Like this:
procedure TForm2.Button1Click(Sender: TObject);
var
i:integer;
begin
for i := 0 to ComponentCount - 1 do
begin
if Components[ I ] is TEdit then
begin
(Components[ I ] as TEdit).Text := 'Done';
end;
end;
end;
As an aside - avoid using 'with'. It just cases ambiguity and confusion.
You could iterate over all child controls of the form, and if the current control is a TEdit, then you set its text. If the current control is a windowed control, it might have child controls of its own, and you need to redo same thing for this control. Hence, let's use recursion:
procedure SetAllEdits(AParent: TWinControl; const AText: string);
var
i: Integer;
begin
for i := 0 to AParent.ControlCount - 1 do
if AParent.Controls[i] is TCustomEdit then
TCustomEdit(AParent.Controls[i]).Text := AText
else if AParent.Controls[i] is TWinControl then
SetAllEdits(TWinControl(AParent.Controls[i]), AText);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
SetAllEdits(Self, 'test');
end;
There are other ways, like subclassing the edit control and having the new class respond to broadcasted messages.
Answer from D. Heffernan is already good, I'm trying to make it easier to understand for beginner.
In this code, we do "typecast" TEdit to TComponent by command: aEdit := TEdit(aComponent), because TEdit is inherited from TComponent.
What you get from iteration (for ...) is TComponent, not TEdit. You get TEdit by "typecast" it.
procedure TForm2.Button1Click(Sender: TObject);
var
i : Integer;
aComponent : TComponent;
aEdit : TEdit;
begin
for i := 0 to ComponentCount-1 do
begin
aComponent := Components[i];
if aComponent is TEdit then
begin
aEdit := TEdit(aComponent);
aEdit.Text := 'Done';
end;
end;
end;
Given a TForm with a TListBox on it, the following works:
procedure TForm1.FormCreate(Sender: TObject);
procedure _WorkOnListBox;
begin
ListBox.Items.Append('Test');
end;
begin
_WorkOnListBox;
end;
As does the following:
procedure TForm1.DoWithoutListBoxEvents(AProc: TProc);
begin
ListBox.Items.BeginUpdate;
try
AProc;
finally
ListBox.Items.EndUpdate;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
DoWithoutListBoxEvents(procedure
begin
LayersListBox.Items.Append('Test');
end);
end;
But the following does not:
procedure TForm1.FormCreate(Sender: TObject);
procedure _WorkOnListBox;
begin
ListBox.Items.Append('Test');
end;
begin
DoWithoutListBoxEvents(_WorkOnListBox);
end;
I get an E2555 Cannot capture symbol '_WorkOnListBox'. Why? Is there any way to get the DoWithoutListBoxEvents to work without using an anonymous procedure? Although I think it looks elegant with it, I'm trying to stay FPC compatible.
DoWithoutEvents() takes a TProc as input:
type
TProc = procedure;
Only a standalone non-class procedure and an anonymous procedure can be assigned to a TProc. _WorkOnForm is neither of those, it is a local procedure instead. A local procedure has special compiler handling that ties it to its parent's stack frame. Thus, _WorkOnForm is not compatible with TProc.
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;