So, here is the discussion I have just read:
http://www.mail-archive.com/delphi#delphi.org.nz/msg02315.html
BeginUpdate and EndUpdate is not thi procedures I need ...
Overriding API Call? I tried to get Update procedures code from ComCtrls unit, nut did not found...
Maybe you could post here a code to fix thi flicker of statusbar compoent if the only text changes in it? I mean - something like TextUpdate or some kind of TCanvas method or PanelsRepaint ... ?
The flickering is caused by this code:
Repeat
BlockRead(Fp, BuffArrayDebug[LineIndex], DataCapac, TestByteBuff); // DataCapac = SizeOf(DWORD)
ProgressBar1.StepIt;
if RAWFastMode.Checked then begin // checks for fast mode and modifyies progressbar
if BuffArrayDebug[LineIndex] = 0 then begin ProgressBar2.Max := FileSize(Fp) - DataCapac; ProgressBar2.Position := (LineIndex + 1) * DataCapac; LineDecr := True; end;
end else begin ProgressBar2.Max := FileSize(Fp); ProgressBar2.Position := LineIndex * DataCapac end;
if PreviewOpn.Caption = '<' then begin // starts data copying to preview area if expanded
Memo1.Lines.BeginUpdate;
if (LineIndex mod DataCapac) > 0 then HexMerge := HexMerge + ByteToHex(BuffArrayDebug[LineIndex]) else
begin
Memo1.Lines.Add(HexMerge); HexMerge := '';
end;
Memo1.Lines.EndUpdate;
end;
StatusBar1.Panels[0].Text := 'Line: ' + Format('%.7d',[LineIndex]) + ' | Data: ' + Format('%.3d',[BuffArrayDebug[LineIndex]]) + ' | Time: ' + TimeToStr(Time - TimeVarStart); StatusBar1.Update;
if FindCMDLineSwitch(ParamStr(1)) then begin
TrayIcon.BalloonTitle := 'Processing ' + ExtractFileName(RAWOpenDialog.FileName) + ' and reading ...';
TrayIcon.BalloonHint := 'Current Line: ' + inttostr(LineIndex) + #10#13 + ' Byte Data: ' + inttostr(TestByteBuff) + #10#13 + ' Hex Data: ' + ByteToHex(TestByteBuff);
TrayIcon.ShowBalloonHint;
end;
Inc(LineIndex);
Until EOF(Fp);
Any ideas?
There was comment with this link ( http://www.stevetrefethen.com/blog/UsingTheWSEXCOMPOSITEWindowStyleToEliminateFlickerOnWindowsXP.aspx ) and there is procedure that works ( no flickering whastsoever ), BUT IT IS VVVVVVVEEEEEERRRRRRYYYYYY SLOW!
1 type
2 TMyForm = class(TForm)
3 protected
4 procedure CreateParams(var Params: TCreateParams); override;
5 end;
6
7 ...
8
9 procedure TMyForm.CreateParams(var Params: TCreateParams);
10 begin
11 inherited;
12 // This only works on Windows XP and above
13 if CheckWin32Version(5, 1) then
14 Params.ExStyle := Params.ExStyle or WS_EX_COMPOSITED;
15 end;
16
Also - the target is not the form, but the StatusBar ... how to assign this method to statusbar?
The most important advise I can give you is to limit the number of status bar updates to maybe 10 or 20 per seconds. More will just cause unnecessary flicker, without any benefit for the user - they can't process the information that fast anyway.
OK, with that out of the way: If you want to use the WS_EX_COMPOSITED extended style for the status bar you have basically three options:
Create a descendent class that overrides the CreateParams() method and either install this into your IDE or (if you don't want to have it as its own component in the IDE) create the status bar at runtime.
Create a descendent class with the same name TStatusBar in another unit, override the CreateParams() method, and add this unit after ComCtrls to the form units using status bar controls. This will create an instance of your own TStatusBar class instead of the one in ComCtrls. See this answer for another example of the technique, hopefully its clear enough.
Use the vanilla TStatusBar class and set the WS_EX_COMPOSITED extended style at runtime.
I prefer the third option as the easiest one to experiment with, so here's the sample code:
procedure TForm1.FormCreate(Sender: TObject);
var
SBHandle: HWND;
begin
// This only works on Windows XP and above
if CheckWin32Version(5, 1) then begin
// NOTE: the following call will create all necessary window handles
SBHandle := StatusBar1.Handle;
SetWindowLong(SBHandle, GWL_EXSTYLE,
GetWindowLong(SBHandle, GWL_EXSTYLE) or WS_EX_COMPOSITED);
end;
end;
Edit:
If you want your code to properly support recent Windows versions and visual styles you should not even think of handling WM_ERASEBKGND yourself - the usual technique involves an empty handler for that method, and drawing the background in the WM_PAINT handler. This doesn't really work for standard controls like TStatusBar, as the background has to be drawn somewhere. If you just skip the background drawing in the WM_ERASEBKGND handler you will need to use owner-drawn panels spanning all of the status bar, otherwise the background simply won't be drawn, and the window underneath will shine through. Besides, the code for the owner-drawn panel would probably be very complex.
Again, a much better course of action would be to untangle the mess in your posted code, properly separate worker from display code, and reduce the update speed of your status bar texts to something reasonable. There just isn't any sense at all in going past the number of monitor updates per second, and even this is sensible only for games and similar visualizations.
You should check whether setting the TWinControl.DoubleBuffered property to True of the TStatusBar component will make it work. Also you can try enabling this property to the status bar's parent component (probably TForm). It's a blind shot - don't have access to the compiler from here. Another thought is to override the WM_ERASEBKGND message without calling inherited. First example found after using google: here.
----- Update after author's comment
I finally got access to the compiler and now it's working. We can use the WS_EX_COMPOSITED solution. All you need is is to create your own custom component basing on TCustomStatusBar or just create a class wrapper and create your status bar instance in runtime. Like this:
TMyStatusBar = class( TCustomStatusBar )
protected
{ Flickering work-around }
procedure CreateParams( var Params : TCreateParams ) ; override ;
end ;
TForm1 = class( TForm )
// (...)
private
FStatusBar : TMyStatusBar ;
// (...)
end ;
-------------
procedure TMyStatusBar.CreateParams( var Params : TCreateParams ) ;
begin
inherited ;
if CheckWin32Version( 5,1 ) then
Params.ExStyle := Params.ExStyle or WS_EX_COMPOSITED ;
end ;
-------------
{ Creating component in runtime }
procedure TForm1.FormCreate( Sender : TObject ) ;
begin
FStatusBar := TMyStatusBar.Create( Self ) ;
FStatusBar.Parent := Self ;
FStatusBar.Panels.Add ;
end ;
And it works for me. Good luck!
Related
I have a form and then I have a 'TPageControl' object (named 'MyPages') and a 'TButton' object (named 'MyButton') placed on it at design time.
Then I have a new class called 'TTab' which extends 'TTabSheet'. 'TTab' class has a 'TButton' object as one of its member variables like below.
class TTab = class(TTabSheet)
private
m_btnCloseTab: TButton;
end;
When I click on the 'MyButton', it would create a new 'TTab' object, init the tab (like instantiating the 'm_btnCloseTab') and add it to 'MyPages' at run time.
Procedure TForm1.MyButtonClick(Sender:TObject);
var
newTab: TTab;
newCaption: AnsiString;
begin
newCaption:= 'Tab' + IntToStr(count); //count is a global var
inc(count);
newTab:= TTab.Create(nil);
newTab.Init(newCaption);
newTab.Parent(MyPages);
end;
This is what the TTab.Init(newCaption: AnsiString) Procedure looks like.
Procedure TTab.Init(newCaption: AnsiString);
begin
Self.Caption:= newCaption;
m_btnCloseTab:= TButton.Create(nil);
with m_btnCloseTab do begin
Parent:= Self;
Left:= 10;
Top:= 10;
Caption:= 'Close Tab';
Visible:= True;
OnClick:= #closeTab;
end;
end;
That adds a new tab alright. The close button is also shown on each tab.
How do I click on the 'm_btnCloseTab' on each tab to close that particular tab?
If I define a destructor (by overriding the destructor of the TTabSheet) for TTab like below, I can call it from outside.
Destructor TTab.Destroy;
begin
if m_btnCloseTab <> nil then begin
m_btnCloseTab.Destroy;
m_btnCloseTab:= nil;
end;
inherited;
end;
But I cannot call the Destructor from inside the tab (well, you can). If I do it, I cannot free the m_btnCloseTab object as it would give an exception, because we are still its event handler. If I don't free it, the tab gets closed fine, but the memory gets leaked (because we did not free m_btnCloseTab).
I believe I have to trigger an event so that the destructor can be called from the outside of 'TTab'. I don't know how to do it.
Any help would be appreciated.
Thanks.
You can find Notification methods all over the LCL sources (and in Delphi as well, of course). A simple example is a TLabeledEdit: this is some kind of "TEdit" which contains a TLabel. If the Label is destroyed the LabeledEdit is notified of this because it must set the reference to the label to nil. Otherwise the destructor of TLabeledEdit would attempt to destroy the label again - BOOM. Here the method is like this (pasted from ExtCtrls):
procedure TCustomLabeledEdit.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (AComponent = FEditLabel) and (Operation = opRemove) then
FEditLabel := nil;
end;
And here you can see what you have to do in your case:
procedure TTab.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (AComponent = m_BtnCloseTab) and (Operation = opRemove) then
m_BtnCloseTab := nil;
end;
Please note that Notification is a virtual method and must be declared with the attribute "override" in the protected section of the component.
I would use a single button for this task.
Take m_btnCloseTab declaration out of TTab and put it in private main form.
Then on your main form's FormCreate:
m_btnCloseTab := TButton.Create( MyPages );
(the above assumes MyPages is a component placed on the form, if not it must be created first.)
Give the button a top and left that makes sense for your TTab's.
Now m_btnCloseTab will be freed when MyPages is freed which is freed when the form is closed.
Now all you have to do is create your new tabs as you like and when one is focused simply make that tab the parent of your button. You could do this, for instance, in the MyPages OnChange method or whatever it has like that.
When the button is clicked it does something like TTab( Parent ).Free;
However, you may need to store Parent in a local variable in the button's OnClick, say:
TempTab: TTab
Then simply set TempTab := TTab( Parent ), set Button's Parent to nil, then call TempTab.Free;
I would also give your Tabs an owner. That way if the user closes the form with tabs still open (that is, your button hasn't been clicked) the owner will free them.
So declare your tabs like:
newTab:= TTab.Create( MyPages );
This should solve all your problems and, after a bit of fiddling, is quite easy to manage.
One final recommendation I would use the method .Free and/or FreeAndNil( ) rather than calling .destroy directly.
I use windows UI Automation framework to access controls in other processes. I catch the system SETFOCUS messages and check the type of the focused control if it is an edit control or not. This sometimes works perfectly, but sometimes I won't get the focused control from setfocus message but only a handle to an upper control in the tree, for example a handle to a pane. What am I doing wrong?
I tried to find out which child element of the pane currently got keyboard focus by checking the UIA_HasKeyboardFocusPropertyId of the enabled child elements, but all of them will return false.
Below is the code which checks the keyboard focus property.
Additionally, for some reason I am not able to use the Automation Element Property Identifiers. They should be listed here: https://msdn.microsoft.com/en-us/library/windows/desktop/ee684017(v=vs.85).aspx
I got the values from archive.org, because the content is no longer available.
In the code, "i" is the type of the currenty focused control which got the windows setfocus message.
if (i = 50033) then // 50033 (pane)
begin
uiAuto.CreatePropertyCondition(30010, true, cond); // 30010 (enabled property)
if cond <> nil then
begin
focusedElement.FindAll(TreeScope_Children, cond, children);
if children <> nil then
begin
children.Get_Length(length);
if length > 0 then
begin
Memo1.Lines.Add('length: ' + IntToStr(length));
for j := 0 to length-1 do
begin
children.GetElement(j, tempChildElement);
tempChildElement.Get_CurrentControlType(k);
Memo1.Lines.Add('child element type: ' + IntToStr(k));
tempChildElement.GetCurrentPropertyValue(30008, keybFocusBool); // 30008 (UIA_HasKeyboardFocusPropertyId)
if keybFocusBool then
Memo1.Lines.Add('child has keyboard focus: TRUE');
keybFocusbool := false;
end;
end;
end;
end;
end;
I try to display formatted text on the screen. At first the very simple HTML text is parsed (there are tags like b,u,i) and then each character is rendered using Canvas.TextOut function in appropriate position and font.
The first thing I noticed is, that rendering of every separate character on the canvas is rather slow. The rendering of whole sentence is much faster. It is obvious, when the canvas is forced to repaint, when form is moved around the screen.
One solution would be to cluster the characters with even fonts and render them at once. But it won't help too much, when the formatting is rich. In addition I need the characters to be the discrete entities, which could be rendered in any way. For example, there is no WinAPI to support text alignment taJustify or in block writing...
Another approach is to render on bitmap, or to use wisely ClipRect property of TCanvas (I haven't tried yet).
Anyway, when the same formatted text is displayed in TRichEdit, there is no time penalty by repaint operation. Another quick example are all major browsers, which has no problem to display tons of formated text... do they render each character like I do, but they do it more efficiently ??? I do not know.
So do you know some recipe to speeding up the application (formatted text rendering?).
Thanx for your ideas...
Sample code: (make TForm as big as possible, grab it with mouse and drag it down under screen. When you move it up, you will see "jumpy" movement)
procedure TForm1.FormPaint(Sender: TObject);
var i, w, h, j:integer;
s:string;
switch:Boolean;
begin
w:=0;
h:=0;
s:='';
for j:=0 to 5 do
for i:=65 to 90 do s:=s + Char(i);
switch:=False; // set true to see the difference
if switch then
begin
for j:=0 to 70 do begin
for i := 1 to Length(s) do
begin
Form1.Canvas.TextOut(50+ w,h +70 , s[i]);
w:=w + Form1.Canvas.TextWidth(s[i]);
end;
w:=0;
h:=h+15;
end;
end
else
begin
for j:=0 to 70 do begin
Form1.Canvas.TextOut(50+ w,h +70 , s);
w:=w + Form1.Canvas.TextWidth(s); // not optimalized just for comparison
w:=0; // not optimalized just for comparison
h:=h+15;
end;
end;
end;
Use a profiler, such as AQTime, to find where your code is actually spending its time. Chances are that it will not be TextOut() itself that is taking the most time. You are indexing through a String one character at a time, passing each character to TextOut() and TextWidth(). Neither of those methods accept Char parameters as input, they only take String input instead, so the RTL is spending effort allocating and freeing a lot of temporary Strings in memory, depending on how long your source String is. I've seen things like that kill loop performance.
To avoid flicker, have best performance and still have all advanced text rendering features (like kerning), the answer is using a temporary bitmap.
Drawing text is very fast in Windows, but displaying a pre-computed bitmap will be much faster.
You can divide your layout to render only the shown part of the text. Or try to split your text into "boxes" of text (just like the great TeX engine does), using a cache for the width of each box. But Windows itself does such caching, so only use such technique if you find a real bottleneck, via proper profiling of the whole code.
Do not reinvent the wheel. On real content, you will find out that text rendering is much more complex than imagined, e.g. if you mix languages and layouts (Arabic and English for instance). You should better rely on Windows, e.g. its UniScribe API, for such complex work. When we made our open source pdf engine, we re-used it as much as possible.
For instance, FireMonkey suffers from reinventing the wheel, and fails when rendering complex text content. So using existing APIs is IMHO the best path...
On my pc, it's about twice as fast when you render to a bitmap, and then draw that to the canvas. Well, the slow version becomes twice as fast. The fast version stays the same.
Another optimization that might work.
You can also pre-calculate character widths into an array, so you don't have to call canvas.TextWidth() often.
Keep a variable like this
widths:array[char] of byte;
Fill it like this:
for c := low(widths) to high(widths) do
widths[c] := Canvas.TextWidth(char(c));
Filling this 65536 element array is slow, so perhaps it's better to just create a 65..90 element-array, and drop unicode-support.
Another thing..
Calling Winapi.Windows.TextOut() is faster than canvas.TextOut().
You can actually win a lot with that.
Winapi.Windows.TextOut(bmp.Canvas.Handle, w, h, #s[i], 1);
Modified version of your code:
// set up of off-screen bitmap.. needs to be resized when the form resizes.
procedure TForm1.FormCreate(Sender: TObject);
begin
bmp := TBitmap.Create;
bmp.SetSize(width,height);
end;
This is
procedure TForm36.PaintIt2;
var h,i,j,w: Integer; s: string;
begin
w := 0; h := 0; s := '';
for j := 0 to 5 do
for i := 65 to 90 do
s := s + Char(i);
bmp.Canvas.Brush.Color := Color;
bmp.Canvas.FillRect(bmp.Canvas.ClipRect);
if Checkbox1.Checked then
begin
for j := 0 to 70 do
begin
for i := 1 to Length(s) do
begin
Winapi.Windows.TextOut(bmp.Canvas.Handle, w, h, #s[i], 1);
w := w + widths[s[i]];
end;
w := 0; h := h + 15;
end;
end
else
for j := 0 to 70 do
begin
bmp.Canvas.TextOut(w, h, s);
w := 0; h := h + 15;
end;
canvas.Draw(0,0,bmp);
end;
I timed the performance with this procedure:
procedure TForm1.Button2Click(Sender: TObject);
var i : Integer; const iterations=300;
begin
with TStopwatch.StartNew do
begin
for I := 1 to iterations do
PaintIt2;
Caption := IntToStr(Elapsed.Ticks div iterations);
end;
end;
Last note:
I've tried disabling cleartype/anti-aliasing, but strangely enough that makes rendering twice as slow! This is how I turned anti-aliasing off:
tagLOGFONT: TLogFont;
GetObject(
bmp.Canvas.Font.Handle,
SizeOf(TLogFont),
#tagLOGFONT);
tagLOGFONT.lfQuality := NONANTIALIASED_QUALITY;
bmp.Canvas.Font.Handle := CreateFontIndirect(tagLOGFONT);
I've tried googling around abit but I cannot find any help in using the badge feature of dock-icons on OSX aswell as getting access to the dock icon menu? I guess I could change the dock icon during run to indicate something is up but it isn't as sleek ;)
This feature isn't implemented in LCL, so if you want to use it, you will have to use the relevant Cocoa framework directly. You can use ObjPas for that. Of course if you are up for writing an LCL implementation, that would be a better long term solution, as it could be made to work on Windows/Gnome later.
Ludicrous late ... but I bumped into this post, and found this post in the Lazarus Forum, which shows code how you can change the application icon in the dock while the application is running.
Hope it will be of use for someone looking for an answer to the same question, even though it's years after the post of the original question. (apologies if this is not appropriate)
uses
... MacOSAll ...
procedure TFrm_Main.FormCreate(Sender: TObject);
begin
...
FResPath := TrimFilename(ExtractFilePath(Application.ExeName) + PathDelim + 'Resource');
...
end;
procedure TFrm_Main.SomeEventWhenOverlay(SomeVar: Integer);
var
temp_ImagePath: String;
temp_CGDataProvider: CGDataProviderRef;
temp_Float32Ptr: Float32Ptr;
temp_CGImage: CGImageRef;
temp_CGContext: CGContextRef;
begin
temp_ImagePath := TrimFilename(FResPath + PathDelim + 'Image' + PathDelim + 'overlay_image.png'); // image must be same size as icon, if not, will be deformed
if (FileExists(temp_ImagePath)) then
begin
temp_CGDataProvider := CGDataProviderCreateWithFilename(PChar(temp_ImagePath));
temp_Float32Ptr := nil;
temp_CGImage := CGImageCreateWithPNGDataProvider(temp_CGDataProvider, temp_Float32Ptr, 1, kCGRenderingIntentDefault);
CGDataProviderRelease(temp_CGDataProvider);
// Draw image
temp_CGContext := BeginCGContextForApplicationDockTile;
//SetApplicationDockTileImage(temp_CGImage);
OverlayApplicationDockTileImage(temp_CGImage);
CGImageRelease(temp_CGImage);
EndCGContextForApplicationDockTile(temp_CGContext);
end;
end;
procedure TFrm_Main.SomeOtherEventWhenRestore();
begin
//This will not work if you use SetApplicationDockTileImage
RestoreApplicationDockTileImage;
end;
I am a student, and I'm working on a little slots game (if the same random number comes up 3 timed, you win). I use Borland Pascal 7. I use graph to make this a bit more visual, but when I start the game my background turns from black to grey, and the other problem is that if I click the game start button, the game runs many times until I release the mouse button. How can I solve this?
Here is my full program:
program slots;
uses mymouse,graph,crt;
var gdriver,gmode,coin:integer;
m:mouserec;
a,b,c,coins:string;
procedure gomb(x1,y1,x2,y2:integer;szoveg:string);
var j,n:integer;
begin
setcolor(blue);
rectangle(x1,y1,x2,y2);
setfillstyle(1,blue);
floodfill(x1+2,y1+2,blue);
setcolor(0);
outtextxy((x1+x2)div 2 -textwidth(szoveg) div 2 ,(y1+y2) div 2-textheight(szoveg) div 2,szoveg);
end;
procedure randomal(var a,b,c:string);
begin
randomize;
STR(random(2)+1,a);
STR(random(2)+1,b);
STR(random(2)+1,c);
end;
procedure menu;
begin;
settextstyle(0,0,1);
outtextxy(20,10,'Meno menu');
gomb(20,20,90,50,'Teglalap');
gomb(20,60,90,90,'Inditas');
gomb(20,100,90,130,'Harmadik');
gomb(20,140,90,170,'Negyedik');
end;
procedure teglalap(x1,x2,y1,y2,tinta:integer);
begin
setcolor(tinta);
rectangle(x1,x2,y1,y2);
end;
procedure jatek(var a,b,c:string;var coin:integer;coins:string);
begin;
clrscr;
menu;
randomal(a,b,c);
if ((a=b) AND (b=c)) then coin:=coin+1 else coin:=coin-1;
settextstyle(0,0,3);
setbkcolor(black);
outtextxy(200,20,a);
outtextxy(240,20,b);
outtextxy(280,20,c);
STR(coin,coins);
outtextxy(400,400,coins);
end;
procedure eger;
begin;
mouseinit;
mouseon;
menu;
repeat
getmouse(m);
if (m.left) and (m.x>20) ANd (m.x<90) and (m.y>20) and (m.y<50) then teglalap(90,90,300,300,blue);
if (m.left) and (m.x>20) AND (m.x<90) and (m.y>60) and (m.y<90) then jatek(a,b,c,coin,coins);
until ((m.left) and (m.x>20) ANd (m.x<140) and (m.y>140) and (m.y<170));
end;
begin
coin:=50;
gdriver:=detect;
initgraph(gdriver, gmode, '');
eger;
end.
I have many years to use Turbo Pascal :)
I used this snippet to init BGI (graphic) mode:
Gd := Detect;
InitGraph(Gd, Gm, 'bgi');
if GraphResult <> grOk then
Halt(1);
SetBkColor(black);
Cleardevice;
If I recall correctly, ClearDevice is proper for clearing the screen, ClrScr is for text mode.
Now, GetMouse(m); probably returns immediately the mouse data thus the code
in the repeat loop runs again and again with no delay, even if you don't use the mouse.
One solution is to check if the mouse button is up before you execute that code or
add some kind of delay before calling the GetMouse.