I have this code to draw on Desktop's canvas:
procedure Paint; {Pseudo code}
begin
repeat
DrawOnWindow();
sleep(100);
Application.ProcessMessages;
until;
end;
function DrawOnWindow(Handle: HWND; X, Y: Integer; BMP : TBitmap): Boolean;
{ actual code }
var
Canvas : TCanvas;
DC : HDC;
begin
Result:= FALSE;
Assert(Handle > 0); // if change is possible then
try
DC := GetDC(Handle); // the dc is freed after repainting
Canvas := TCanvas.Create;
Canvas.Handle := DC;
Canvas.Draw(x, y, bmp);
Canvas.Free;
Result := TRUE;
ReleaseDC(Handle,DC);
except
end;
end;
The drawing worked fine. But it was freezing my program and I had to use Application.ProcessMessages to 'unfreeze' it. But Application.ProcessMessages was creating its own problems.
So I moved the code in a thread. Now it works for a while (< 1 minute) then the canvas is not painted anymore (but the thread is running).
Why is this happening? Am I supposed to lock that canvas?
An alternative question (path) would be: Should I move the painting code back in the main app/thread and paint from a TTimer (or better, a high precision timer)?
Related
I'm working on a Firemonkey application in Delphi Tokyo and decided to add a loader screen that does some animation. I have a form with a list animation that is run within one thread, and then my calls to the datasnap server runs within another thread. I'm doing it like this because I couldn't get the animation to work if both calls wasn't within a thread.
Now running this on the windows version works fine. Running it on both my Huawei phone and another samsung tablet works 70% of the time. The other 30% of the time it freezes and I have to kill the app. When the datasnap load is done the loader form is supposed to be freed and closed and the main panels opacity is set to 1 and I enable the panel again. I'm not sure 100% if the app freezes and if the code is not run successfully thats supposed to enable the panel again. I was able to debug it one time while not working which produced an out of memory error, but I'm unable to recreate the issue while debugging on the phone.
The idea was that when the logging button is pressed a loader screen shows some animation while the data is retrieved and then hides it again. Am I doing something wrong in the below code?
ShowLoader;
fThread := TTask.Create
(
procedure ()
begin
try
LoDataset := fmxDataModule.ServerMethods.GetLoginDetails(edtEmail.Text, edtPassword.Text);
except on E:Exception do
begin
TThread.Synchronize(TThread.CurrentThread,
procedure()
begin
ShowMessage('The system could not log you in. Error Details: '+slinebreak+slinebreak+E.Message+slinebreak+slinebreak+'Please try again.');
HideLoader;
end
)
end;
end;
TThread.Synchronize(TThread.CurrentThread,
procedure()
begin
fmxDataModule.LoggedInUser.LoadFromDataset(LoDataset);
if fmxDataModule.LoggedInUser.CompanyID.Value > 0 then
begin
Toolbarheader.Visible := True;
lblLoginInfo.Visible := false;
lblWelcome.Text := 'Welcome ' + fmxDataModule.LoggedInUser.FirstName.Value + ', ' + fmxDataModule.LoggedInUser.LastName.Value;
GoToProfilesTab.Execute;
GenerateProfiles;
pnlButtons.Visible := True;
fLoggedIn := True;
FormResize(nil);
end else
begin
lblLoginInfo.Visible := True;
lblLoginInfo.Text := 'User does not exist, or login details invalid';
end;
end
);
HideLoader;
end
);
fThread.Start;
Here is the code for ShowLoader:
procedure TfrmLogin.CreateLoaderForm;
begin
if Assigned(fLoader) then
FreeAndNil(fLoader);
fLoader := TfrmLoader.Create(Self);
floader.Parent := Self;
fLoader.Left := Self.Left + (Self.Width div 2) - (fLoader.Width div 2);
fLoader.Top := Self.Top + (Self.Height div 2) - (fLoader.Height div 2);
fLoader.Show;
end;
procedure TfrmLogin.ShowLoader;
begin
pnlMain.Enabled := false;
pnlMain.Opacity := 0.4;
TTask.Create (
procedure ()
begin
TThread.Queue(TThread.CurrentThread,
procedure()
begin
CreateLoaderForm
end);
end
).Start;
end;
Hiding the loader:
procedure TfrmLogin.HideLoader;
begin
pnlMain.Enabled := True;
pnlMain.Opacity := 1;
// pnlMain.Repaint;
fLoader.Visible := False;
end;
Am I missing something in the code above?
Another question is why does my form not open in the middle of the screen? I've tried different things, setting the position in the form properties, and manually calculating it. It always opens up top left corner on the device, but works on windows.
After trying a different approach like #nolaspeaker suggested, and syncronising the username and passwords fields like #RemyLebeau suggested, I removed the form loader that was in a different thread, and the problem still persisted. Doing that became obvious that there must be a problem in the below piece of code I posted initially, only a bit refactored:
TThread.CreateAnonymousThread
(
procedure
var
LsUsername,LsPassword:String;
begin
try
TThread.Synchronize(TThread.CurrentThread,
procedure()
begin
LsUsername := edtEmail.Text;
LsPassword := edtPassword.Text;
end
);
LoDataset := fmxDataModule.ServerMethods.GetLoginDetails(LsUsername, LsPassword);
except on E:Exception do
begin
TThread.Synchronize(TThread.CurrentThread,
procedure()
begin
ShowMessage('The system could not log you in. Error Details: '+slinebreak+slinebreak+E.Message+slinebreak+slinebreak+'Please try again.');
HideLoader;
end
)
end;
end;
TThread.Synchronize(TThread.CurrentThread,
procedure()
begin
fmxDataModule.LoggedInUser.LoadFromDataset(LoDataset);
if fmxDataModule.LoggedInUser.CompanyID.Value > 0 then
GoToProfilesTab.Execute
else
begin
lblLoginInfo.Visible := True;
lblLoginInfo.Text := 'User does not exist, or login details invalid';
end;
end
);
HideLoader;
end
).Start;
Trying a couple more times to debug the scenario I ended up in TTabControl.SetActiveTabWithTransition.
The issue occurs on this line
LocalAnimateIntWait(Layout2, 'Position.X', Round(P.X), Duration, TAnimationType.In,
TInterpolationType.Linear);
in this block of code:
procedure TTabControl.SetActiveTabWithTransition(const ATab: TTabItem; ATransition: TTabTransition;
const ADirection: TTabTransitionDirection = TTabTransitionDirection.Normal);
...
begin
case ATransition of
TTabTransition.Slide:
begin
FTransitionRunning := True;
ClipChildren := True;
try
...
if ADirection = TTabTransitionDirection.Normal then
begin
P...
end
else
begin
...
LocalAnimateIntWait(Layout2, 'Position.X', Round(P.X), Duration, TAnimationType.In,
TInterpolationType.Linear);
end;
finally
SetLength(FTransitionTabs, 0);
ClipChildren := False;
FTransitionRunning := False;
Realign;
end;
// Force repaint
Application.ProcessMessages;
end
else
ActiveTab := ATab;
end;
end;
So I remove the tab transitioning for that one click and it finally works as expected. The moment I put the transitioning back to Slide, it freezes again on that line. I'll be sure to report this issue.
I'm trying to have an image on a custom page I can get the custom page to show or the image on a predefined page but not on the custom page.
Problem I think is with Parent := CustomPage.ID;.
Parent := WizardForm.SelectTasksPage; works though.
How to do this properly?
procedure ImageOnClick(Sender: TObject);
var
ErrorCode: Integer;
begin
ShellExec('', 'http://test.com', '', '', SW_SHOW, ewNoWait, ErrorCode);
end;
var
CustomPage: TWizardPage;
BtnImage: TBitmapImage;
procedure InitializeWizard;
begin
CustomPage := CreateCustomPage(wpLicense, 'Heading', 'Sub heading.');
ExtractTemporaryFile('image.bmp');
BtnImage := TBitmapImage.Create(WizardForm);
with BtnImage do
begin
Parent := CustomPage.ID;
Bitmap.LoadFromFile(ExpandConstant('{tmp}')+'\image.bmp');
AutoSize := True;
Left := 90;
Top := WizardForm.SelectTasksPage.Top +
WizardForm.SelectTasksPage.Height - Height - 8;
Cursor := crHand;
OnClick := #ImageOnClick;
end;
end;
That's what TWizardPage.Surface of type TNewNotebookPage is for.
with BtnImage do
begin
Parent := CustomPage.Surface;
{ ... }
end;
Related questions:
TInputDirWizardPage with Radio Buttons
(Similar question about radio buttons with more code)
Add additional controls to standard Inno Setup pages?
Also, never use absolute coordinates and sizes. Your layout will break, when the wizard is shown on high DPI/scaled display, what is quite common nowadays with "retina" displays. Use ScaleX and ScaleY functions. For the same reason, you should have images with different resolutions ready (see Inno Setup WizardImageFile looks bad with font scaling on Windows 7). Or at least scale/stretch the bitmap.
CustomPage := CreateCustomPage(wpLicense, 'Heading', 'Sub heading.');
ExtractTemporaryFile('image.bmp');
BtnImage := TBitmapImage.Create(WizardForm);
with BtnImage do
begin
Parent := CustomPage.Surface;
Bitmap.LoadFromFile(ExpandConstant('{tmp}')+'\image.bmp');
AutoSize := True;
AutoSize := False;
Height := ScaleY(Height);
Width := ScaleX(Width);
Stretch := True;
Left := ScaleX(90);
Top := WizardForm.SelectTasksPage.Top + WizardForm.SelectTasksPage.Height -
Height - ScaleY(8);
Cursor := crHand;
OnClick := #ImageOnClick;
end;
Layout on 100% zoom (96 DPI):
Layout on 150% zoom (144 DPI):
Layout on 150% zoom (144 DPI) with offset/sizes scaling and image stretching:
Similar to Martin Prikryl's answer.
In order to deal with different DPI settings and placing a bitmap:
setup your machine to 100% DPI
make a bitmap with size (width/height) to fit on your InnoSetup page/form
get these width and height (right click/properties on your bmp file)
use the code below
setup your machine to 150% DPI and create your bitmap to fit for 150% DPI and use it instead the first one (which fits for 100% DPI), this way it will look nice for 100% and for 200%
The code:
WarningImage := TBitmapImage.Create(RisksForm);
WarningImage.Parent := RisksForm;
WarningImage.Bitmap.LoadFromFile(ExpandConstant('{app}')+'uninstall-warning-large.bmp');
WarningImage.Left := ScaleX(24);
WarningImage.Top := ScaleY(120);
WarningImage.Width := ScaleX(544);
WarningImage.Height := ScaleY(211);
WarningImage.Stretch := True;
Change 544 with the width of your bitmap and 211 with the height of your bitmap (from step 3)
Stretch := True does the bitmap to expand (if it is smaller) or shrink (if it is bigger) than width/height properties
P.S. ofcourse you could use multiple files and use one depending on users DPI settings (DPI settings with Inno Setup), but bitmaps are without compressions, so I don't like this idea.
you can Use Botva2 library
http://krinkels.org/threads/botva2.1931/
use google translate if u can't understand rusian
u can create some awesome installer using this
image f.e
Botva2 example
[code]
#include "botva2.iss"
var SomeImage : Longint;
procedure InitializeWizard();
begin
{Your Custom page Code Goes Here}
SomeImage := ImgLoad(WizardForm.Handle,'Image.bmp',0,0,854,480,true,true);
end;
procedure CurPageChanged(CurPageID: Integer);
begin
ImgSetVisibility(SomeImage,false);
if (CurPageID = CustomPage.ID) ImgSetVisibility(SomeImage,true);
end;
I am using Delphi anonymous thread to execute code.
In the middle of the thread, a couple of GUI updates have to take place, a couple of labels changing etc.
If I do this from inside the thread, the changes take place, but as soon as the thread stops. they disappear, and then the application gives me the old window handler error...(Which is to be expected)
System Error. Code:1400. Invalid window handle
I tried using the Syncronize(updateui); method to execute the changes(moved them to a separate function), but I get an error on the syncronize E2066 Missing operator or semicolon which does not make sense to me at all...
I have searched through page after page, and they all seem to call it this way, but when I do, I get the above error...
Am I calling it wrong?
Code:
TThread.CreateAnonymousThread(
procedure
begin
main.Enabled:=false;
Loading.show;
label52.caption:=getfieldvalue(datalive.users,'users','credit_amount','user_id',user_id );
CoInitialize(nil);
if (length(maskedit1.Text)=maskedit1.MaxLength) and (pingip(serverip)=true) then
begin
if (strtofloat(label52.caption)>0) then
begin
....do some work....
Synchronize(updateui);
end
else Showmessage('Insufficient Funds. Please add funds to continue.');
end
else if (length(maskedit1.Text)<>maskedit1.MaxLength) then
begin
Showmessage('ID Number not long enough.');
end
else
begin
Showmessage('Could not connect to the server. Please check your internet connection and try again.');
end;
CoUnInitialize;
loading.close;
main.Enabled:=true;
end).start;
UpdateUI:
procedure TMain.updateui;
var
birthdate,deathdate:TDate;
begin
Panel3.Show;
Label57.Caption := 'Change 1';
Label59.Caption := 'Change 2';
Label58.Caption := 'Change 3';
Label60.Caption := 'Change 4';
Label62.Caption := 'Change 5';
Label70.Caption := 'Change 6';
ScrollBox1.Color := clwhite;
end;
Use TThread.Synchronize and pass another anonymous function to it. Then you can call updateui in the anonymous function:
TThread.CreateAnonymousThread(
procedure
begin
// do whatever you want
TThread.Synchronize(nil,
procedure
begin
updateui();
end);
// do something more if you want
end
).Start();
Synchronizations are generally expensive (regarding performance). Only do them when they are really neccessary. You can increase the performance if you extend the updateui-method to reduce paint-operations.
This is possible to a call to SendMessage with WM_SETREDRAW:
procedure StopDrawing(const Handle: HWND);
const
cnStopDrawing = 0;
begin
SendMessage(Handle, WM_SETREDRAW, cnStopDrawing, 0);
end;
procedure ContinueDrawing(const Handle: HWND);
const
cnStartDrawing = 1;
begin
SendMessage(Handle, WM_SETREDRAW, cnStartDrawing, 0);
// manually trigger the first draw of the window
RedrawWindow(Handle, nil, 0,
RDW_ERASE or RDW_FRAME or RDW_INVALIDATE or RDW_ALLCHILDREN);
end;
Add a call to StopDrawing() at the top of updateui() and a call to ContinueDrawing() at the end of updateui(). The call to ContinueDrawing() should be in a finally-block. This will ensure that the window will be painted even after an exception has occured during the execution of updateui.
Example:
procedure TMain.updateui;
begin
try
StopDrawing(Handle);
Panel3.Show;
Label57.Caption := 'Change 1';
Label59.Caption := 'Change 2';
// ...
finally
// Code under finally gets executed even if there was an error
ContinueDrawing(Handle);
end;
end;
I want to read blobfield (with blobstream) from client side (over network) but application freezes while fetching data. How can I read blobfield without freezing and showing percentage with a progressbar. (I'm using Delphi and Firebird)
i'm using uniquery component. i've found this code from: http://forums.devart.com/viewtopic.php?t=14629
but it doesn't work properly:
const
BlockSize= $F000;
var
Blob: TBlob;
Buffer: array of byte;
p: pointer;
pos, count: integer;
UniQuery1.SQL.Text:= 'select * from TABLE1 where FIELD_ID = 1';
UniQuery1.Open;
blob:= uniquery1.GetBlob('DATA');
SetLength(buffer, blob.Size);
ProgressBar1.Position:= 0;
Application.ProcessMessages;
repeat
count:= Blob.Read(pos, blocksize, p);
ProgressBar1.Position:= Round(pos/Blob.Size * 100);
pos:= pos + count;
p:= pointer(integer(p) + count);
Application.ProcessMessages;
until count < blocksize;
PS: i've set uniquery's options:
cacheblobs:= false;
streamedblobls:= true;
deferredblobread:= true;
in the first step of repeat-until loop, Blob.Read method reads all of stream, so it doesnt work properly.
You should use a thread, here is an example with Delphi TThread:
type
TMyForm = class(TForm)
private
FPosition: Integer;
procedure ProgressUpdate;
procedure Execute;
end;
procedure TMyForm.ProgressUpdate;
begin
ProgressBar1.Position := FPosition;
end;
procedure TMyForm.Execute;
begin
FPosition:= 0;
ProgressUpdate;
Thread := TThread.CreateAnonymousThread(procedure
begin
repeat
// Do some long running stuff (in chunks, so we can update the position)
FPosition := CalculatePosition;
// Important: Synchronize will run ProgressUpdate in the main thread!
TThread.Synchronize(nil, ProgressUpdate);
until SomeCondition;
end
);
Thread.Start;
end;
So after applying this pattern to your code we get:
type
TMyForm = class(TForm)
private
FPosition: Integer;
procedure ProgressUpdate;
procedure Execute;
end;
procedure TMyForm.ProgressUpdate;
begin
ProgressBar1.Position := FPosition;
end;
procedure TMyForm.Execute;
var
Blob: TBlob;
Thread: TThread;
begin
UniQuery1.SQL.Text := 'SELECT * FROM TABLE1 WHERE FIELD_ID = 1';
UniQuery1.Open;
Blob := UniQuery1.GetBlob('DATA');
FPosition:= 0;
ProgressUpdate;
Thread := TThread.CreateAnonymousThread(
procedure
const
BlockSize = $F000;
var
Buffer: array of Byte;
P: Pointer;
Pos, Count: Integer;
begin
SetLength(Buffer, Blob.Size);
repeat
Count := Blob.Read(Pos, BlockSize, P);
FPosition := Round(Pos / Blob.Size * 100);
Pos := Pos + Count;
P := Pointer(Integer(P) + Count);
// Important: Synchronize will run ProgressUpdate in the main thread!
TThread.Synchronize(nil, ProgressUpdate);
until Count < BlockSize;
end
);
Thread.Start;
end;
I removed the Application.ProcessMessage and moved all processing to the thread.
The Thread is setting the FPosition private attribute and uses TThread.Synchronize to set the ProgressBar position to FPosition in the main thread.
If your block size is not big enough this might still block the UI (due to excessive synchronization), so choose an appropriate block size or add some update delay.
You have to make sure that the connection of the UniQuery1 object is not used in the main thread while the anonymous thread is running or move the connection and query to the thread as well.
Also this can have reentrance problems, but it should give you a basic idea of how to use a thread for background processing.
PS: It might also be a good idea to run the query in the thread, especially if it can take some time.
Long story short, I'm very far from a skilled programmer, in fact, my most complicated programs so far were either plain ASCII string manipulating, simple maths and array searching/sorting either in Free Pascal or later, Delphi 7 and Java. This was some years ago, when I learnt programming in high school faculty (that was plain Pascal). Later I went on to become a programmer (meeting with D7 and Java, and some C++), but I had quit my programming studies due to personal reasons, and since then, I didn't wrote a single line of code.
Erm, sorry for the long introduction, so... Recently I decided to revive programming as my hobby, mainly because I didn't found a suitable program for some tasks I would like to accomplish since long. In spite of my faint understanding of such fairly basic things as explicit parameters, pointers, objects, classes, constructors and threads, with the help of a programming book, Delphi help files and the internet, I managed to write a simple program in Delphi 7 that can load and display certain image file formats in a given directory using external libraries, make it possible to arbitrarily switch among them (using the GUI), and log some information (mainly for debug purposes) in text files.
However, I encountered a problem at the current version of the code when I tried to make the image loading and displaying function threaded. First, for better understanding, I'll explain the logic of my program.
First of all, in the main form's FormCreate event, the program looks for supported image files in the current directory (where the exe is). If there is no image files, the current directory is set at the one at the upper level (with the standard Windows file system symbol "..") and is checked for images. Supported image files are determined by file extensions. Anyway, this explorer function stores the found images' filename and a file type identifier (which is a byte) in a dynamic array. Then, using this array as a reference, the first supported image file is loaded by the correct library and displayed in the form. The GUI has buttons and a combobox to change between images, with each control's OnClick or OnSelect (combobox) event setting variables about the supposedly current image file and calling the image loader and displayer function which uses the reference array.
The problem is that some images are so huge that the loading takes noticeable time, so the GUI can't respond until the image is fully loaded and displayed. I tried to make this program threaded by initializing each image loader function as a thread. While the GUI is more responsive now, there are certainly two new bugs with the program.
The first is that the program sometimes randomly crashes when changing images, with appearing messages either referring to "JPEG Error #58" (supposedly meaning "invalid file structure" in Delphi's in-built jpeg library), "EAccessViolation" exception, "EOSError" exception (including "System Error, Code 5"), "unknown software exception", "Runtime error 216", and error messages about memory locations and failed read operations. Before using threads, none of these error messages appeared, but I certainly want to (and must) use threads in the program.
The other, minor bug is that when the interface buttons are clicked in a fast succession, it seems like all loading and displaying takes place, although in a laggy-then-quickly manner. I don't really have an idea on how to "kill" a thread and initiate it "again" to load the now-current file instead of the obsolete one it tried to load a few hundred milliseconds ago.
I start a thread in the following manner:
LoaderThread := CreateThread(nil, 0, Addr(LoadPicture), nil, 0, LoaderThreadID);
CloseHandle(LoaderThread);
I use this two times in the main form's FormCreate event (although only one of them executes at any start), and in the GUI controls' OnClick or OnSelect event to faciliate the desired function of the control (for example skip to the last image).
Any suggestions? Thank you in advance! :)
UPDATE:
Here is some (well, almost all) of my source code:
procedure TMainForm.FormCreate(Sender: TObject);
begin
MainForm.DoubleBuffered := true;
MainJPEG := TJPEGImage.Create;
MainJPEG.ProgressiveDisplay := true;
MainJPEG.Smoothing := true;
MainJPEG.Performance := jpBestQuality;
MainPNG := TPNGObject.Create;
MainGIF := TGIFImage.Create;
AssignFile(Log, '_NyanLog.txt');
CurrentDir := GetCurrentDir;
ExploreCurrentDir;
if CurrentDirHasImages = false then
begin
SetCurrentDir('..');
CurrentDir := GetCurrentDir;
ExploreCurrentDir;
end;
if CurrentDirHasImages = true then
begin
CurrentFilename := ImagesOfCurrentDir[CurrentPos].Filename;
CurrentFiletype := ImagesOfCurrentDir[CurrentPos].Filetype;
LoaderThread := BeginThread(nil, 0, Addr(LoadImage), nil, 0, LoaderThreadID);
CloseHandle(LoaderThread);
if Length(ImagesOfCurrentDir) > 1 then
begin
MainForm.NextButton.Enabled := true;
MainForm.EndButton.Enabled := true;
MainForm.SlideshowButton.Enabled := true;
MainForm.SlideshowIntervalUpDown.Enabled := true;
end;
UpdateTitleBar;
end
else UpdateTitleBar;
end;
procedure ExploreCurrentDir;
var
Over: boolean;
begin
CurrentPos := 0;
Over := false;
ReWrite(Log);
Write(Log, 'blablabla');
if FindFirst(CurrentDir+'\*.*', faAnyFile-faDirectory, Find) = 0 then
begin
CurrentFilename := Find.Name;
DetermineFiletype;
if CurrentFiletype <> UNSUPPORTED then
begin
SetLength(ImagesOfCurrentDir, CurrentPos+1);
ImagesOfCurrentDir[CurrentPos].Filename := CurrentFilename;
ImagesOfCurrentDir[CurrentPos].Filetype := CurrentFiletype;
MainForm.ImagelistComboBox.AddItem(CurrentFilename, nil);
Write(Log, 'blablabla');
CurrentPos := Succ(CurrentPos);
end;
while Over = false do
begin
if FindNext(Find) = 0 then
begin
CurrentFilename := Find.Name;
DetermineFiletype;
if CurrentFiletype <> UNSUPPORTED then
begin
SetLength(ImagesOfCurrentDir, CurrentPos+1);
ImagesOfCurrentDir[CurrentPos].Filename := CurrentFilename;
ImagesOfCurrentDir[CurrentPos].Filetype := CurrentFiletype;
MainForm.ImagelistComboBox.AddItem(CurrentFilename, nil);
Write(Log, 'blablabla');
CurrentPos := Succ(CurrentPos);
end;
end
else
begin
FindClose(Find);
Over := true;
end;
end;
CurrentDirImageCount := Length(ImagesOfCurrentDir);
CurrentDirHasImages := true;
Write(Log, 'blablabla');
end;
if CurrentDirHasImages = false then Write(Log, 'blablabla');
CloseFile(Log);
CurrentPos := 0;
end;
procedure LoadImage; //procedure #1 which should be used in a thread
begin
if CurrentFiletype = BMP then
begin
MainForm.MainImage.Picture := nil;
MainForm.MainImage.Picture.LoadFromFile(CurrentFilename)
end
else
if CurrentFiletype = JPEG then
begin
MainForm.MainImage.Picture := nil;
MainJPEG.LoadFromFile(CurrentFilename);
MainForm.MainImage.Picture.Assign(MainJPEG);
end
else
if CurrentFiletype = PNG then
begin
MainForm.MainImage.Picture := nil;
MainPNG.LoadFromFile(CurrentFilename);
MainForm.MainImage.Picture.Assign(MainPNG);
end
else
if CurrentFiletype = GIF then
begin
MainForm.MainImage.Picture := nil;
MainGIF.LoadFromFile(CurrentFilename);
MainForm.MainImage.Picture.Assign(MainGIF);
end;
end;
procedure NextImage; //the "NextButton" button from the GUI calls this
begin
if CurrentPos < Length(ImagesOfCurrentDir)-1 then
begin
CurrentPos := Succ(CurrentPos);
CurrentFilename := ImagesOfCurrentDir[CurrentPos].Filename;
CurrentFiletype := ImagesOfCurrentDir[CurrentPos].Filetype;
UpdateTitleBar;
LoaderThread := BeginThread(nil, 0, Addr(LoadImage), nil, 0, LoaderThreadID);
CloseHandle(LoaderThread);
while MainImageIsEmpty = true do
begin
if CurrentPos < Length(ImagesOfCurrentDir)-1 then
begin
CurrentPos := Succ(CurrentPos);
CurrentFilename := ImagesOfCurrentDir[CurrentPos].Filename;
CurrentFiletype := ImagesOfCurrentDir[CurrentPos].Filetype;
UpdateTitleBar;
LoaderThread := BeginThread(nil, 0, Addr(LoadImage), nil, 0, LoaderThreadID);
CloseHandle(LoaderThread);
end;
if CurrentPos = CurrentDirImageCount-1 then Break;
end;
end;
if CurrentPos = CurrentDirImageCount-1 then
begin
MainForm.NextButton.Enabled := false;
MainForm.EndButton.Enabled := false;
MainForm.SlideshowButton.Enabled := false;
MainForm.SlideshowIntervalUpDown.Enabled := false;
end;
MainForm.PrevButton.Enabled := true;
MainForm.StartButton.Enabled := true;
end;
procedure PrevImage; //called by "PrevButton"
begin
//some code, calls LoadImage
//almost the same logic as above for a backward step among the images
end;
procedure FirstImage; //called by "StartButton"
begin
//some code, calls LoadImage
end;
procedure LastImage; //called by "EndButton"
begin
//some code, calls LoadImage
end;
procedure Slideshow; //procedure #2 which should be used in a thread
begin
while SlideshowOn = true do
begin
SlideshowInterval := MainForm.SlideshowIntervalUpDown.Position*1000;
Sleep(SlideshowInterval);
NextImage; //NextImage calls LoadImage which should be a thread
if CurrentPos = CurrentDirImageCount-1 then SlideshowOn := false;
end;
end;
function MainImageIsEmpty;
begin
if MainForm.MainImage.Picture = nil then MainImageIsEmpty := true
else MainImageIsEmpty := false;
end;
procedure TMainForm.NextButtonClick(Sender: TObject);
begin
NextImage;
end;
procedure TMainForm.PrevButtonClick(Sender: TObject);
begin
PrevImage;
end;
procedure TMainForm.StartButtonClick(Sender: TObject);
begin
FirstImage;
end;
procedure TMainForm.EndButtonClick(Sender: TObject);
begin
LastImage;
end;
procedure TMainForm.SlideshowButtonClick(Sender: TObject);
begin;
if SlideshowOn = false then
begin
SlideshowOn := true;
SlideshowThread := BeginThread(nil, 0, Addr(Slideshow), nil, 0, SlideshowThreadID);
SlideshowButton.Caption := '||';
SlideshowButton.Hint := 'DIAVETÍTÉS LEÁLLÍTÁSA';
end
else
begin
SlideshowOn := false;
CloseHandle(SlideshowThread);
SlideshowButton.Caption := '|>';
SlideshowButton.Hint := 'DIAVETÍTÉS INDÍTÁSA';
end;
end;
There's a lot of text here, and not much code. Your question would probably be better with more code and less text.
Anyway, I can offer some hints.
Firstly, calling CreateThread directly is a rather laborious way to do threading in Delphi. It's easier to use TThread which wraps up some of the low-level Windows API issues in a manner more native to typical Delphi code style. Of course, you could go further and use a threading library like OmniThreadLibrary, but for now it may be better just to stick to TThread and work out how to do it that way.
Now, that won't be your problem here. Almost certainly your problem will be cause by one of two common issues with threading:
All VCL and GUI code should run in the main thread. Windows controls have affinity with the thread that creates them. Many parts of the VCL are not thread-safe. These issues strongly push you to putting all VCL/GUI code in the main thread.
It's quite possible that you have a race condition due to lack of synchronisation.
The most common way to deal with issue 1 is to call TThread.Synchronize or TThread.Queue from the worker threads in order to force all the VCL/GUI code to run on the main thread. Of course you need to be sure that none of the time-consuming code in your worker thread uses VCL/GUI objects since that is doomed to failure.
Issue 2 can be dealt with by synchronisation objects like critical sections or lock-free methods using the InterlockedXXX family of functions.
Exactly what your problem is I can't say. If you want more detailed help then please post more code, most probably cut down from what you are currently running.
You create a thread and kill it right away without waiting for it to finish loading
LoadImage is not VCL thread safe
Here simple seudo thread in VCL way. Codes is in simple form and you can study further and make enhancement
TYourThread.Create(image file name);
type
TYourThread = class(TThread)
protected
FBitmap: TBitmap;
FImageFileName: string;
procedure BitmapToVCL;
begin
MainForm.MainImage.Picture := FBitmap;
end;
procedure Execute; override;
begin
FBitmap := TBitmap.Create;
try
FBitmap.LoadFromFile(FImageFileName);
Synchronize(BitmapToVCL);
finally
FreeAndNil(FBitmap);
end;
end;
public
constructor Create(const AImageFileName: string);
begin
FImageFileName := AImageFileName;
inherited Create(False);
FreeOnTerminate := True;
end;
end;
Gook luck
Cheer