I'm trying to draw a simple image with OnPaint method. The code compiles just fine, but when the application starts, it shows "Object lock not owned" error and nothing else happens. Could you please tell me what mistake I made? The code shows the OnPaint event I'm using. Thank you all for your help.
procedure TTabbedForm.Image1Paint(Sender: TObject; Canvas: TCanvas;
const ARect: TRectF);
var
p1, p2, p3, p4, p5, p6: TPointF;
prst1: TRectF;
i :Integer;
begin
Image1.Bitmap.Canvas.Stroke.Color := TAlphaColors.Black;
Image1.Bitmap.Canvas.Stroke.Thickness := 3;
p1 := TPointF.Create(PX, PY);
Image1.Bitmap.Canvas.BeginScene;
with TabbedForm do begin
for i := 0 to 360 do
if (i mod 15)=0 then
begin
p2 := TPointF.Create(Round(PX+PP*sin(i*pi/180)), Round(PY+PP*cos(i*pi/180)));
Image1.Bitmap.Canvas.DrawLine(p1, p2, 100);
end;
for i := 0 to PP do
if (i mod 20)=0 then
begin
prst1 := TRectF.Create(PX+i,PY+i,PX-i,PY-i);
Image1.Bitmap.Canvas.DrawEllipse(prst1, 100);
end;
for i := 0 to 400 do
if (i mod 20)=0 then
begin
p3 := TPointF.Create(i,2*PP);
p4 := TPointF.Create(i,2*PP+2*PP);
Image1.Bitmap.Canvas.DrawLine(p3, p4, 100);
end;
for i := 0 to 400 do
if (i mod 20)=0 then
begin
p5 := TPointF.Create(0,2*PP+i);
p6 := TPointF.Create(2*PP+2*PP,2*PP+i);
Image1.Bitmap.Canvas.DrawLine(p5, p6, 100);
end;
Image1.Bitmap.Canvas.EndScene;
end;
end;
The error message "Object lock not owned" is the message of EMonitorLockException, which is documented to be raised "whenever a thread tries to release the lock on a non-owned monitor". Since you have not responded to my request for an MCVE, and I have not been able to reproduce this error, I can not confirm whether it is due to an unsuccessful lock aquisition through Canvas.BeginScene, or something else.
You can use either a TImage or a TPaintBox for your drawing. Using a TImage provides many benefits such as directly loading an image file, drawing on that image and saving your image to a file directly in various formats, like .bmp, .jpg or .png (maybe others too). A TPaintBox is more lightweight and doesnt have an own bitmap, but uses the parent components surface to draw on (therefore the need for an OnPaint() handler). Loading from / saving to file must be done e.g. through a separate TBitmap.
So yes, you may continue to use a TImage control if you want, but in that case, do not use the OnPaint event for the drawing as you are now. A TImage has a built in mechanism to paint itself when needed. You only need to draw your drawing once to the built-in bitmap canvas. In the following code the image is drawn in a ButtonClick() event. Also note, that with the TImage you must use BeginScene - EndScene correctly as documented.
You must also set the TImage.Bitmap.Size before drawing on it. If this was not set elsewhere in your code of what you have shown, then that may be another reason why your code produced no image.
Draw your image on Image1.Bitmap.Canvas e.g. in a OnClick() event of a button:
procedure TTabbedForm.Button1Click(Sender: TObject);
var
p1, p2, p3, p4, p5, p6: TPointF;
prst1: TRectF;
i: integer;
begin
Image1.Bitmap.SetSize(300, 300); // must be set before call to BeginScene
if Image1.Bitmap.Canvas.BeginScene then
try
Image1.Bitmap.Canvas.Stroke.Color := TAlphaColors.Black;
Image1.Bitmap.Canvas.Stroke.Thickness := 1;
p1 := TPointF.Create(px, py);
for i := 0 to 360 do
if (i mod 15) = 0 then
begin
pp := i;
p2 := TPointF.Create(Round(px + pp * sin(i * pi / 180)),
Round(py + pp * cos(i * pi / 180)));
Image1.Bitmap.Canvas.DrawLine(p1, p2, 100);
end;
for i := 0 to pp do
...
for i := 0 to 400 do
...
for i := 0 to 400 do
....
finally
Image1.Bitmap.Canvas.EndScene;
end;
end;
I think you get this error message, because you're drawing on the canvas at a time when you're not allowed to. Potential causes for this are:
You're drawing on the bitmap of the image from the paint event of the image. Images are for displaying pre-generated or loaded bitmaps, and since modifying the bitmap should trigger the OnPaint event, I think it's a bad idea to make those changes from that same event. It's asking for an endless loop, or other unwanted side effects.
You're using BeginScene/EndScene incorrectly. You should only proceed drawing if BeginScene returns true. And actually it's not needed to call them at all when drawing on the given canvas of a paint event.
You're (partially) using a global instance of the form instead of the current instance (Self), which could (depending on your application), lead to drawing on the wrong instance.
Small disclaimer: I left your code as-is as much as possible, just changed the things that I think could potentially cause your problem. I think these changes all make sense, but I must admit I've never done much painting in FMX, so maybe some of these are a bit naive or over-protective (or blatantly wrong).
Things that are different in this code compared to yours:
Use a TPaintbox (you'll have to add a TPaintbox named 'Paintbox1', and add this method to it's OnPaint handler). Paintboxes are for direct drawing. You could also keep the image, if you would be able to pre-render the image's bitmap on specific events, like the start of your application, a click of a button, a timer, and so on.
Correct use of BeginScene and EndScene, with an if and a try..finally block. BeginScene will give you a lock or not, and return a boolean depending on the success. You should only proceed if you actually acquired the lock, and only call EndScene in that case too, because they are ref counted, and doing this wrong could screw up the refcount, and therefor all further painting in your application.
Stroke settings inside the scene as well. Not 100% sure if needed, but I guess it's part of drawing the scene too, right?
Left out BeginScene..EndScene completely. The Paintbox or Image control should already have called that itself. See FMX.Graphics.TCanvas.BeginScene docs
Just use Canvas. It's passed as a parameter to the event handler, so better to use that, then to try and find the right canvas yourself.
Removed the with. This is a bit of a long shot, but it looked like you were referring to a global TTabbedForm variable, and since you are inside a TTabbedForm method, you should be able to use the properties and methods of the current instance as-is, or prepend with Self. if you run into naming conflicts. It's always better to not rely on those globals for forms and datamodules, and you'll actually run into problems if you want to have multiple instances of your form, in which case your original code would partially operate on the wrong instance.
procedure TTabbedForm.Paintbox1Paint(
Sender: TObject; Canvas: TCanvas; const ARect: TRectF);
var
p1, p2, p3, p4, p5, p6: TPointF;
prst1: TRectF;
i :Integer;
begin
p1 := TPointF.Create(PX, PY);
Canvas.Stroke.Color := TAlphaColors.Black;
Canvas.Stroke.Thickness := 3;
for i := 0 to 360 do
if (i mod 15)=0 then
begin
p2 := TPointF.Create(Round(PX+PP*sin(i*pi/180)), Round(PY+PP*cos(i*pi/180)));
Canvas.DrawLine(p1, p2, 100);
end;
for i := 0 to PP do
if (i mod 20)=0 then
begin
prst1 := TRectF.Create(PX+i,PY+i,PX-i,PY-i);
Canvas.DrawEllipse(prst1, 100);
end;
for i := 0 to 400 do
if (i mod 20)=0 then
begin
p3 := TPointF.Create(i,2*PP);
p4 := TPointF.Create(i,2*PP+2*PP);
Canvas.DrawLine(p3, p4, 100);
end;
for i := 0 to 400 do
if (i mod 20)=0 then
begin
p5 := TPointF.Create(0,2*PP+i);
p6 := TPointF.Create(2*PP+2*PP,2*PP+i);
Canvas.DrawLine(p5, p6, 100);
end;
end;
Related
Been reading some Documentation for Indy some few weeks back. Using Indy i have been able to implement client and server program for simple programs hence i wanted to test myself for a VNC program like teamviewer, started out using Indy and i did like the topic well than using Raw winsock , Indy did help me, but I do have one issue i want to trade out.
I am coding something like my own teamviewer which requires client and server now i want to get the screenshot from the server and send to client
on client side i do something that Looks like this to connect
procedure TForm1.FormCreate(Sender: TObject);
begin
IdTCPServer1:=TIdTCPServer.Create(nil);
IdTCPServer1.DefaultPort:=50000;
IdTCPServer1.OnExecute:=IdTCPServer1Execute;
IdTCPServer1.Active:=true;
end;
Now the onExecute would look like this to grab the screenshot and send vis Indy (Winsock)
procedure TForm1.IdTCPServer1Execute(AContext: TIdContext);
var
mem_dc : HDC;
bmp : TBitmap;
_bm : BITMAP;
w, h : Integer;
dimensions : Integer;
begin
bmp := TBitmap.Create;
GetObject (bm, sizeof (BITMAP), #_bm);
w := _bm.bmWidth;
h := _bm.bmHeight;
bmp.Height := h;
bmp.Width := w;
mem_dc := CreateCompatibleDC (bmp.Canvas.Handle);
SelectObject (mem_dc, bm);
BitBlt (bmp.Canvas.Handle,0, 0, w, h, mem_dc, 0, 0, SRCCOPY);
Canvas.Draw (0, 0, bmp);
DeleteObject (mem_dc);
bmp.Free;
//Send Dimensions vis Indy here
dimensions := w * h / 4;
while True do
begin
AContext.Connection.IOHandler.WriteLn(dimensions);
// and do same for Pixels
end;
end.
Since i am new to something like this, do i just get the width and height and send or do i have to send them separately with something like this :
procedure TForm1.IdTCPServer1Execute(AContext: TIdContext);
var
mem_dc : HDC;
bmp : TBitmap;
_bm : BITMAP;
w, h : Integer;
begin
bmp := TBitmap.Create;
GetObject (bm, sizeof (BITMAP), #_bm);
w := _bm.bmWidth;
h := _bm.bmHeight;
bmp.Height := h;
bmp.Width := w;
mem_dc := CreateCompatibleDC (bmp.Canvas.Handle);
SelectObject (mem_dc, bm);
BitBlt (bmp.Canvas.Handle,0, 0, w, h, mem_dc, 0, 0, SRCCOPY);
Canvas.Draw (0, 0, bmp);
DeleteObject (mem_dc);
bmp.Free;
//Send Dimensions vis Indy here
dimensions := w * h;
while True do
begin
AContext.Connection.IOHandler.WriteLn(w);
AContext.Connection.IOHandler.WriteLn(h);
// Then add the same for Pixels
end;
end.
There are lots of different ways to do this, so it's not possible to say exactly what you should do. For example if you look at the HTTP protocol it sends headers and data, the headers describe the data that is following. So the headers would say either how much data there is, or possibly how to determine how much data there is (like a chunked encoding). Other protocols (OSI X25 for example) send information in defined message with binary coded headers.
Designing a communications protocol can be challenging and also rewarding.
I would suggest you consider how many different types of data you want to send in each direction. Then consider that in the future you may want to send more.
You may want to have an application communicate with multiple clients at the same time, so think about how you identify each 'session' to the other side. For each message received you want to be able to determine what the data is first, then process it. You could use a text based header (easier to debug) like HTTP, or you could go for a defined structure with predefined values transferred as binary data (more compact).
I would typically expect that each message received would have a header containing:
Session ID (allowing one program to service multiple connections)
Data Type
Data-Type dependent information (variable number of data items according to the type)
Content Length
This would be followed by the content. You can keep the content and the headers in one message, and try to keep the messages fairly short.
You may find it easier to break up the screenshot into defined parts. This also means that if you compare the current screenshot to the last one you would only need to send changes to the screen layout. So when you send a part you need to give both the size of the part you are sending and its position.
Once you have something basic working you can extend it in all sorts of ways if you have designed a flexible protocol for the information exchange.
Follwing on:
How to load large bitmap in FMX (fire monkey)
I have come to a need to draw whats on TBitmapSurface on the FMX.Graphics.TBitmap, i have found a lot of answer regarding this on the web, but they are either in VLC instead of FMX or their goal is saving and loading instead of drawing on a TBitmap, which is why i asked a new question here.
Now here is my current code for loading my image on the TBitmapSurface :
var
bitmapSurf: TBitmapSurface;
path: string;
begin
path := 'image.jpg';
bitmapSurf := TBitmapSurface.Create;
TBitmapCodecManager.LoadFromFile(path, bitmapSurf);
end;
Now after searching for a bit i found that i can use Scanline on the TBitmapSurface, but i didn't know how to use it to draw on the TBitmap, on the web some people had used TBitmap.canvas.draw, but such a thing doesn't exist on the FMX!.
In the end my goal is to draw a very large image (1000*16000) which is loaded in the TBitmapSurface on more then 1 TBitmap (because TBitmap doesn't support more then 8192px and my height is 16000px, i need to draw this on two TBitmap).
I am using Delphi 10.2.3.
Thanks.
You can split the large image (from a file) to two TImage components as follows
Load the image from file to a TBitmapSurface as you already do in your code.
Then create another TBitmapSurface and set its size to the half of the large one. Copy the first half of the large image to this surface and assign it to Image1.Bitmap. Then copy the latter half to this surface and assign that to Image2.Bitmap.
var
srce, dest: TBitmapSurface;
path: string;
scan: integer;
w, h1, h2: integer;
begin
path := 'C:\tmp\Imgs\res.bmp';
srce := TBitmapSurface.Create;
try
TBitmapCodecManager.LoadFromFile(path, srce);
dest := TBitmapSurface.Create;
try
// first half
w := srce.Width;
h1 := srce.Height div 2;
dest.SetSize(w, h1, TPixelFormat.RGBA);
for scan := 0 to h1-1 do
Move(srce.Scanline[scan]^, TBitmapSurface(dest).Scanline[scan]^, srce.Width * 4);
Image1.Bitmap.Assign(dest);
// second half
h2 := srce.Height - h1;
dest.SetSize(w, h2, TPixelFormat.RGBA);
for scan := h1 to srce.Height-1 do
Move(srce.Scanline[scan]^, TBitmapSurface(dest).Scanline[scan-h1]^, srce.Width * 4);
Image2.Bitmap.Assign(dest);
finally
dest.Free;
end;
finally
srce.Free;
end;
I populate ScrollBoxin the alike way:
procedure TForm1.FormCreate(Sender: TObject);
var
i: word;
begin
for i := 1 to 3 do
begin
with TLabel.Create(ScrollBox1) do
begin
Parent := ScrollBox1;
Top := 1000;
AutoSize := False;
Align := alTop;
Height := 25;
Caption := 'Label' + IntToStr(i);
end;
end;
ScrollBox1.Realign;
end;
When the code is run under Delphi I get the follwong result:
The order of items is proper.
But when I call the same code under Lazarus I get:
The order of items is reverse. I can solve the issue by reverse creation of ScrollBox children and/or adding {IFDEF ...} but I suspect this is not reliable. Adding compiler switches will double the volume of code making it bulky and difficult to read.
Is there a way to do unified reliable Delphi-Lazarus code for this purpose?
APPENDED
explanation on comment of #TomBrunberg
If I create chidren in reverse order (for instance for i := 3 downto 1) I get the opposite result: Delphi produces reverse and Lazarus - direct order. That is why I was saying about doubling of code.
APPENDED 2
on note of Tom Brunberg
When the same code is called from a Button onClick event handler the code behaviour becomes opposite (and again different in Lazarus and in Delphi).
APPENDED 3
Can I trust for i := 1 to 3... Top := 1000 + i; as it gives the expected result?
I want to read the entire table from an MS Access file and I'm trying to do it as fast as possible. When testing a big sample I found that the loop counter increases faster when it's reading the top records comparing to last records of the table. Here's a sample code that demonstrates this:
procedure TForm1.Button1Click(Sender: TObject);
const
MaxRecords = 40000;
Step = 5000;
var
I, J: Integer;
Table: TADOTable;
T: Cardinal;
Ts: TCardinalDynArray;
begin
Table := TADOTable.Create(nil);
Table.ConnectionString :=
'Provider=Microsoft.ACE.OLEDB.12.0;'+
'Data Source=BigMDB.accdb;'+
'Mode=Read|Share Deny Read|Share Deny Write;'+
'Persist Security Info=False';
Table.TableName := 'Table1';
Table.Open;
J := 0;
SetLength(Ts, MaxRecords div Step);
T := GetTickCount;
for I := 1 to MaxRecords do
begin
Table.Next;
if ((I mod Step) = 0) then
begin
T := GetTickCount - T;
Ts[J] := T;
Inc(J);
T := GetTickCount;
end;
end;
Table.Free;
// Chart1.SeriesList[0].Clear;
// for I := 0 to Length(Ts) - 1 do
// begin
// Chart1.SeriesList[0].Add(Ts[I]/1000, Format(
// 'Records: %s %d-%d %s Duration:%f s',
// [#13, I * Step, (I + 1)*Step, #13, Ts[I]/1000]));
// end;
end;
And the result on my PC:
The table has two string fields, one double and one integer. It has no primary key nor index field. Why does it happen and how can I prevent it?
I can reproduce your results using an AdoQuery with an MS Sql Server dataset of similar size to yours.
However, after doing a bit of line-profiling, I think I've found the answer to this, and it's slightly counter-intuitive. I'm sure everyone who does
DB programming in Delphi is used to the idea that looping through a dataset tends to be much quicker if you surround the loop by calls to Disable/EnableControls. But who would bother to do that if there are no db-aware controls attached to the dataset?
Well, it turns out that in your situation, even though there are no DB-aware controls, the speed increases hugely if you use Disable/EnableControls regardless.
The reason is that TCustomADODataSet.InternalGetRecord in AdoDB.Pas contains this:
if ControlsDisabled then
RecordNumber := -2 else
RecordNumber := Recordset.AbsolutePosition;
and according to my line profiler, the while not AdoQuery1.Eof do AdoQuery1.Next loop spends 98.8% of its time executing the assignment
RecordNumber := Recordset.AbsolutePosition;
! The calculation of Recordset.AbsolutePosition is hidden, of course, on the "wrong side" of the Recordset interface, but the fact that the time to call it apparently increases the further you go into the recordset makes it reasonable imo to speculate that it's calculated by counting from the start of the recordset's data.
Of course, ControlsDisabled returns true if DisableControls has been called and not undone by a call to EnableControls. So, retest with the loop surrounded by Disable/EnableControls and hopefully you'll get a similar result to mine. It looks like you were right that the slowdown isn't related to memory allocations.
Using the following code:
procedure TForm1.btnLoopClick(Sender: TObject);
var
I: Integer;
T: Integer;
Step : Integer;
begin
Memo1.Lines.BeginUpdate;
I := 0;
Step := 4000;
if cbDisableControls.Checked then
AdoQuery1.DisableControls;
T := GetTickCount;
{.$define UseRecordSet}
{$ifdef UseRecordSet}
while not AdoQuery1.Recordset.Eof do begin
AdoQuery1.Recordset.MoveNext;
Inc(I);
if I mod Step = 0 then begin
T := GetTickCount - T;
Memo1.Lines.Add(IntToStr(I) + ':' + IntToStr(T));
T := GetTickCount;
end;
end;
{$else}
while not AdoQuery1.Eof do begin
AdoQuery1.Next;
Inc(I);
if I mod Step = 0 then begin
T := GetTickCount - T;
Memo1.Lines.Add(IntToStr(I) + ':' + IntToStr(T));
T := GetTickCount;
end;
end;
{$endif}
if cbDisableControls.Checked then
AdoQuery1.EnableControls;
Memo1.Lines.EndUpdate;
end;
I get the following results (with DisableControls not called except where noted):
Using CursorLocation = clUseClient
AdoQuery.Next AdoQuery.RecordSet AdoQuery.Next
.MoveNext + DisableControls
4000:157 4000:16 4000:15
8000:453 8000:16 8000:15
12000:687 12000:0 12000:32
16000:969 16000:15 16000:31
20000:1250 20000:16 20000:31
24000:1500 24000:0 24000:16
28000:1703 28000:15 28000:31
32000:1891 32000:16 32000:31
36000:2187 36000:16 36000:16
40000:2438 40000:0 40000:15
44000:2703 44000:15 44000:31
48000:3203 48000:16 48000:32
=======================================
Using CursorLocation = clUseServer
AdoQuery.Next AdoQuery.RecordSet AdoQuery.Next
.MoveNext + DisableControls
4000:1031 4000:454 4000:563
8000:1016 8000:468 8000:562
12000:1047 12000:469 12000:500
16000:1234 16000:484 16000:532
20000:1047 20000:454 20000:546
24000:1063 24000:484 24000:547
28000:984 28000:531 28000:563
32000:906 32000:485 32000:500
36000:1016 36000:531 36000:578
40000:1000 40000:547 40000:500
44000:968 44000:406 44000:562
48000:1016 48000:375 48000:547
Calling AdoQuery1.Recordset.MoveNext calls directly into the MDac/ADO layer, of
course, whereas AdoQuery1.Next involves all the overhead of the standard TDataSet
model. As Serge Kraikov said, changing the CursorLocation certainly makes a difference and doesn't exhibit the slowdown we noticed, though obviously it's significantly slower than using clUseClient and calling DisableControls. I suppose it depends on exactly what you're trying to do whether you can take advantage of the extra speed of using clUseClient with RecordSet.MoveNext.
When you open a table, ADO dataset internally creates special data structures to navigate dataset forward/backward - "dataset CURSOR". During navigation, ADO stores the list of already visited records to provide bidirectional navigation.
Seems ADO cursor code uses quadratic-time O(n2) algorithm to store this list.
But there are workaround - use server-side cursor:
Table.CursorLocation := clUseServer;
I tested your code using this fix and get linear fetch time - fetching every next chunk of records takes the same time as previous.
PS Some other data access libraries provides special "unidirectional" datasets - this datasets can traverse only forward and don't even store already traversed records - you get constant memory consumption and linear fetch time.
DAO is native to Access and (IMHO) is typically faster.
Whether or not you switch, use the GetRows method. Both DAO and ADO support it.
There is no looping. You can dump the entire recordset into an array with a couple of lines of code. Air code:
yourrecordset.MoveLast
yourrecordset.MoveFirst
yourarray = yourrecordset.GetRows(yourrecordset.RecordCount)
I am working with Delphi. I am using bmp.ScanLine[] in my code. My code is as follows :
bmp := TBitmap.Create;
bmp.Height := imgMain.Height;
bmp.Width := imgMain.Width;
for i := 0 to imgMain.Height - 1 do begin
prgb := bmp.ScanLine[i];
p1 := imgMain.ScanLine[i];
for j := 0 to imgMain.Width - 1 do begin
//Some code
end;
end;
Here, imgMain is of TBitmap type. My problem is when I execute this code, it takes too much time on the lines
prgb := bmp.ScanLine[i];
p1 := imgMain.ScanLine[i];
Please, tell me where I am wrong?
Hmm, something can be gained (introducing rowpitch, see below) but that is not too much. Probably changing the for loop to a while loop that does pointer increment and compares with a pointer value of the last pixel
// from memory, might need an additional typecast here or there.
// will typically be negative
scanline0:=imga.scanline[0];
rowpitchimga:=integer(imga.scanline[1])-integer(scanline0); // bytes to jump row.
prgb1 :=scanline0;
for i:=0 to imgmain.height-1;
begin
prgbend:=prgb1;
inc(prgbend,width); // if prgbend, it will be with sizeof(prgb1^)
while(prgb1<prbend) do // smaller then, since prgb1[] is 0 based.
begin
// do your thing
inc(prgb1);
end;
prgb1:=prgbend;
inc(pointer(prgb1),rowpitch-width*sizeof(prgb1^)); // skip alignmentbytes
inc(pointer(prgbend),rowpitch);
end;
See also rotating bitmaps. In code for a routine that does things like this to rotate an image fast.
Allocating bmps all the time can be expensive too, specially if they are large, use pools to avoid repeated allocation.