![Delphi-PRAXiS [en]](https://en.delphipraxis.net/uploads/monthly_2018_12/logo.png.be76d93fcd709295cb24de51900e5888.png){kind=logo}
Pat Foley
-
Content Count
367 -
Joined
-
Last visited
-
Days Won
2
Posts posted by Pat Foley
-
-
4 hours ago, Sonjli said:The marvel:
if ThereIsAnError then begin //ShowMessage('This is the error'); //Abort; halt; end;All exceptions in a big project with this simple, magic trick...
I had to work 2 weeks to change all the exception handling system.
Upgraded to D14.4.2
For EU End User input errors should provide helpful feedback. 'not enough data entry', 'too much data'
masked tedits help
Exceptions need to be surfaced!
-
1
-
-
Hey, codebox </> selector just reappeared. Copying text from browser to IDE and back again to browser window did sometime to the browser edit window the day before 😞
So another question how to cancel a post before saving?
Thanks
-
More info.
procedure TpfEngine.AddScreenMenuitems; var tabpageCount: integer; // used in menuclick handler and tag business ScreenMenu: TMenuitem; begin menucount := 0; extendedTScount := 0; For tabPageCount:= 0 to ComponentCount - 1 do if Components[tabpageCount].ClassNameIs('TTabSheet')then if (Components[tabpageCount] as TTabSheet).TabVisible then begin inc(MenuCount); ScreenMenu:= TMenuItem.Create(self); ScreenMenu.caption:= (Components[tabPageCount]as TTabSheet).Caption; ScreenMenu.Tag:= tabPageCount; extendedTScount := ScreenMenu.Tag; ScreenMenu.onClick:= MenuScreenClick; // dirty patch if ScreenMenu.caption = 'Prime Mover' then begin ScreenMenu.Enabled := False; ScreenMenu.Bitmap.LoadFromResourceName(HInstance,'BITMAP_ST');//:= Image1.Picture.Bitmap; end; .... Screens.add(screenmenu) // Screens:TMenuItem end; -
9 minutes ago, chkaufmann said:Hi,
I would like to add group headers in a TPopupmenu. So I can create things like this:
Are there any properties I didn't find yet in the standard VCL? Or can I do that with some additional methods in a TPopupMenu subclass?
Christian
Menu.Break := mbBarbreak //mbbreak
example
ScreenMenu.Break := mbBarBreak;
ScreenMenu.Enabled := False;
// ScreenMenu.Bitmap:= Image1.Picture.Bitmap;
ScreenMenu.Bitmap.LoadFromResourceName(HInstance,'BITMAP_3');
-
28 minutes ago, Uwe Raabe said:hm! That Exit call will only exit procedure gotoTrue, but not function BlankControl.
Concede.
-
3 hours ago, Stefan Glienke said:Certainly but that would change the behavior - currently if the class is found it exits, regardless. With a giant if and/or statement it would continue to evaluate the is checks.
// lost editor code box somehow sorry.
Fix up at top Result := False; once
function BlankControl(EditControl: TObject; const EditMess: string; ShowErrorMsg: Boolean; MaxLen: Integer): Boolean;
//fall back label gotoTrue spare
procedure gotoTrue;
begin
Result := True;
Exit;
end;
begin
Result := false;if EditControl is TCustomEdit then
if length(trim((EditControl as TCustomEdit).Text)) < MaxLen then
gotoTrue;
if EditControl is TComboBox then
if length(trim((EditControl as TComboBox).Text)) < MaxLen then
gotoTrue;if EditControl is TDBComboBox then
if length(trim((EditControl as TDBComboBox).Text)) < MaxLen then
gotoTrue;if EditControl is TDBRadioGroup then
if ((EditControl as TDBRadioGroup).Value = '') then
gotoTrue;if EditControl is TDBLookupComboBox then
if ((EditControl as TDBLookupComboBox).Text = '') then
gotoTrue;if EditControl is TDBCheckBox then
if ((EditControl as TDBCheckBox).State = cbGrayed) then
gotoTrue;
//gotoTrue:
//result := True;
end;
...
if BlankControl(EditControl, EditMess, false, ShowErrorMsg,0) then
Showerror(EditControl, EditMess, false, ShowErrorMsg);// Move the spaghetti hidden in the goto sauce -
QuoteUS I think thousand separator is Comma, here it is decimal separator. THis is one of the places there would have been nice to have global standard, and only one 🙂
-
1
-
-
subclass (extend) Tshape with Tmyshape = class(Tshape) protected procedure Paint; public Moniker: string; end ... { TmyShape } procedure TpatShape.Paint; var w, h: integer; textSize: TSize; begin inherited; Brush.Color := clBtnFace; with Canvas do begin font.Size := -15; textSize := TextExtent(Moniker); w := (Width - textSize.cx) div 2; h := (Height - textSize.cy) div 2; TextOut(w,h,Moniker); end; //At runtime create custom shapes setting their parent to a floatPanel-
1
-
-
3 hours ago, Joe Sansalone said:I see the benefit of For loop only evaluating once at initial.
This shows way mentioned to extend for..loop functionality.
procedure TForm19.Button1Click(Sender: TObject); var needsProcessed, startProcess: integer; LList: TList<integer>; s,r: string; begin LList := TList<integer>.Create; try LList.AddRange([0,1,2,3,4,5]); needsProcessed := LList.Count; //process everything first time. Repeat startProcess := LList.Count - Needsprocessed; needsProcessed := 0; for var ii := startProcess to pred(LList.count) do begin // ^ LList.Last would increase here! if ((LList.List[ii] mod 2) = 0) then begin inc(needsProcessed); r := ' even '; with LList do add(Last + 1); end else r := ' odd '; s := s + LList.List[ii].ToString + r + #13#10; end; until (LList.count > 150) or (needsProcessed = 0); showMessage(s); finally LList.Free; end; end;
-
QuotePROBLEM: the loop does not continue past the initial count.
I'm guessing this is a BUG?
Most people consider this a feature.
Append list elsewhere; Keep track of List count and start count at a lastProcessed count to reduce processing.
-
Quotethe GetFocus actually worked great but after i started testing the cobol programs ... the focus is at the top field on the screen. so .... just push the button at the bottom of the screen but the popup calendar is at the top.
So on Cobol window only the edit fields can be focused? That is using the tab key to move to each control in window allowing editing in edit field or a key press with enter key.
What event is called when pop up calendar Date is set? How is the initial Date set in pop up when opened.
You could let the user save the popup position in a inifile. This inifile could load a button for each cobol field update event. It could save the last date(s) entered to set calendar date if needed.
-
QuoteSo, I'm not looking to redesign UI, just thought perhaps there was simple solution that will trigger alert to add new checkbox and its state as filter.
I have switched to reading the header line of the data table coming in. So if data table has five fields the reads five fields. A data table with six fields reads the six 'names' through iteration. Controls are named and
labeled with these 'names'. Hard coding enums for each column required rework as extra data table fields are added. How does your report handle datetime and time period if I may ask?
-
1
-
-
QuoteIt would be really nice if compiler could distinguish Set, open arrays and enum arrays, so we can pass ['a','b','c'] into array[enum] of string. And then if enum changes to have 2 or 4 elements it would complain. Seems like a small update to compiler
Try overloading to extend your codebase. Or explore it in this case
//existing procedure SaveProjectNames(aProjNames: TProjectNames); overload; begin xProjectNames := aProjNames; end; //add procedure SaveProjectNames(aitems: TStrings); overload; begin ... for switches in Atems SaveProjectNames(switches[0],switches[1], False); end; // this overload wants three args need to set the extra args to False in existing procedure SaveProjectNames(abMain, abXXX, abCountry: Strings); overload; begin If abMain = 'C' do stuff If ... //If abCountry end;force the compiler to use new procedures with fixed number of Args
ie comment out original to find the aberrant code or missing switches.You would add an overloaded procedure when argument count needs change.
(* procedure SaveProjectNames(aProjNames: TProjectNames); overload; begin xProjectNames := aProjNames; end; *)-
1
-
-
I would use Vcl.Samples.Gauges for a start.
Set some of these in a form setting TGaugeKind = (.. gkHorizontalBar
Use the form mouse down events to resize the gauges by dragging.
Then convert the form into a component by editing the forms dfm file. Be sure to add/set the parent.
This scheme allows the control to load its controls in runtime but not in the IDE.
-
1
-
-
I suspect it might be OLE for files at work! In short leaving everything
on disk, reading only what's needed. How to share the "loaded" or
streamed file is a good question.
https://en.wikipedia.org/wiki/COM_Structured_Storage
-
QuoteTurn off RTTI if you can.
That can save 400K
For big savings remove Classes 1.5 M and SysUtils .2 M from the uses clause for a smaller lib.
-
1
-
-
How about using buffer items in second--These would be blank or ad space :)--but stay at 30 for height unless there is a way to insert a 15 height buffer first to center second items displays.
TWinStatus = (WSallin,WSsecondround..WSoverallwinner) TTeam = record name: string; Lastwin: TwinStatus end; Teams, Opposers, Winners: Tlist; end; Teams: tlist; //build the controls.items at runtime // round := WSallin; //add half height dummy to second list if possible with Teams do begin if TTteam(items[ii]).Lastwin := round then add to listbox1.items if TTteam(items[ii]).Lastwin := TwinStatus(round + 1) then begin add to listbox2.items add dummy to listbox2.items end; end; -
QuoteYou mean non-existing outside the method before the call, still means as not-existing inside the method, so it cannot be used before its creation.
type TJobflag = (jfstart, jfAdd, jfLoaded, jfDone); Tcompareflag = (cfCaps, cfDupes); Jobs = set of TJobflag; Compares = set of Tcompareflag; function AddItems2(const aArray: array of string; var aList: TStrings; aCompareSet: Compares) : TJobflag; var jobSpecification: Tcompareflag; S: string; RC: Boolean; begin result := jfDone; RC := False; for S in aArray do begin for jobSpecification in aCompareSet do begin RC := (jobSpecification = cfCaps) // and // compare S for Caps; RC := RC or (jobSpecification = cfDupes) //and dupes found If RC then begin if not assigned(aList) then aList := TStringList.create aList.add(S); end; end; result := jfLoaded; end; end; try if AddItems2(['Hello', 'World'],lst, [cfCaps]) = jfLoaded then Writeln('True') else Writeln('False'); if lst <> nil then Writeln(lst.Text); finally { uncommenting this will raise an invalid pointer exception later } // lst.Free; end; Or procedure loadLists aList := TStringList.create result := jfDone; for S in aArray do begin for jobSpecification in aCompareSet do begin RC := (jobSpecification = cfCaps // and // compare S for Caps; RC := RC or (jobSpecification = cfDupes) //and dupes found If RC then aList.add(S); If RC then jobStatus := jfLoaded; end; end; end; // future Procedure processListsAbover my spin on it use enums to determine status testing for list = nil does not tell if list need was ever tested.
-
2
-
-
Here's a book to read for 10.4 If Marco took the time to write it. We should take to time read it or at least read the stuff about connection and event and wrapping connect with try..finally.
Also I would look for Cary Jensen He has books and videos about client data sets that may help your app.
-
I find that loading extra copy of 10.4 prevents the disappearing act. It prevents recompiling packages though.
My vcl custom components when installed show only the non-visual components on the palette when making fmx application. But after making a fmx app switching to vcl app then a message box may appear stating that my components refer to Teechartxxx.
Here's output of a component that runs in IDE as well as runtime. Using this in an app with timer.interval at 10 shows more stuff.
// win32 works // in create of custom component if (csDesigning in ComponentState) then ticker.Enabled := true; //Tip by Delphian | 2014-08-13 at 17:05 function GetTitleOfActiveWindow: string; var AHandle: THandle; ATitle: string; ALen: Integer; begin Result := ''; AHandle := GetForegroundWindow; if AHandle <> 0 then begin ALen := GetWindowTextLength(AHandle) + 1; SetLength(ATitle, ALen); GetWindowText(AHandle, PChar(ATitle), ALen); result := Trim(ATitle); end; end; procedure TForm1.Timer1Timer(Sender: TObject); var awn: HWND; buf: array[0..1024] of Char; lng: longint; WinInstance: Thandle; WinModuleName: string; begin SetLength(WinModuleName,251); WinInstance := GetWindowLong(GetForegroundWindow(), GWL_hInstance); if WinInstance <> 0 then begin lng := GetModuleFileName(WinInstance, PChar(WinModuleName), Length(WinModuleName)); SetLength(WinModuleName, lng); end; awn := GetForegroundWindow; if awn <> 0 then begin GetClassName(awn, @buf, Length(buf)); if buf <> cacheAwn then begin Edit3.Text := buf; cacheAwn := buf; memo1.Lines.Add(cacheAwn); end; end else Edit3.Text := ''; Edit2.Text := GetTitleOfActiveWindow + ' ' + WinModuleName; end;
-
Runs OK! Good example of separation of units and runtime building.
It may be easier to edit DFM file than drilling into Object Inspector.
ItemAppearance.ItemHeight = 45 ItemAppearanceObjects.ItemObjects.ObjectsCollection = < item AppearanceObjectName = 'INDEX' AppearanceClassName = 'TTextObjectAppearance' Appearance.Width = 100.000000000000000000 Appearance.Height = 22.000000000000000000 Appearance.Align = Trailing end item AppearanceObjectName = 'VALUE' AppearanceClassName = 'TTextObjectAppearance' Appearance.Width = 100.000000000000000000 Appearance.Height = 22.000000000000000000 end item AppearanceObjectName = 'IMAGE' AppearanceClassName = 'TImageObjectAppearance' Appearance.ScalingMode = Original Appearance.Width = 200.000000000000000000 Appearance.Height = 5.000000000000000000 Appearance.PlaceOffset.Y = 32.000000000000000000 end>-
1
-
-
Can't read RARs today.
procedure TForm1.Button1Click(Sender: TObject);
var
I: integer;
colorRect: TroundRect;
begin
for I := 1 to 100 do
begin
colorRect := TRoundRect.Create(self);
with colorRect do
begin
Setbounds(0,10 * I, 34,34); //need to set size only
parent := FlowLayout1;
fill.color := Talphacolors.Gold;show;
end;
end;
You could change the roundRect to other shapes as needed. the self in TRoundRect.Create(self) puts the object created in the forms list of Controls and/or Components for destruction later
-
1
-
-
1. Use FlowLayout and set properties of children controls.
2. Put a Progress bar over another.
-
1
-
-
Mixing vcl components into a fmx project group definely causes trouble.
// CodeGear C++Builder // Copyright (c) 1995, 2021 by Embarcadero Technologies, Inc. // All rights reserved // (DO NOT EDIT: machine generated header) 'dclPat.dpk' rev: 34.00 (Windows) #ifndef DclpatHPP #define DclpatHPP #pragma delphiheader begin #pragma option push #pragma option -w- // All warnings off #pragma option -Vx // Zero-length empty class member #pragma pack(push,8) #include <System.hpp> // (rtl) #include <SysInit.hpp> #include <pfControllerB.hpp> #include <pattimerEX.hpp> ... #include <System.Messaging.hpp> // (rtl) #include <System.Actions.hpp> // (rtl) #include <Vcl.ActnList.hpp> // (vcl) #include <System.HelpIntfs.hpp> // (rtl) #include <System.SyncObjs.hpp> // (rtl) #include <Winapi.UxTheme.hpp> // (rtl) #include <Vcl.GraphUtil.hpp> // (vcl) #include <Vcl.StdCtrls.hpp> // (vcl) #include <Winapi.ShellAPI.hpp> // (rtl) #include <Vcl.Printers.hpp> // (vcl) #include <Vcl.Clipbrd.hpp> // (vcl) #include <Vcl.ComCtrls.hpp> // (vcl) #include <Vcl.Dialogs.hpp> // (vcl) #include <Vcl.ExtCtrls.hpp> // (vcl) #include <Vcl.Themes.hpp> // (vcl) #include <System.AnsiStrings.hpp> // (rtl) #include <System.Win.ComObj.hpp> // (rtl) #include <Winapi.FlatSB.hpp> // (rtl) #include <Vcl.Forms.hpp> // (vcl) #include <Vcl.Menus.hpp> // (vcl) #include <Winapi.MsCTF.hpp> // (rtl) #include <Vcl.Controls.hpp> // (vcl) #include <Vcl.Buttons.hpp> // (vcl) #include <VCLTee.TeeHtml.hpp> #include <VCLTee.TeeConst.hpp> #include <VCLTee.TeCanvas.hpp> #include <VCLTee.TeeFilters.hpp> #include <VCLTee.TeeProcs.hpp> #include <VCLTee.TeEngine.hpp> #include <VCLTee.Chart.hpp> #include <VCLTee.TeeSpline.hpp> #include <Consts_Gen.hpp> #include <pfTrackBar.hpp> #include <pfArrowButton.hpp> #include <sparkline.hpp> #include <VCLTee.Series.hpp> // SO_SFX: 270 // PRG_EXT: .bpl // BPI_DIR: C:\Users\Public\Documents\Embarcadero\Studio\21.0\Dcp // OBJ_DIR: C:\Users\Public\Documents\Embarcadero\Studio\21.0\Dcp // OBJ_EXT: .obj //-- user supplied ----------------------------------------------------------- namespace Dclpat { //-- forward type declarations ----------------------------------------------- //-- type declarations ------------------------------------------------------- //-- var, const, procedure --------------------------------------------------- } /* namespace Dclpat */ #if !defined(DELPHIHEADER_NO_IMPLICIT_NAMESPACE_USE) && !defined(NO_USING_NAMESPACE_DCLPAT) using namespace Dclpat; #endif #pragma pack(pop) #pragma option pop #pragma delphiheader end. //-- end unit ---------------------------------------------------------------- #endif // DclpatHPP
Multi-device application chokes on the Tchart package in here.
Short answer is don't mix vcl and fmx. I only have DX pro how's it making C++
TCustomInifile.ReadSubSections in older Delphi versions
in RTL and Delphi Object Pascal
Posted
How about
Type TdzIniFile = Class(TmemIniFile) {$if ver < 12} // procedure dealwithsubsections {$endif} TdzRegFile = Class(TRegIniFile) procedure dealwithsubsectionsHaving two components would match better with their mem or reg business.
Unsure if switch is usable or needed.