Related
I have a small Delphi 10.3.3 app that has some text editing functions, using a TMemo where the user type the text.
I'm trying to include some formatting options, something as this site provides :
http://qaz.wtf/u/convert.cgi?text=How%20do%20it%20on%20Delphi
When i copy the 'circled' text from the site above and paste on my memo, it works, appears 'circled'. But i want to give my user the ability to apply the formatting inside my app.
For instance, i want to have a speedbutton to apply the 'circle' formatting to the current TMemo selected text : the user selects a text , click on this speedbutton and then the selected text gets the 'circled' formatting.
This is rather easy. If you look at the Unicode chart for the enclosed alphanumerics, you realise that the following mapping is valid:
function EncircleChr(AChr: Char): Char;
begin
case AChr of
'0':
Result := Chr($24EA);
'1'..'9':
Result := Chr($2460 + Ord(AChr) - Ord('1'));
'a'..'z':
Result := Chr($24D0 + Ord(AChr) - Ord('a'));
'A'..'Z':
Result := Chr($24B6 + Ord(AChr) - Ord('A'));
else
Result := AChr;
end;
end;
Hence, with
function Encircle(const S: string): string;
var
i: Integer;
begin
SetLength(Result, S.Length);
for i := 1 to S.Length do
Result[i] := EncircleChr(S[i]);
end;
and
procedure TForm1.Button1Click(Sender: TObject);
begin
Memo1.SelText := Encircle(Memo1.SelText);
end;
you get the desired behaviour:
This dialog shows exactly under button, but in Windows 8 dialog is shifted to the left and upward. How to get the same results in all Windows versions?
procedure TForm1.Button3Click(Sender: TObject);
var p: TPoint;
begin
p := Button3.ClientToScreen(Point(0, Button3.Height));
MessageDlgPos('', mtInformation, [mbOK], 0, p.X, p.Y);
end;
update:
In case we open Form instead of Dialog, and if that Form has BorderStyle bsSizeable or bsSizeToolWin, then everything is OK. Otherwise (bsDialog, bsSingle, bsToolWindow), Form opens shifted as Dialog from the example above.
Running the exact code you have shown on Windows 7, I am not able to reproduce the same dialog positioning you have shown in your Windows 7 screnshot. The MessageDlgPos window is offset up and to the left in the same manner as your Windows 8 screenshot:
That being said, I notice you are positioning your MessageDlg window relative to the button's client area:
If you want the dialog positioned relative to its actual bottom edge, you need to call ClientToScreen() on the button's Parent rather than on the button itself:
p := Button3.Parent.ClientToScreen(Point(Button3.Left, Button3.Top+Button3.Height));
The end result is about the same, though:
Now, why is the overlap occurring in the first place? Because the window is being positioned such that the top-left corner of its non-client area falls at the specified coordinates:
You can adjust the window coordinates to account for that:
p := Button3.Parent.ClientToScreen(Point(Button3.Left, Button3.Top + Button3.Height));
Inc(p.X, GetSystemMetrics(SM_CXFIXEDFRAME) + GetSystemMetrics(SM_CXBORDER));
Inc(p.Y, GetSystemMetrics(SM_CYFIXEDFRAME) + GetSystemMetrics(SM_CYBORDER));
Which gets you much closer to the desired position:
Note that Aero "tweaks" system metrics a bit, so you might need to use things like DwmGetWindowAttribute(DWMWA_EXTENDED_FRAME_BOUNDS) and/or GetThemeSysSize() to get more accurate metrics.
After your answers and comments and some additional research, I came to this solution. Tested on Windows 8, 7 with Aero, 7 without Aero and XP. I was hoping for something more simple and stable but ...
uses DwmApi;
type
TNonClientMetricsX = packed record
cbSize: UINT;
iBorderWidth: Integer; iScrollWidth: Integer;
iScrollHeight: Integer; iCaptionWidth: Integer;
iCaptionHeight: Integer; lfCaptionFont: TLogFontA;
iSmCaptionWidth: Integer; iSmCaptionHeight: Integer;
lfSmCaptionFont: TLogFontA; iMenuWidth: Integer;
iMenuHeight: Integer; lfMenuFont: TLogFontA;
lfStatusFont: TLogFontA; lfMessageFont: TLogFontA;
iPaddedBorderWidth: Integer; // not defined in Delphi 2007
end;
function GetExtendedFrameOffset(BorderStyle: TFormBorderStyle): integer;
var
IsEnabled: BOOL;
NCM: TNonClientMetricsX;
begin
Result := 0;
if (DwmIsCompositionEnabled(IsEnabled) = S_OK) and IsEnabled and
(BorderStyle in [bsdialog, bsSingle, bsToolWindow]) then
begin
NCM.cbSize := SizeOf(NCM);
SystemParametersInfo(SPI_GETNONCLIENTMETRICS, SizeOf(NCM), #NCM, 0);
Result := NCM.iBorderWidth + NCM.iPaddedBorderWidth;
end;
end;
procedure TForm1.Button3Click(Sender: TObject);
var p: TPoint; offset: integer;
begin
p := Button3.ClientToScreen(Point(0, Button3.Height));
offset := GetExtendedFrameOffset(bsDialog);
MessageDlgPos('', mtInformation, [mbOK], 0, p.X + offset, p.Y + offset);
end;
update: D2007 includes DwmApi, so no need for complications with LoadLibrary
This question is unlikely to help any future visitors; it is only relevant to a small geographic area, a specific moment in time, or an extraordinarily narrow situation that is not generally applicable to the worldwide audience of the internet. For help making this question more broadly applicable, visit the help center.
Closed 10 years ago.
I have a button and when clicked, i would like for a TMachine (aka TShape) to show up on the form. Currenty i get no errors, but it never shows up on the form.
Code for button click
procedure TfDeptLayout.bAddMachineClick(Sender: TObject);
var
machine: TMachine;
shapeAsset,
shapeShape,
shapeNumber,
shapeName: string;
begin
if not OkToAdd() then
begin
ShowMessage('Please fill out form correctly!');
Exit;
end;
ShapeAsset := Edit2.text;
ShapeShape := Combobox1.Text;
ShapeNumber := Edit3.Text;
ShapeName := Edit1.Text;
if sub = false then
begin
machine := TMachine.Create(self);
machine.Parent := Self;
machine.PlaceShape(0, FDB.GetWW(ShapeShape), FDB.GethW(ShapeShape),
'20', '20', ShapeName, ShapeNumber, ShapeAsset)
//show save button
//lockout add machine button
//let user place machine top / left.
//save all locations
//save top and left for each tmachine to database
//lockout save button
//show add machine button
end;
if sub then
ShowMessage('auto save form');
ShowMessage('congrats you added a machine');
end;
if needed i can show the TMachine unit?..
type
TMachine = class(TShape)
private
FOnMouseEnter: TNotifyEvent;
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
protected
procedure DoMouseEnter; virtual;
published
property OnMouseEnter: TNotifyEvent Read FOnMouseEnter write FOnMouseEnter;
public
mnName: string;
mnAsset: string;
mnNumber: string;
mnIsPanel: string;
mnBasicName: string;
mnLShape: string;
procedure PlaceShape(AM, sizeW, sizeH: Integer; ptop, pleft, name, order,
asset: string);
end;
implementation
uses
deptlayout;
procedure TMachine.CMMouseEnter(var Message: TMessage);
begin
DoMouseEnter;
inherited;
end;
procedure TMachine.DoMouseEnter;
begin
if Assigned(FOnMouseEnter) then
FOnMouseEnter(Self);
end;
procedure TMachine.PlaceShape(AM, sizeW, sizeH: Integer; ptop, pleft, name,
order, asset: string);
var
myLabel: TLabel;
begin
if ptop = '0' then
Top := 136
else
Top := StrToInt(ptop);
Width := sizeW;
Height := sizeH;
if pleft = '0' then
Left := MyDataModule.fDB.LastX + 2 //set left
else
Left := StrToInt(pleft);
MyDataModule.fDB.lastx := Left + sizeW;
if AM = 1 then //if in edit mode..
begin
//create label put inside the shape.
myLabel := TLabel.Create(FDeptLayout);
mylabel.Parent := FDeptLayout;
mylabel.Left := Left;
mylabel.Top := Top + 8;
mylabel.Caption := '#' + mnNumber;
end;
end;
end.
Of course it doesn't work!
The code that adds the machine is inside if not OkToAdd() then, so it will only run if not OkToAdd. BUT! Even if this is the case, you Exit before you run the code! Hence, the code will never run!
Probably you mean it to be like this:
if not OkToAdd then
begin
ShowMessage('Please fill out form correctly!');
Exit;
end; //END!!!!!!
To summarise my comments above:
Change the refer to fDeptLayout to Self, as you have done in your edit:
procedure TfDeptLayout.bAddMachineClick(Sender: TObject);
var
machine : TMachine;
shapeAsset,
shapeShape,
shapeNumber,
shapeName : string;
begin
if not OkToAdd() then
begin
showmessage('Please fill out form correctly!');
Exit;
End;
shapeAsset := edit2.text;
ShapeShape := Combobox1.Text;
ShapeNumber := Edit3.Text;
ShapeName := Edit1.Text;
if sub = false then
begin
machine := TMachine.Create(self);
machine.Parent := Self;
machine.PlaceShape(0,FDB.GetWW(ShapeShape),FDB.GethW(ShapeShape),'20','20',ShapeName,ShapeNumber,ShapeAsset)
//show save button
//lockout add machine button
//let user place machine top / left.
//save all locations
//save top and left for each tmachine to database
//lockout save button
//show add machine button
end;
if sub then
showmessage('auto save form');
showmessage('congrats you added a machine');
end;
To avoid confusion in future, delete the global form variables that the Delphi IDE creates for all but the main form, and any other autocreated forms - they are rarely if ever needed, and "pollute the namespace"
Unknown why this solved it, but after trying to find the parent for Machine by putting
showmessage('Machine Parent: '+Machine.parent.name);
it was giving access errors.
Deleted
Machine.parent := self;
Compile, build. Then reaadded
Machine.parent := self;
and everything worked.
Is it possible to get Delphi to close a ShowMessage or MessageDlg Dialog after a certain length of time?
I want to show a message to the user when the application is shut down, but do not want to stop the application from shutting down for more than 10 seconds or so.
Can I get the default dialog to close after a defined time, or will I need to write my own form?
Your application is actually still working while a modal dialog or system message box or similar is active (or while a menu is open), it's just that a secondary message loop is running which processes all messages - all messages sent or posted to it, and it will synthesize (and process) WM_TIMER and WM_PAINT messages when necessary as well.
So there's no need to create a thread or jump through any other hoops, you simply need to schedule the code that closes the message box to be run after those 10 seconds have elapsed. A simple way to do that is to call SetTimer() without a target HWND, but a callback function:
procedure CloseMessageBox(AWnd: HWND; AMsg: UINT; AIDEvent: UINT_PTR;
ATicks: DWORD); stdcall;
var
Wnd: HWND;
begin
KillTimer(AWnd, AIDEvent);
// active window of the calling thread should be the message box
Wnd := GetActiveWindow;
if IsWindow(Wnd) then
PostMessage(Wnd, WM_CLOSE, 0, 0);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
TimerId: UINT_PTR;
begin
TimerId := SetTimer(0, 0, 10 * 1000, #CloseMessageBox);
Application.MessageBox('Will auto-close after 10 seconds...', nil);
// prevent timer callback if user already closed the message box
KillTimer(0, TimerId);
end;
Error handling ommitted, but this should get you started.
You can try to do it with a standard Message dialog. Create the dialog with CreateMessageDialog procedure from Dialogs and after add the controls that you need.
In a form with a TButton define onClick with this:
procedure TForm1.Button1Click(Sender: TObject);
var
tim:TTimer;
begin
// create the message
AMsgDialog := CreateMessageDialog('This is a test message.',mtWarning, [mbYes, mbNo]) ;
lbl := TLabel.Create(AMsgDialog) ;
tim := TTimer.Create(AMsgDialog);
counter := 0;
// Define and adding components
with AMsgDialog do
try
Caption := 'Dialog Title' ;
Height := 169;
// Label
lbl.Parent := AMsgDialog;
lbl.Caption := 'Counting...';
lbl.Top := 121;
lbl.Left := 8;
// Timer
tim.Interval := 400;
tim.OnTimer := myOnTimer;
tim.Enabled := true;
// result of Dialog
if (ShowModal = ID_YES) then begin
Button1.Caption := 'Press YES';
end
else begin
Button1.Caption := 'Press NO';
end;
finally
Free;
end;
end;
An the OnTimer property like this:
procedure TForm1.MyOnTimer(Sender: TObject);
begin
inc(counter);
lbl.Caption := 'Counting: ' + IntToStr(counter);
if (counter >= 5) then begin
AMsgDialog.Close;
end;
end;
Define the variables and procedure:
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
AMsgDialog: TForm;
lbl:TLabel;
counter:integer;
procedure MyOnTimer(Sender: TObject);
end;
And test it.
The form close automatically when the timer final the CountDown. Similar this you can add other type of components.
Regards.
Try this:
function MessageBoxTimeOut(hWnd: HWND; lpText: PChar; lpCaption: PChar;
uType: UINT; wLanguageId: WORD; dwMilliseconds: DWORD): integer;
stdcall; external user32 name 'MessageBoxTimeoutA';
I've been using this for quite some time; it works a treat.
OK. You have 2 choices:
1 - You can create your own MessageDialog form. Then, you can use it and add a TTimer that will close the form when you want.
2 - You can keep using showmessage and create a thread that will use FindWindow (to find the messadialog window) and then close it.
I recommend you to use you own Form with a timer on it. Its cleaner and easier.
This works fine with windows 98 and newers...
I don't use the " MessageBoxTimeOut" because old windows 98, ME, doesn't have it...
this new function works like a "CHARM"..
//add this procedure
procedure DialogBoxAutoClose(const ACaption, APrompt: string; DuracaoEmSegundos: Integer);
var
Form: TForm;
Prompt: TLabel;
DialogUnits: TPoint;
ButtonTop, ButtonWidth, ButtonHeight: Integer;
nX, Lines: Integer;
function GetAveCharSize(Canvas: TCanvas): TPoint;
var
I: Integer;
Buffer: array[0..51] of Char;
begin
for I := 0 to 25 do Buffer[I] := Chr(I + Ord('A'));
for I := 0 to 25 do Buffer[I + 26] := Chr(I + Ord('a'));
GetTextExtentPoint(Canvas.Handle, Buffer, 52, TSize(Result));
Result.X := Result.X div 52;
end;
begin
Form := TForm.Create(Application);
Lines := 0;
For nX := 1 to Length(APrompt) do
if APrompt[nX]=#13 then Inc(Lines);
with Form do
try
Font.Name:='Arial'; //mcg
Font.Size:=10; //mcg
Font.Style:=[fsBold];
Canvas.Font := Font;
DialogUnits := GetAveCharSize(Canvas);
//BorderStyle := bsDialog;
BorderStyle := bsToolWindow;
FormStyle := fsStayOnTop;
BorderIcons := [];
Caption := ACaption;
ClientWidth := MulDiv(Screen.Width div 4, DialogUnits.X, 4);
ClientHeight := MulDiv(23 + (Lines*10), DialogUnits.Y, 8);
Position := poScreenCenter;
Prompt := TLabel.Create(Form);
with Prompt do
begin
Parent := Form;
AutoSize := True;
Left := MulDiv(8, DialogUnits.X, 4);
Top := MulDiv(8, DialogUnits.Y, 8);
Caption := APrompt;
end;
Form.Width:=Prompt.Width+Prompt.Left+50; //mcg fix
Show;
Application.ProcessMessages;
finally
Sleep(DuracaoEmSegundos*1000);
Form.Free;
end;
end;
////////////////////////////How Call It//////////////////
DialogBoxAutoClose('Alert'', "This message will be closed in 10 seconds',10);
/////////////////////////////////////////////////////////
MessageBox calls this function internally and pass 0xFFFFFFFF as timeout parameter, so the probability of it being removed is minimal (thanks to Maurizio for that)
I thought about using a separate thread, but it's probably going to get you into a lot of unnecessary code etc. Windows dialogs were simply not made for this thing.
You should do your own form. On the good side, you can have custom code/UI with a countdown like timed dialog boxes do.
No. ShowMessage and MessageDlg are both modal windows, which means that your application is basically suspended while they're displayed.
You can design your own replacement dialog that has a timer on it. In the FormShow event, enable the timer, and in the FormClose event disable it. In the OnTimer event, disable the timer and then close the form itself.
You can hook up the Screen.OnActiveFormChange event and use Screen.ActiveCustomForm if it is a interested form that you want to hook up the timer to close it
{code}
procedure abz.ActiveFormChange(Sender: TObject);
var
Timer: TTimer;
begin
if (Screen.ActiveCutomForm <> nil) and //valid form
(Screen.ActiveCutomForm.Tag = 0) and //not attached a timer yet
(Screen.ActiveCutomForm.ClassName = 'TMessageForm') //any interested form type check
then
begin
Timer := TTimer.Create(Screen.ActiveCutomForm); // let the form owned so it will be freed
Timer.Enabled := False;
Timer.Tag := Integer(Screen.ActiveCutomForm); // keep track to be used in timer event
.... setup any timer interval + event
Screen.ActiveCutomForm.Tag := Integer(Timer);
Timer.Enabled := True;
end;
end;
{code}
enjoy
Best way is to use a stayontop form and manage a counter to disappear using the alfpha blend property of the form, at the end of the count just close the form, but
the control will be passed to the active control needed before showing the form, this way, user will have a message which disappears automatically and wont prevent the usage of the next feature, very cool trick for me.
You can do this with WTSSendMessage.
You can find this in the JWA libraries, or call it yourself.
This question already has answers here:
Closed 12 years ago.
Possible Duplicate:
How can I handle a keyboard shortcut when my program isn't active?
hello guys
i need to make a delphi program that creates a short cut key that works outside the delphi app. for example: when i press ctrl+1 it pastes a certain text. When i press ctrl+2, another text, and so on. It really helps my work. I managed to make a delphi application that does that, but it only works inside that app. i want it to work in all windows applications as long as my app is open ( and minimized). Can anyone help me out? I'm pretty new at delphi, i'm trying to learn.
I tried this code which someone recommended to me but it doesn't work. it does nothing. what did i do wrong?
unit Unit3;
interface
uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, Clipbrd;
type
TForm17 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
HotKey1 : Integer;
HotKey2 : Integer;
procedure WMHotKey(var Msg: TWMHotKey); message WM_HOTKEY;
public
{ Public declarations }
end;
var
Form17: TForm17;
implementation
{$R *.dfm}
{ TForm17 }
procedure TForm17.FormCreate(Sender: TObject);
const
MOD_CONTROL = $0002;//0x0002
begin
// Register Ctrl + 1 hotkey
HotKey1 := GlobalAddAtom('Hotkey1');
RegisterHotKey(Handle, HotKey1, MOD_CONTROL, Ord('1'));
// Register Ctrl + 2 hotkey
HotKey2 := GlobalAddAtom('Hotkey2');
RegisterHotKey(Handle, HotKey2, MOD_CONTROL, Ord('2'));
end;
procedure TForm17.FormDestroy(Sender: TObject);
begin
//unregister the hotkeys
UnRegisterHotKey(Handle, HotKey1);
GlobalDeleteAtom(HotKey1);
UnRegisterHotKey(Handle, HotKey2);
GlobalDeleteAtom(HotKey2);
end;
procedure TForm17.WMHotKey(var Msg: TWMHotKey);
begin
if Msg.HotKey = HotKey1 then
begin
ShowMessage('Ctrl + 1 was pressed');
Clipboard.AsText := 'This is my own text!';
end
else
if Msg.HotKey = HotKey2 then
begin
ShowMessage('Ctrl + 2 was pressed');
Clipboard.AsText := 'This is my own text!';
end;
end;
end.
You need to use RegisterHotKey and UnregisterHotKey from the Win32 API, they are very straightforward to use.
Also, you may find useful ShortCutToKey(), which returns the key code and shift state of a Delphi shortcut.
PS: Don't forget to check the return value of RegisterHotKey(), since it will fail if the hotkey is already registered by other application.
Edit: sorry, I though that you were using another WM_MESSAGE, since first you posted the code as plain text and I only scanned through it...
I think that the problem with your code is that your are using GlobalAddAtom for the ID key, but you only need to use an unique ID inside your app (the docs for the function say that you need to use GlobalAddAtom only for a shared DLL). Try using just this:
const
ID_HOTKEY1=0;
ID_HOTKEY2=1;
procedure TYourForm.FormCreate(Sender: TObject);
begin
if not RegisterHotKey(Handle,ID_HOTKEY1,MOD_CONTROL,Ord('1'))
then Application.MessageBox('Error registering hot key 1','Error',MB_ICONERROR);
if not RegisterHotKey(Handle,ID_HOTKEY2,MOD_CONTROL,Ord('2'))
then Application.MessageBox('Error registering hot key 2','Error',MB_ICONERROR);
end;
procedure TYourForm.FormDestroy(Sender: TObject);
begin
UnregisterHotKey(Handle,ID_HOTKEY1);
UnregisterHotKey(Handle,ID_HOTKEY2);
end;
procedure TYourForm.WMHotKey(var Msg: TWMHotKey);
begin
Application.MessageBox(PChar(IntToStr(Msg.HotKey)),'Hotkey ID',MB_OK);
end;
Also, the MOD_CONTROL and related constants are already defined by Delphi, you don't need to redefine them.
andrei, check this sample code to paste a text in a external application using a hotkey.
the code show two options
1) sending the Ctrl+V combination to the focused window
2) sending a WM_PASTE message
function GetFocusedHandle: THandle;
var
ActiveHWND : THandle;
FocusedThread : DWORD;
begin
Result:=0;
ActiveHWND := GetForegroundWindow;
FocusedThread := GetWindowThreadProcessID(ActiveHWND, nil) ;
try
if AttachThreadInput(GetCurrentThreadID, FocusedThread, true) then
Result := GetFocus;
finally
AttachThreadInput(GetCurrentThreadID, FocusedThread, false) ;
end;
end;
procedure TForm17.WMHotKey(var Msg: TWMHotKey);
var
FocusWindowHwnd : THandle;
begin
if Msg.HotKey = HotKey1 then //option 1
begin
Clipboard.AsText := 'Text from Ctrl + 1 Hotkey';//Assign the text to the clipboard
//send the Ctrl + V combination to the current focused window
keybd_event(VK_CONTROL, 0, 0, 0);
keybd_event(Ord('V'), 0, 0, 0);
end
else
if Msg.HotKey = HotKey2 then //option 2
begin
FocusWindowHwnd:=GetFocusedHandle; //get the handle to the focused window
if FocusWindowHwnd<>0 then
begin
Clipboard.AsText := 'Text from Ctrl + 2 Hotkey';//Assign the text to the clipboard
SendMessage(FocusWindowHwnd,WM_PASTE,0,0);//send the WM_PASTE message
end;
end;
end;