I'm attempting to write an analog VU meter. I use a bitmap of a VU meter and draw the needle on to the bitmap. I am using a trackbar and it's onChange event to test the meter:
procedure TForm1.TrackBar1Change(Sender: TObject);
var
angle : integer;
x,y : integer;
Peaked : boolean;
begin
Angle := 120 - Round(sTrackBar1.Position / sTrackBar1.Max * 100 )+20;
Peaked := Angle < PeakVol;
if Peaked then
Buffer.Picture := VUImagePeaked.Picture
else
buffer.picture := VUImage.Picture;
buffer.Picture.Bitmap.Canvas.Pen.Color := clSilver;
buffer.Picture.Bitmap.Canvas.Pen.Width:=2;
buffer.Canvas.MoveTo(pivot.x,Pivot.y);
x := 150 + Round(Cos(DegToRad(Angle)) * NeedleLen);
y := PaintBox1.Height - Round(Sin(DegToRad(Angle)) *NeedleLen);
buffer.Canvas.LineTo(x,y);
PaintBox1.Canvas.Draw(0,0,buffer.Picture.Bitmap)
end;
Seems to work but what I can't get is to display the bitmap of the meter when the program starts. I have even resorted to copying the above code to both the Form.Create and Form.Activate event handlers but no joy. I created a button and added the following code to trigger the onChange event handler for the trackbar. This works and displays the meter.
procedure TForm1.Button1Click(Sender: TObject);
begin
TrackBar1.Position := 1;
end;
When I copied this to the Form.Activate handler it doesn't. Can anyone please tell me what I'm doing wrong? I'm using Delphi Berlin starter edition. Thanks
A TPaintBox must be painted using its OnPaint event. This event is triggered every time Windows needs you to redraw the control. You can't simply draw to the control's Canvas at any time, because it will just be drawn over the next time the control is repainted.
In your particular case, you don't need to move your entire block of code to the OnPaint event handler. Instead, all you need is:
procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
PaintBox1.Canvas.Draw(0,0,buffer.Picture.Bitmap)
end;
Related
I have a form with about 168 Timage objects containing Icons that are user selectable.
I wish to make each Icon move Down and Right by 3 pixels when the mouse is over the Timage object. I want it to return to its original position when the mouse leaves the Timage. This will add a pleasing effect to the user interface.
I know I can do this in the OnMouseEnter and OnMouseLeave events and it works well - however I cannot help but think that there must be a more elegant / efficient method to produce this effect for all 168 Timage objects, rather than creating 168 OnMouseEnter procedures and 168 OnMouseLeave procedures.
Any help much appreciated ...
It is enough to create a single OnMouseEnter event handler procedure and assign it to every component (similar for OnMouseLeave).
If these components were created in design-time (hard to imagine), then you can select all 168 images in the Form Designer, and then go to the Object Inspector and assign the events in a single go, as Remy Lebeau wrote in comments. Alternative way - use existing list of components (assuming that owner is form and there is no other TImages on the form):
for i := 0 to Components.Count - 1 do
if Components[i] is TImage then //perhaps more conditions to separate needed images
TImage(Components[i]).OnMouseEnter := EnterHandler;
If components were created in run-time and they are stored in array or list, handler assigning is simpler:
for i := 0 to Images.Length - 1 do
Images[i].OnMouseEnter := EnterHandler;
Then you can work with each component using the event's Sender argument:
procedure TMyForm.EnterHandler(Sender: TObject);
begin
TImage(Sender).Left := TImage(Sender).Left + 3;
TImage(Sender).Top := TImage(Sender).Top + 3;
end;
procedure TMyForm.LeaveHandler(Sender: TObject);
begin
TImage(Sender).Left := TImage(Sender).Left - 3;
TImage(Sender).Top := TImage(Sender).Top - 3;
end;
The cleanest solution here would be to create a custom component and to sanitize your design away from such a heavy and flat design-time layout. These naturally become difficult to maintain and to modify.
That said, if you want a quick hack to save yourself a lot of typing and clicking, you can use an interposer class to inject this mouse behaviour.
In the interface section of your Form's unit, add the following class above the Form's class declaration:
type
TImage = class(Vcl.ExtCtrls.TImage)
private
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
end;
TForm1 = class(TForm)
{ ... rest of your form as normal }
end;
And then, in the implementation section, add this:
procedure TImage.CMMouseEnter(var Message: TMessage);
begin
inherited;
Top := Top + 3;
Left := Left + 3;
end;
procedure TImage.CMMouseLeave(var Message: TMessage);
begin
inherited;
Top := Top - 3;
Left := Left - 3;
end;
Defining an interposer like this effectively causes your modified TImage class to replace all of the existing TImage components that are placed on the Form at design-time.
Note that this example is only for VCL on Windows. For a cross-platform solution using FMX, all UI controls have virtual DoMouseEnter() and DoMouseLeave() methods that you can override instead, eg:
type
TImage = class(FMX.Objects.TImage)
protected
procedure DoMouseEnter; override;
procedure DoMouseLeave; override;
end;
...
procedure TImage.DoMouseEnter;
begin
inherited;
Top := Top + 3;
Left := Left + 3;
end;
procedure TImage.DoMouseLeave;
begin
inherited;
Top := Top - 3;
Left := Left - 3;
end;
My Delphi 7 app has two TPageControls with a TSplitter between them. On each TPageControl are two TTabSheets. One each TTabSheet is a TWebBrowser. Got the picture?
The problem with this component arrangement is that it is impossible to track the location of the mouse since the TWebBrowser does not have a OnMouseMove event and the TForm's OnMouseMove event is never triggered under this pile of ClientAligned components.
What I need to know is the XY position of the mouse, relative to the app's form, at all times. IOW, I need to know when the mouse moved, and when it does, a function that would:
GetMouseLocationNow(var X, Y : Integer);
How can I do this?
To track mouse move application-wide, you have to track WM_MOUSEMOVE message. You can use TApplicationEvents component for that. So, drop TApplicationEvents on form, and process WM_MOUSEMOVE in OnMessage event. Low order word in LParam specifies X coordinate of the cursor (relative to the window that the message is posted to), and high order word Y coordinate.
procedure TfrmMain.ApplicationEventsMessage(var Msg: tagMSG; var Handled: Boolean);
var
Pt: TPoint;
begin
if Msg.message = WM_MOUSEMOVE then begin
Pt := Point(WORD(Msg.lParam), HiWord(Msg.lParam));
windows.ClientToScreen(Msg.hwnd, Pt);
windows.ScreenToClient(Handle, Pt);
MouseMoved(Pt.X, Pt.Y);
end;
end;
procedure TfrmMain.MouseMoved(const AX, AY: Integer);
begin
// do the work here
end;
We have a win control object which moves its clients to some other coordiantes. The problem is, when there are too many children - for example 500 controls - the code is really slow.
It must be because of each control being repainted each time I set Left and Top property. So, I want to tell the WinControl object stop being repainted, and after moving all objects to their new positions, it may be painted again (Something like BeginUpdate for memo and list objects). How can I do this?
Here's the code of moving the objects; it's quite simple:
for I := 0 to Length(Objects) - 1 do begin
with Objects[I].Client do begin
Left := Left + DX;
Top := Top + DY;
end;
end;
As Cosmin Prund explains, the cause for the long duration is not an effect of repainting but of VCL's realignment requisites at control movement. (If it really should take as long as it does, then you might even need to request immediate repaints).
To temporarily prevent realignment and all checks and work for anchors, align settings and Z-order, use DisableAlign and EnableAlign. And halve the count of calls to SetBounds by called it directly:
procedure TForm1.FormCreate(Sender: TObject);
var
I: Integer;
Control: TControl;
begin
for I := 0 to 499 do
begin
Control := TButton.Create(Self);
Control.SetBounds((I mod 10) * 40, (I div 10) * 20, 40, 20);
Control.Parent := Panel1;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
I: Integer;
C: TControl;
begin
// Disable Panel1 paint
SendMessage(Panel1.Handle, WM_SETREDRAW, Integer(False), 0);
Panel1.DisableAlign;
try
for I := 0 to Panel1.ControlCount - 1 do
begin
C := Panel1.Controls[I];
C.SetBounds(C.Left + 10, C.Top + 5, C.Width, C.Height);
end;
finally
Panel1.EnableAlign;
// Enable Panel1 paint
SendMessage(Panel1.Handle, WM_SETREDRAW, Integer(True), 0);
// Update client area
RedrawWindow(Panel1.Handle, nil, 0, RDW_INVALIDATE or RDW_UPDATENOW or RDW_ALLCHILDREN);
end;
end;
Your assumption that the slowness comes from re-painting controls is probably true, but not the whole story. The default Delphi code that handles moving controls would delay painting until the next WM_PAINT message is received, and that would happen when the message queue is pumped, after you complete moving all the controls. Unfortunately there are a lot of things involved in this, that default behavior can be altered in many places, including Delphi and Windows itself. I've used the following code to test what happens when you move a control at runtime:
var i: Integer;
begin
for i:=1 to 100 do
begin
Panel1.Left := Panel1.Left + 1;
Sleep(10); // Simulate slow code.
end;
end;
The behaviour depends on the control! A TControl (example: TLabel) is going to behave according to Delphi's rules, but a TWinControl depends on too many factors. A simple TPanel is not repainted until after the loop, in the case of TButton on my machine only the background is re-painted, while a TCheckBox is fully repainted. On David's machine the TButton is also fully repainted, proving this depends on many factors. In the case of TButton the most likely factor is the Windows version: I tested on Windows 8, David tested on Windows 7.
AlignControl Avalanche
Anyhow, there's an other really important factor to be taken into account. When you move a control at runtime, all the rules for alignment and anchoring for all the controls need to be taken into account. This likely causes an avalanche of AlignControls / AlignControl / UpdateAnchorRules calls. Since all those calls end up requiring recursive invocations of the same, the number of calls will be exponential (hence your observation that moving lots of objects on a TWinControl is slow).
The simplest solution is, as David suggests, placing everything on a Panel and moving the panel as one. If that's not possible, and all your controls are actually TWinControl (ie: they have a Window Handle), you could use:
BeginDeferWindowPos, DeferWindowPos, EndDeferWindowPos
I would put all the controls in a panel, and then move the panel rather than the controls. That way you perform the shift in a one single operation.
If you would rather move the controls within their container then you can use TWinControl.ScrollBy.
For what it is worth, it is more efficient to use SetBounds than to modify Left and Top in separate lines of code.
SetBounds(Left+DX, Top+DY, Width, Height);
To speed up you should set the Visible property of you WinControl to False during child movement to avoid repainting.
Together with SetBounds you will get the best from moving the child controls.
procedure TForm1.MoveControls( AWinControl : TWinControl; ADX, ADY : Integer );
var
LIdx : Integer;
begin
AWinControl.Visible := False;
try
for LIdx := 0 to Pred( AWinControl.ControlCount ) do
with AWinControl.Controls[LIdx] do
begin
SetBounds( Left + ADX, Top + ADY, Width, Height );
end;
finally
AWinControl.Visible := True;
end;
end;
BTW As David suggested, moving the parent is much faster than each child.
I have some troubles with rendering my canvas. Actually I'm trying to write game like space invaders, without using any OpenGL or DirectX. So at the background I have moving sky, and jet moving over it. But the jet is blinding, and sky moves not uniformly. Here's my code
sky := TBitmap.Create;
sky.LoadFromFile('sky.bmp');
jet := TBitmap.Create;
jet.LoadFromFile('jet.bmp');
jet.Transparent := True;
while True do
begin
for k := 0 to sky.Height do
begin
for i := -1 to (pbMain.Height div sky.Height) do
begin
for j := 0 to (pbMain.Width div sky.Width) do
begin
pbMain.Canvas.Draw(nx, ny, jet);
pbMain.Canvas.Draw(j*sky.Width, k + i*sky.Height, sky);
end;
Application.ProcessMessages;
end;
Sleep(1);
end;
end;
Thank you.
You can't write a standard Windows app like that. You have to do your painting in response to WM_PAINT messages. In Delphi terms this equates to overriding the Paint method of a TWinControl descendent, or perhaps using a TPaintBox and providing an OnPaint event handler. I'm going to assume that you use a TPaintBox.
If you need to avoid flicker it is common practice to draw to an off-screen bitmap and then show this when you are asked to paint.
Your application should probably use a timer control to provide a regular pulse. Then, on each pulse, update your off-screen bitmap. Then call Invalidate on your paint box to force a paint cycle.
The code might look like this:
procedure TMainForm.RefreshTimerTimer(Sender: TObject);
begin
RedrawOffscreenBitmap;
PaintBox.Invalidate;
end;
procedure TMainForm.RedrawOffscreenBitmap;
begin
//paint to FOffscreenBitmap
end;
procedure TMainForm.PaintBoxBox(Sender: TObject);
begin
PaintBox.Canvas.Draw(0, 0, FOffscreenBitmap);
end;
In a TImage's OnClick event, I would like to extract the x,y coordinates of the mouse. I would prefer them in relation to the image, but in relation to the form or window is just as good.
Mouse.CursorPos contains the TPoint, which in turn contains the X and Y position. This value is in global coordinates, so you can translate to your form by using the ScreenToClient routine which will translate screen coordinates to window coordinates.
According to the Delphi help file, Windows.GetCursorPos can fail, Mouse.CursorPos wraps this to raise an EOsException if it fails.
var
pt : tPoint;
begin
pt := Mouse.CursorPos;
// now have SCREEN position
Label1.Caption := 'X = '+IntToStr(pt.x)+', Y = '+IntToStr(pt.y);
pt := ScreenToClient(pt);
// now have FORM position
Label2.Caption := 'X = '+IntToStr(pt.x)+', Y = '+IntToStr(pt.y);
end;
The Mouse.CursorPos property will tell you the current position of the mouse. If the computer is running sluggishly, or if your program is slow to respond to messages, then it might not be the same as the position the mouse had when the OnClick event first occurred. To get the position of the mouse at the time the mouse button was clicked, use GetMessagePos. It reports screen coordinates; translate to client coordinates with TImage.ScreenToClient.
The alternative is to handle the OnMouseDown and OnMouseUp events yourself; their parameters include the coordinates. Remember that both events need to occur in order for a click to occur. You may also want to detect drag operations, since you probably wouldn't want to consider a drag to count as a click.
As others have said, you can use Mouse.CursorPos or the GetCursorPos function, but you can also just handle the OnMouseDown or OnMouseUp event instead of OnClick. This way you get your X and Y values as parameters to your event handler, without having to make any extra function calls.
How about this?
procedure TForm1.Button1Click(Sender: TObject);
var
MausPos: TPoint;
begin
GetCursorPos(MausPos);
label1.Caption := IntToStr(MausPos.x);
label2.Caption := IntToStr(MausPos.y);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
SetCursorPos(600, 600);
end;
Found this online somewhere once and saved it in my codesnippet DB :)
This page will probably solve all your questions however... There appear to be functions to go from client to screen coordinates and back etc..
Good luck!
To Firemonkey (FMX):
var
p: TPointF;
begin
p := Screen.MousePos;
end;