

Ian Branch
Members-
Content Count
1431 -
Joined
-
Last visited
-
Days Won
3
Everything posted by Ian Branch
-
I have just implemented you code. procedure TJobTicketsForm.btnPrintImageClick(Sender: TObject); var // temp for memory works... LPrinter : TPrinter; LJPEG : TJPEGImage; LJPEGStream : TMemoryStream; LBitmapToResize : TBitmap; begin LJPEGStream := TMemoryStream.Create; LJPEG := TJPEGImage.Create; LBitmapToResize := TBitmap.Create(1, 1); try // my field BLOB with only "JPEG" files!!! any other raise an exception!!! // header: ($FF, $D8, $FF); // 255, 216, 255 (dmC.jtImages.FieldByName('JTImage') as TBlobField).SaveToStream(LJPEGStream); // LJPEGStream.Position := 0; LJPEG.LoadFromStream(LJPEGStream); // //Memo1.Text := format('JPEG: %dx%d', [LJPEG.Width, LJPEG.Height]); // if not (LJPEG.Empty) then begin LPrinter := TPrinter.Create; try LPrinter.PrinterIndex := -1; // current printer ( if any one ??? ) LPrinter.Orientation := poPortrait; //TPrinterOrientation(integer(not chkbxPortrait.Checked)); // // try resize to fill the page on printing... MyResizeBitmap2({ } LJPEG, { } LBitmapToResize, { } GetDeviceCaps(LPrinter.Handle, HORZRES), { } GetDeviceCaps(LPrinter.Handle, VERTRES), { } True); //chkbxScaled.Checked); // //Memo1.Lines.Add(format('JPEG loaded: %dx%d', [LJPEG.Width, LJPEG.Height])); // LPrinter.BeginDoc; LPrinter.Canvas.Draw(0, 0, LJPEG); LPrinter.EndDoc; finally LPrinter.Free; end; end; finally LBitmapToResize.Free; LJPEG.Free; LJPEGStream.Free; end; end; Same result. No printing.. Could well be my printer. Ian
-
I was but no longer. No file.
-
Hi Team, I cheated a little bit here and have this att.. procedure TJobTicketsForm.btnPrintImageClick(Sender: TObject); var bmp : TBitmap; jpegimage : TJPegImage; outputrect : TRect; i : Integer; sFilename : string; begin // sFilename := 'TempImage.jpg'; if TFile.Exists(sFileName) then TFile.Delete(sFileName); (dmC.jtImages.FieldByName('JTImage') as TBlobField).SaveToFile(sFilename); // jpegimage := TJPegImage.Create; try jpegimage.Loadfromfile(sFileName); bmp := tbitmap.Create; try bmp.assign(jpegimage); i := 1; while ((i + 1) * bmp.Width < printer.pagewidth) and ((i + 1) * bmp.Height < printer.pageheight) do Inc(i); outputrect := Rect(0, 0, i * bmp.width, i * bmp.height); try printer.Orientation := poPortrait; printer.begindoc; PrintBitmap(bmp, outputrect); except printer.abort; raise; end; printer.enddoc; finally bmp.Free; end; finally jpegimage.free; if TFile.Exists(sFileName) then TFile.Delete(sFileName); end; end; It appears to work. The file is created and it contains the right image. On the disk, TempImage.jpg is only 200KB If I look at the Print Queue it has the file, 38.4MB, ostensibly printing but the printer is doing nothing.. 😞 .
-
Customer is using Win 7. 😞 He also is still using IE and can't change that because of other Legacy applications. 😞
-
Old Age, Eye Sight, etc. 🙂 The forms are too small for me to work with on 4k monitor when Delphi opens dpi aware.
-
Bit out of my price range.. 😞
-
Hi Team, D11.3. In my Log In form I have the fololowing code in the form Type section.. ... // protected property Destroying: Boolean read FDestroying write FDestroying; end; var ... The form is called from the project file at startup.. ... // if not TLogInForm.Execute('DBiBackup', %1001) then exit; // Bits 0 & 3 // ... I have long forgotten why it is there and obviously I didn't document it. 😞 Can someone enlighten me what it is there fore please?? Or, do I actually need it?? Regards & TIA, Ian orm
-
Hi Team, Again, thank you all for your inputs. I have eliminated FDestroying and related code altogether so issue resolved. Regards, Ian
-
Ah Ha! The login form is used for many Apps. This code was further down.. procedure TLogInForm.DBSLoginRemoteReconnect(Sender: TObject; var Continue, StopAsking: Boolean); begin // if FDestroying then begin Continue := False; StopAsking := True; end else begin Continue := True; MessageBeep(MB_ICONASTERISK); // tdRemRecon.Timer.Interval := 180000; // 3 minutes. // var iResponse := tdRemRecon.Execute; // case iResponse of 200: begin Continue := True; iReconnectCounter := iReconnectCounter + 1; end; 201: begin Continue := False; StopAsking := True; end; 202: Continue := False; end; // if iReconnectCounter = 3 then Continue := False; // lConnected := False; // {$IFDEF SILogging} case iResponse of 200: LogMessage('RemoteReconnect Result = mrYes - (Continue), Continue = True StopAsking = False.'); 201: LogMessage('RemoteReconnect Result = mrCancel - (Ignore), Continue = False, StopAsking = True.'); 202: LogMessage('RemoteReconnect Result = mrNo - (Stop), Continue = False.'); end; {$ENDIF} // end; // end; But still no sign of anything that actually sets FDestroying. Is it possible that FDestroying should be set under specific conditions? i.e. during thr form OnDestroy event, or some other event/condition where the form is closed?? Fishing in unknown waters here. I don't want to totally discount it until I have eliminated all the probabilities. Regards, Ian
-
Tks Remy. I sorta figured/hoped that was the case but I wasn't sure if there was any under-the-hood Delphi thing happening. All gone now. Regards, Ian
-
Hi Anders, Created - The form is created with the "if not TLogInForm.Execute('DBiBackup', %1001) then exit; // Bits 0 & 3" in the dpr. There is a private FDestroying in the Form Type.. private { Private declarations } FDestroying: Boolean; and a public class.. public { Public declarations } class function Execute(const sApplication: string; const iBits: SmallInt): Boolean; FMutex is a genaral Var. FMutex : THandle; // Mutex Handle The Execute does this.. class function TLogInForm.Execute(const sApplication: string; const iBits: SmallInt): Boolean; begin // sApp := sApplication; iBitsSet := iBits; // with TLogInForm.Create(nil) do try Result := ShowModal = mrOk; finally Free; end; // end; This is the FormCreate.. procedure TLogInForm.FormCreate(Sender: TObject); var wApp : array[0..11] of WideChar; begin // if VirtualUI.Active then begin VirtualUI.ClientSettings.MouseMoveGestureStyle := MM_STYLE_ABSOLUTE; VirtualUI.ClientSettings.MouseMoveGestureAction := MM_ACTION_WHEEL; VirtualUI.ClientSettings.CursorVisible := True; VirtualUI.OnClose := BrowserClosed; // sUsersIP := VirtualUI.BrowserInfo.IPAddress; // if sUsersIP = '59.167.177.107' then // begin // ShowMessage('The Users IP is valid'); // ModalResult := mrOK; // PostMessage(Handle, WM_CLOSE, 0, 0); // end; end; // if sApp <> 'DBManager' then TStyleManager.TrySetStyle('Windows11 Polar Light'); // StringToWideChar(sApp, wApp, 12); // FMutex := CreateMutex(nil, False, wApp); // if WaitForSingleObject(FMutex, 0) = WAIT_TIMEOUT then Application.Terminate; // // if VirtualUI.Active then // begin // VirtualUI.ClientSettings.MouseMoveGestureStyle := MM_STYLE_ABSOLUTE; // VirtualUI.ClientSettings.MouseMoveGestureAction := MM_ACTION_WHEEL; // VirtualUI.ClientSettings.CursorVisible := True; // VirtualUI.OnClose := BrowserClosed; // sUsersIP := VirtualUI.BrowserInfo.IPAddress; // end; // DBE1.ConfigPath := DBiWIni.ReadString('DBiWorkflow', 'Directory', ''); // iDatabaseType := DBiWIni.readInteger('DBiWorkflow', 'DatabaseType', 0); // DBSLogin.SessionDescription := sApp + ' Login Dialog.'; DBSLogin.RemoteAddress := DBiWIni.ReadString('DBiWorkflow', 'ServerAddress', '0.0.0.0'); DBSLogin.RemotePort := DBiWIni.readInteger('DBiWorkflow', 'ServerPort', 0); // try // DBC1.Open; // except on EDatabaseError do begin // TaskMessageDlg('Database Open Error!', 'Please check that the database has been started and is available and that you have correctly configured the Data path with DBiConfig.' + sLineBreak + 'The application will now close.', mtError, [mbOK], 0); DBE1.Close; Application.Terminate; Exit; // end; // end; // end; Destroyed - The form normally closes with this.. procedure TLogInForm.FormClose(Sender: TObject; var Action: TCloseAction); begin // DBC1.CloseDataSets; // DBC1.Close; DBSLogin.Close; DBE1.Close; // ReleaseMutex(FMutex); // Action := caFree; // end; HTH. Regards, Ian
-
Hi Team, I am trying to figure out the wierd usage of the TStringHelper IsNullOrWhiteSpace. I have seen this as "if ''.IsNullOrWhiteSpace(MyString) then", and this "MyString.IsNullOrWhiteSpace(MyString) then". Are both correct? Why the confusing construct? From the class definition, "class function IsNullOrWhiteSpace(const Value: string): Boolean; static;" I had expected to be able to simply do a more readable "if IsNullOrWhiteSpace(MyString) then ". Regards & TIA, Ian
-
All good. Tks Guys.
-
I've just settled for "if Trim(MyString) = '' then"
-
Hi Attila, I tried that with this "if TStringHelper.IsNullOrWhiteSpace('sMyString') then" but get an 'E2018 Record, object or class type required' error.
-
Hi Team, I have used the following construct multiple times for a long time.. Currently D11.3 but used in older Delphis. // Thread := TThread.CreateAnonymousThread( procedure begin // DBSBackup.Execute(Some SQL code); // end); try Thread.FreeOnTerminate := False; H := Thread.Handle; Thread.Start; while MsgWaitForMultipleObjects(1, H, False, INFINITE, QS_ALLINPUT) = (WAIT_OBJECT_0 + 1) do Application.ProcessMessages; finally FreeAndNil(Thread); end; // DBSBackup is an ElevateDB TEDBSession. Whilst this is happening an activity indicator is spinning around on the screen so the User knows the App is alive and still doing something. I have been advised that 'Application.ProcessMessages' is not thread safe. Is this the case? If so, what is a better way to achieve the above? Regards & TIA, Ian
-
Hi Team, Windows 11, D11.3 (and previous D11 versions, don't recall experiencing the issue in D10 versions), latest GExperts. This is as far as I can tell NOT an issue with GExperts Formatter. I have for some time been wrestling with the Formatter sometimes working & sometimes not. I was initially blaming it on other plug-ins. This turns out to not be the case. I use a Drive/Directory utility called Xplorer2. It is excellent. One of the things I like most about it is that its open drives/directories are persistant between uses. Unlike Windows Explorer. Anyway, after a lot of experimenting with the various Appliations I use while developing, I have discovered that if I open Xplorer first, it does something such that when I open Delphi and go to use the GExperts Formatter, the Formatter is disabled. Totally. 😞 If I open Delphi then Xplorer, then the Formatter is fine. It is now a matter of discipline in the order of opening files. 🙂 Just thought that may help others in some way if they are experiencing an issue like I was. Of course this could be just unique to my development environment. Regards, Ian
-
@Dalija Prasnikar % @Remy Lebeau I like both your solutions. As was noted, att the App sits there until the process is finished. I would like, if needed, for the User to be able to move the form aside, out of the road, on the screen, or even another screen, while the process is running, if possible. Particularly on long processes. Regards, Ian
-
All, Thank you very much for your inciteful and informative inputs. Very much appreciated. I put Threads in the same category as Pointers - A black art. Something I never fully grasped, but happy to use if it achieves an end.
-
Hi Team, D11.3. I have just realised I can't change the width of my forms at all at design time in the IDE. Drag-and-drop of the form handles doesn't work, changing the Width properties does nothing. There are no Constraints set. I disabled ALL my IDE plugins just in case, no change. WTH?? Any thoughts/suggestions?? Regards & TIA, Ian
-
Suddenly can't resize forms in IDE??
Ian Branch replied to Ian Branch's topic in Delphi IDE and APIs
Found it!! Onthe form was a TDBGrid. It had constraints. Why I don't know. Removed them and all good now. Now to check my other forms. Thank you for your input/suggestions. Ian -
Suddenly can't resize forms in IDE??
Ian Branch replied to Ian Branch's topic in Delphi IDE and APIs
Yup. That works. I also tried forms in different projects. Sometimes it works, sometimes it doesnt. 😞 -
Yup. Understood. Mine is set at 15 minutes.
-
My purpose in raising this was to see if it was just my environment or if anybody else has experienced it. If nobody else has then it i something I have to deal with.
-
There is only one shared datamodule.