I still dont quite understand how to implement multi-threading with TThreads - delphi

For this question please refer to a previous question I asked a while back: Do I need TThreads? If so can I pause, resume and stop them? LU RD answered the question with a provided demo and some comments.
I stopped using Delphi for quite a long time but now I am getting back into it and redoing a project. This project has time consuming operations such as opening a Gif, extracting the frames and then adding those frames (bitmaps) into a TImageList and TListView. This time I actually add the bitmaps directly into a TObjectList, as seen here: How to add and retrieve Bitmaps to and from a TList?
Typically nothing special needs doing here to speed it up as most Gif animations are small, but with medium to large Gifs the application can hang. This is going to get worse though as those bitmaps are going to be modified at runtime using various imaging filters such as grayscale, change hue etc. So I am sure I need multi-threading for this otherwise accessing each bitmap and then manipulating is going to be very slow (as I found out before).
So with that said, I am foolishly trying to adapt (without a clue of what I am doing) some of my procedures to work with the TThread example posted by LU RD I linked to at the top.
I wish I spent a bit more time with the original question to ask for more information but I guess I got sidetracked and moved onto something else, which meant I learned nothing.
Take this snippet from the threading example:
const
cWorkLoopMax = 500;
function TForm1.HeavyWork: boolean; // True when ready
var
i, j: integer;
begin
j := 0;
for i := 0 to 10000000 do
Inc(j);
Inc(workLoopIx);
Result := (workLoopIx >= cWorkLoopMax);
end;
For a start I have no idea what cWorkLoopMax is for, and why its value is set to 500?
Secondly I guess the HeavyWork procedure is just a sample, which runs in a loop a 10000000 times whilst incrementing the j variable?
Then we have the workLoopIx which I am unsure what is for? Maybe something to do with the position within the thread maybe?
So, here I have my current code (no threading) which handles opening the Gif and adding to the TListView and TImageList. The procedures I use are in another unit, if needed I will post it also, but this is what I use inside a TAction (actOpen):
if OpenPictureDialog.Execute then
begin
Screen.Cursor := crHourGlass;
try
BitmapCollection.AddFromGif(OpenPictureDialog.FileName, ImageList1);
ListView1.Items.BeginUpdate;
try
ListView1.Items.Clear;
for I := 0 to BitmapCollection.BitmapList.Count - 1 do
begin
with ListView1.Items.Add do
begin
Caption := 'bitmap' + IntToStr(I+1);
ImageIndex := I;
end;
end;
finally
ListView1.Items.EndUpdate;
end;
finally
Screen.Cursor := crDefault;
end;
end;
What I dont understand is how to put that into a thread procedure, such as HeavyWork? I just created a new one called Job_Open and did this:
procedure TForm1.actOpenExecute(Sender: TObject);
begin
if OpenPictureDialog.Execute then
begin
if not Assigned(MyThread) then
begin
workLoopIx := 0;
btnStartTask.Enabled := false;
btnPauseResume.Enabled := true;
btnCancelTask.Enabled := true;
MyThread := TWorkerThread.Create(Self.Handle, WM_MyProgress, Job_Open);
end;
end;
end;
function TForm1.Job_Open: boolean;
var
I: Integer;
begin
BitmapCollection.AddFromGif(OpenPictureDialog.FileName, ImageList1);
for I := 0 to BitmapCollection.BitmapList.Count - 1 do
begin
with ListView1.Items.Add do
begin
Caption := 'bitmap' + IntToStr(I+1);
ImageIndex := I;
end;
Inc(workLoopIx);
end;
Result := (workLoopIx >= BitmapCollection.BitmapList.Count);// cWorkLoopMax);
end;
This is clearly not right, the performance is slower and I am getting all kind of errors such as Invalid Handle.
I would be extremely grateful if someone could take some time to explain my comments, what I am doing wrong and what I should be doing instead, updated code and comments in source are welcome but I am hoping to learn a bit more of what is going on with the code ideally.
In a perfect world if there is a library of sorts that exists out there that is easy to use then that would be a massive help if I cannot understand what is happening above. Is there such a library that can do something like:
procedure DoSomething;
begin
BeginThreading();
HeavyWork;
StopThreading();
end;
Thanks in advance, and apologies for the lengthy post.

