Jump to content

Pat Foley

Members
  • Content Count

    367
  • Joined

  • Last visited

  • Days Won

    2

Everything posted by Pat Foley

  1. How about Type TdzIniFile = Class(TmemIniFile) {$if ver < 12} // procedure dealwithsubsections {$endif} TdzRegFile = Class(TRegIniFile) procedure dealwithsubsections Having two components would match better with their mem or reg business. Unsure if switch is usable or needed.
  2. 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!
  3. Pat Foley

    Edit code section in post

    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
  4. Pat Foley

    TPopupMenu with group headers

    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;
  5. Pat Foley

    TPopupMenu with group headers

    Menu.Break := mbBarbreak //mbbreak example ScreenMenu.Break := mbBarBreak; ScreenMenu.Enabled := False; // ScreenMenu.Bitmap:= Image1.Picture.Bitmap; ScreenMenu.Bitmap.LoadFromResourceName(HInstance,'BITMAP_3');
  6. // 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
  7. Pat Foley

    How to create a grid that looks like this

    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
  8. 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;
  9. Most people consider this a feature. Append list elsewhere; Keep track of List count and start count at a lastProcessed count to reduce processing.
  10. 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.
  11. 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?
  12. 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; *)
  13. Pat Foley

    Need suggestion on developing a custom component

    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.
  14. Pat Foley

    Caching oddity

    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
  15. Pat Foley

    Binary size, how-to make it smaller?

    That can save 400K For big savings remove Classes 1.5 M and SysUtils .2 M from the uses clause for a smaller lib.
  16. Pat Foley

    Two Lists synchronised movement

    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;
  17. 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 processLists Abover my spin on it use enums to determine status testing for list = nil does not tell if list need was ever tested.
  18. Pat Foley

    Fail faster than calling Connected := True?

    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.
  19. Pat Foley

    10.4.2 IDE crashes on start

    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;
  20. Pat Foley

    FMX TListView with dynamicappearance. Create progress bar as bitmap.

    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>
  21. Pat Foley

    FMX TListView with dynamicappearance. Create progress bar as bitmap.

    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
  22. Pat Foley

    FMX TListView with dynamicappearance. Create progress bar as bitmap.

    1. Use FlowLayout and set properties of children controls. 2. Put a Progress bar over another.
  23. Pat Foley

    JCL installation problems in D10.4.2

    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++
×