DISCLAIMER: While my answer is not an answer directly to your question it is a psobile solution to your problem.
After reading your questions I have one question to you:
Are you applying same image graphical effects on all ImageList images?
If you are then I must say that you started on working on your problem from wrong approach.
First you need to know that Imagelist doesen't store all those images seperately but that it is storing them all in same verry wide image. So when you read any ImageList image internally ImageList creates output bitmap and then uses Canvas.CopyRect which is quite. When you save image to image list it internally uses Canvas.Draw.
So when you do this many times you create lots of unnecessary data movment.
So instead of your approach where you work on seperate images I recomend you work on ImageLists internal image whose handle you can get using ImageList.GetImageBitmap. This will alow you to apply same graphical effect on all ImageList images at once. And if you don't need to apply graphical effects to all ImageList images I bet you can modify your mage processing method to work only on parts of the image.
In order to learn more about ImageList I recomed you read its documentation:
Image list explanation: http://docwiki.embarcadero.com/Libraries/XE6/en/Vcl.Controls.TImageList
Image list GetImageBitmap explanation
http://docwiki.embarcadero.com/Libraries/XE6/en/Vcl.ImgList.TCustomImageList.GetImageBitmap

Related

How can I remove a PCB Object in Altium PCB Library using Altium scripting systems?

I am writing a Delphi Altium script to remove all tracks in TopOverLay inside the PCB Library.
When running the script though, nothing happens (the tracks are not removed).
I don't know why. Can you please help me?
Here below is my code :
procedure RemoveTrackObject;
Var
MyComponent : IPCB_LibComponent;
MyTrack : IPCB_Track;
Iterator : IPCB_GroupIterator;
DeleteList : TInterfaceList;
TrackTemp : IPCB_Track;
i : Integer;
begin
MyComponent := PCBServer.GetCurrentPCBLibrary.CurrentComponent;
//////////////////////////////////////////////////////////////////////
Iterator := MyComponent.GroupIterator_Create;
Iterator.AddFilter_ObjectSet(Mkset(eTrackObject));
Iterator.AddFilter_LayerSet(Mkset(eTopOverLay));
DeleteList := TInterfaceList.Create;
try
MyTrack := Iterator.FirstPCBObject;
While MyTrack <> nil do
begin
DeleteList.Add(MyTrack);
MyTrack := Iterator.NextPCBObject;
end;
finally
MyComponent.GroupIterator_Destroy(Iterator);
end;
try
PCBServer.PreProcess;
for i := 0 to DeleteList.Count - 1 do
begin
TrackTemp := DeleteList.Items[i];
MyComponent.RemovePCBObject(TrackTemp);
end;
finally
PCBServer.PostProcess;
DeleteList.Free;
end;
Client.SendMessage('PCB:Zoom', 'Action=Redraw' , 255, Client.CurrentView);
end;
AFAIU In Altium dephiscript API InterfaceList have specific uses: holding non-PCB objects & passing to external dll functions & letting the receiving fn destroy the list.
You don't really need one here.
The PcbLib does have some strange behaviour around deleting from selected/focused footprint etc.
I think the problem is caused by the Pcb Editor not allowing objects to be deleted from the current focused component/footprint.
The history around this issue points to solutions involving moving focus away from the required component..
You can't complete the delete process while the List still contains the object reference.
Use a While loop, after RemovePCBObject(), remove object ref from the List (remove the List Item). Then when the While loop terminates you have zero items in List.
Might help refresh or look & feel to use some of these fn calls:
CurrentLib.Board.GraphicallyInvalidate;
CurrentLib.Navigate_FirstComponent;
CurrentLib.Board.ViewManager_FullUpdate;
CurrentLib.Board.GraphicalView_ZoomRedraw;
CurrentLib.RefreshView;

Delphi - How to add multiple JPG images to a TCanvas and print them

As a Delphi programmer I'm a bit of a hack - learned bits and pieces along the way, mostly self taught.
I'm working on a program for fun that's a database for an out of print card game. Has info of the cards and links to a JPG of the card image.
Was talking to someone about it and they said "Wouldn't it be cool if you could render multiple card images on a page at 2.5 x 3.5 inches and print them".
Legal issues aside (I won't be distributing this without express permission from the former publisher), I wanted to see if it could be done as an exercise to teach me how to use TCanvas. Unfortunately I've really got no idea how to do this.
I'm working with an 8.5 x 11 inch page, so I'd want a 2.3 x 3.5 card image which gives me about an inch to play with that's not taken up by card images, so like 0.25 inches page margins all around and .25 inches between each image. This would put 9 cards on the page.
For what I have written in my program so far, I can drop a TImage on a form and read the associated jpg file for any given card from disk and show it on the form.
Assume I have built a deck of these cards and want to print the images of my "deck". How do I then take that associated image for each card, resize it so that it would fit into a 2.5 x 3.5 space on a canvas and then continue loading images until I've got 9 on the page. Then I'd want to move to a new page and do it again until I've printed the cards in my deck (usually around 50 of them - so about 6 pages).
I've been doing some searching and I'm not sure how to deal with these aspects
Resize the JPG once read
Position it on the canvas - and get 9 images total there
The current images are (for the most part) 390 x 546 pixels. (which is the correct ratio for 2.5 x 3.5 inches).
Also, in order to try to preserve ink & paper, is there a way to "preview" the canvas before you send it to the printer (a print preview if you will), or is it just a huge trial and error thing until you get it right.
While specific code example would be preferred, I'm willing to do some legwork if I could even get a pointer to a website that showed how to work with these objects.
About 15 years ago I mucked around with putting Text onto a TCanvas and printing it, but I'm not sure how to make this work with a JPG after reading from disk and then resizing it to print to the scale I want here.
Anyone able to offer some pointers for me here ?
Oh if it matters, I'm working with Delphi XE3 Enterprise / Windows 10.
Thanks.
There is some rude way to make it work.
First of all, I see at least two ways to make it:
load all images into array or ObjectList (that is better I suppose) and then make transofrmations and draw them on canvas;
load, transform and draw image one by one;
Which of them the better one? I don't know. I'd prefer second because it will take less RAM I suppose.
uses ...,jpeg, SysUtils, Graphics;
...
const CARD_WIDTH:integer = /*your card width*/;
const CARD_HEIGHT:integer = /*your card height*/;
const MARGIN_X:integer = 0; //you can change it if you want to
const MARGIN_Y:integer = 0; //you can change it if you want to
...
//Load images. You can call it from button's OnClick event;
function LoadImages(aWidth, aHeight:integer):TBitmap;
var i:integer;
lImage:TJpegImage;
lResizedBmp:TBitmap;
lPosX,lPosY:integer; //it can be TPoint as well
begin
result := TBitmap.Create;
lPosX := MARGIN_X;
lPosY := MARGIN_Y;
try
result.Width := aWidth;
result.Height := aHeight;
//I don't know how you will get filenames, so I'll make some dummy code
for i := 0 to 10 do
begin
lImage := TJpegImage.Create;
lResizedBmp := nil;
try
lImage.LoadFromFile('C:\' + inttostr(i) + '.jpg'); //it's bad code just to demonstrate the way we load file. I don't remember if "i.toString()" is acceptable in XE3.
lResizedBmp := ResizeJpeg(lImage, CARD_WIDTH, CARD_HEIGHT);
result.Canvas.Draw(lPosX, lPosY, lResizedBmp);
//let's calculate next card position
lPosX := lPosX + CARD_WIDTH + MARGIN_X;
if (lPosX + CARD_WIDTH + MARGIN_X > aWidth) then
begin
lPosX := MARGIN_X;
lPosY := lPosY + MARGIN_Y + CARD_HEIGHT;
end;
finally
FreeAndNil(lImage);
if assigned(lResizedBmp) then
FreeAndNil(lResizedBmp)
end;
end;
except
on (e:Exception) do
begin
FreeAndNil(result);
raise e;
end;
end;
end;
//Resize image and convert it into Bitmap
function ResizeJpeg(aJpg:TJpegImage; aWidth, aHeight:integer):TBitmap;
var lProxyBmp:TBitmap;
begin
result := TBitmap.Create;
try
result.Width := aWidth;
result.Height := aHeight;
lProxyBmp := TBitmap.Create;
try
lProxyBmp.Assign(aJpg);
result.Canvas.StretchDraw(result.Canvas.ClipRect, lProxyBmp);
finally
FreeAndNil(lProxyBmp);
end;
except
on e:Exception do
begin
FreeAndNil(result);
raise e;
end;
end;
end;
So, you have all procedures to make your page. Just make Form, place TImage and two buttons on in. Set TImage's Stretched and Proportional properties to true. Set buttons' captions to Load and Print. Don't forget to add unit with procedures to uses or make them as Form's methods. Add private field _bmp:TBitmap to your Form;
For Load button:
//Page preview.
procedure TForm1.Button1Click(Sender:TObject)
begin
if assigned(_bmp) then
FreeAndnIl(_bmp);
_bmp := LoadImages(2000,3000);
Image1.Picture.Assign(_bmp);
end;
For Print button:
procedure TForm1.Button2Click(Sender:TObject)
begin
if not assigned(_bmp) then
begin
ShowMessage('Click "Load" first');
Exit;
end;
with TPrintDialog.Create(nil) do
try
if not Execute then
Exit;
finally
Free;
end;
Printer.BeginDoc;
try
Printer.Canvas.Draw(0,0,_bmp);
finally
Printer.EndDoc;
end;
end;
After I checked this code on Delphi 10.1 using PDF printer I got my pdf file.
I've tried to make it as simple as possible, but there is plenty of code. I could miss something, but I'm ready to help. All constants can be made as variables and passed as function's params, it's up to you.

Is globalalloc with GMEM_MOVEABLE dangerous for local variables in Delphi?

Our programming dept just spent about a non-mythical man-month tracking down what we think is a bug in a 3rd party component, here's their copyrighted source code:
function TGDIPPicture.GetImageSizes: boolean;
var
multi: TGPImage;
pstm: IStream;
hGlobal: THandle;
pcbWrite: Longint;
begin
result := false;
if Empty then
Exit;
if FDataStream.Size = 0 then
Exit;
hGlobal := GlobalAlloc(GMEM_MOVEABLE, FDataStream.Size);
if (hGlobal = 0) then
raise Exception.Create('Could not allocate memory for image');
try
pstm := nil;
// Create IStream* from global memory
CreateStreamOnHGlobal(hGlobal, TRUE, pstm);
pstm.Write(FDataStream.Memory, FDataStream.Size,#pcbWrite);
multi := TGPImage.Create(pstm);
FWidth := multi.GetWidth;
FHeight := multi.GetHeight;
Result := true;
multi.Free;
finally
GlobalFree(hGlobal);
end;
end;
We found the problem was with TMS's AdvOfficeTabSet. If we added tabs, then it crashed, if we didn't add tabs then it didn't crash. (the crash was one of those un-debuggable app hangs that hits you 10 steps after the real problem).
Following Raymond Chen's advice I replaced GMEM_MOVEABLE with GPTR and it appears to have fixed the problem.
I'm wondering if anyone can tell me if the above code had any legitimate reason for using GMEM_MOVEABLE. AFAIK it's only for the clipboard and it should always be used with GlobalAlloc.
while I was typing this another programmer got an error in the GlobalFree function using my code. So, apparently this doesn't work either. Could really use some help here!
*CreateStreamOnHGlobal is a Windows API function. (which apparently prefers GMEM_MOVEABLE)
*TGPImage is part of TMS's implementation of the GDI+ library.
Jonathan has identified the obvious problem, that being the double free of the HGLOBAL. But as you have found, the use is GMEM_MOVEABLE is correct.
Frankly, the code seems needlessly complex. I suggest you use the built in stream adapter and avoid any GlobalAlloc. To get an IStream you just need to do this:
pstm := TStreamAdapter.Create(FDataStream);
That's it.

Determine when an Excel workbook has closed with Delphi

The following code opens the document specified by the 'app' parameter and then waits until the particular document has been closed. This works fine for all document types, except when you have an Excel workbook open and open another Excel workbook. The code thinks the document has closed when it is actually still open. How would I solve this?
procedure RunAppAndWAit( a: TApplication; app, par, verb: string);
var
seinfo: tshellexecuteinfo;
exitcode: dword;
begin
fillchar( seinfo, sizeof( seinfo), 0);
seinfo.cbsize := sizeof( tshellexecuteinfo);
with seinfo do
begin
fmask := see_mask_nocloseprocess;
wnd := a.Handle;
lpfile := pchar( app);
lpDirectory := pchar( ExtractFileDir( app));
lpParameters := pchar( par);
lpVerb := pchar( verb);
nshow := sw_shownormal;
end;
if ShellExecuteEx( #seinfo) then
begin
repeat
a.ProcessMessages;
GetExitCodeProcess( seinfo.hprocess, exitcode);
until ( exitcode <> still_active) or a.terminated;
end
else
sshowmessage( 'Unable to open ' + app);
end;
Your attempt only works for applications that open the document in the same process which launches the document.
A lot of applications don't work this way any more: the process launching the document will pass the document to another process that shows/edits it, and the launching process dies.
You will need to find an API that supports event callbacks (in this case for Excel, most likely the COM API that Excel exposes) that lets you watch more closely what Excel actually does with your document.
Open your document using this API, register an event that gets called when the document is closed, wait for the event, then close.
This isn't pretty and may not be as reliable as you wish, but you could loop (or better, use a timer event?) calling the Windows EnumWindows function looking for title bars that match what you'd expect Excel to show for this file. (Obviously, this is an Excel-specific solution.)
For example, look for a title bar that contains the word "Excel" and your file name, which is what Excel shows in the title bar.
There may be holes in this approach that make it fragile. In fact, I'm a bit hesitant to post this since I don't think the solution is particularly robust. However, if you have no other way to solve your problem, this might work...
Google "EnumWindows Delphi" for sample code.
... on further thought,below is another way. As Jeroen noted, you could use an API to Excel. If you're doing a lot of these calls, then put the CreateOLEObject and unAssigned assignment outside the function might make it less heavy. (And you'll need some try...except blocks in case Excel is no longer running, etc.) This solution, too, is Excel-specific and clumsy, IMO. I don't know if there might be circumstances (like a File, Dialog box open in Excel?) that would cause this to return erroneous result.
So, basically, I'm saying, here are two relatively weak approaches that are specific to Excel and may not always work. (When I say it that way, I'd almost rather just delete this entire post... But, maybe it'll give you some ideas on how you want to proceed.)
This code is not tested, but similar code has worked for me in the past:
uses ComObj;
function FindWorkbook( Workbookname: String):boolean;
var
ExcelOLE: Variant;
WorkbookNumber: Integer;
begin
Result := FALSE;
ExcelOLE := CreateOLEObject('Excel.Application');
try
for WorkbookNumber := 1 to ExcelOLE.Workbooks.Count do
if UpperCase(WorkbookName) = UpperCase(ExcelOLE.Workbooks[WorkbookNumber].Name) then
Result := TRUE;
finally
ExcelOLE := unAssigned;
end;
end;

Delphi Twain issue help

Using the DelphiTwain files from http://delphitwain.sourceforge.net/ and am getting some weird behavior.
After each scan a little more memory is being held onto.
After an hour or so of repetitive scans, the image scanned is zoomed in approxamately 10 times, and just the upper-left square inch is stored.
Has anyone had similar issues, or have some suggestions?
Code below...
try
try
Twain := TDelphiTwain.Create(self);
Twain.OnTwainAcquire := TwainAcquireHandler; //manually set the event handler
Twain.OnSourceFileTransfer := TwainSourceFileTransfer;
Twain.OnSourceSetupFileXfer := TwainSourceSetupFileXfer;
Twain.LoadLibrary;
Twain.LoadSourceManager;
Twain.Source[0].Loaded := TRUE;
Twain.Source[0].TransferMode := ttmFile;
Twain.Source[0].EnableSource(false, false);
except on e : exception do
showmessage('Error loading Scanner.');
end;
try
while Twain.Source[0].Enabled do
Application.ProcessMessages;
except on e : exception do
showmessage('Error Scanning Packing List.');
end;
finally
Twain.Source[0].Loaded := FALSE;
Twain.UnloadSourceManager(true);
Twain.UnloadLibrary;
Twain.Destroy;
end;
Since the TDelphiTwain appears to be a component you are creating in code, I would recommend passing in nil for the constructor and calling the .Free method or (as suggested by Joseph) FreeAndNil.
Twain := TDelphiTwain.Create(nil);
try
try
Twain.OnTwainAcquire := TwainAcquireHandler; //manually set the event handler
Twain.OnSourceFileTransfer := TwainSourceFileTransfer;
Twain.OnSourceSetupFileXfer := TwainSourceSetupFileXfer;
Twain.LoadLibrary();
Twain.LoadSourceManager();
Twain.Source[0].Loaded := True;
Twain.Source[0].TransferMode := ttmFile;
Twain.Source[0].EnableSource(False, False);
except on e : exception do
showmessage('Error loading Scanner.');
end;
try
while Twain.Source[0].Enabled do
Application.ProcessMessages;
except on e : exception do
showmessage('Error Scanning Packing List.');
end;
Twain.Source[0].Loaded := False;
Twain.UnloadSourceManager(True);
Twain.UnloadLibrary();
finally
FreeAndNil(Twain);
end;
I would also recommend better exception handling, but not related to question you asked. The only thing users will see and report to you (or worse, the quiet guy in the corner responsible for your IT support who loves to get non-descriptive errors from users) is 'Error doing something'
Good luck
Another area to look at is if the scanner supports WIA (Windows Image Acquisition)
var
DevMgr: IDeviceManager;
Scanner: Idevice;
Picture: IItem;
Image: OleVariant;
AImage: IImageFile;
begin
DevMgr := CreateOleObject('WIA.DeviceManager') as IDeviceManager;
// Figure out which device is the scanner
Scanner:= DevMgr.DeviceInfos.Item[1].Connect;
//Command: Figure out which command scans..
Picture := Scanner.ExecuteCommand(Scanner.Commands.Item[1].CommandID);
//Transfer as JPG
Image := Picture.Transfer(Picture.Formats.Item[1]);
//Save the image
AImage := IImageFile(Image);
AImage.SaveFile('c:\wia_viaScanner\image.' + AImage.FileExtension);
end;
More info on the WIA library can be found here..
http://msdn.microsoft.com/en-us/library/ms629859(VS.85).aspx
Examining the code within these calls may be fruitful:
TwainAcquireHandler;
TwainSourceFileTransfer;
TwainSourceSetupFileXfer;
Do any of those create any objects without freeing them?
If you are using Delphi 2006 or higher, then you can add this line to your .DPR file:
ReportMemoryLeaksOnShutdown := True;
Then reproduce the memory leak, close your app... and it will describe the leaks in detail. A little more info about this can be found here.
On another note, I'd suggest replacing
Twain.Destroy;
with
FreeAndNil(Twain);
.Destroy will call the destructor directly, while FreeAndNil is a safer alternative that will also prevent the "Twain" variable from pointing anywhere dangerous. (See the accepted answer to this question).
I can't address the problem you're reporting but you have a busy loop there that will gobble CPU time.
What are you doing when you get the Image, did you keep in memory?
Or the library can have some memory leaks, you can check if it is true with FastMM4.
to KevinRF:
I need to use WIA automation in Delphi 7 project. I registered WIAAut.dll in my system, import this library into Delphi and past your programm code into my project and got some errors:
Scanner:= DevMgr.DeviceInfos.Item[1].Connect;
Types of actual and formal var parameters must be identical
in "Item" must be Item[var Index: OleVariant], but "1" is integer
What's wrong, what i need to made it works?

Resources