Pat Foley

3 hours ago, bravesofts said:

my conclusion:

An Enumeration Type is just  a predefined const list of values

 

You could say the same about clYellow, clMoneyGreen.

By setting a couple of adjustable colors 

UserColorBrush: Tcolor;

UsercolorPen: Tcolor; 

begin
  ColorDialog1.Options := [cdFullOpen,cdShowHelp];
  if ColorDialog1.Execute then
  begin
    MachineColor:= ColorDialog1.Color;
    EngineSubModel[11]:= inttostr(MachineColor); //for saving loading 

adding these to a list to get a count.    

Quote

On 8/18/2021 at 9:00 PM, Darian Miller said:

 

Note:  once you start down this path of customizing basic component behavior, it's best to derive a custom set of components.  Derive your own component from TButton and reuse whatever custom code that ends up working out for you.  You may find yourself with a custom version of all the basic components and you'll end up with customized behavior controlled in a central location.

 

Whatever happens, please don't copy-n-paste this code into 27 different Click events throughout your app...  

 

 

You could have single click event and assign all custom TUButtons onClick to it.

This could stored in eventForm code.  Somewhat like a DataModule   Only we keep

message handlers in there. Also panels to use as needed by setting panel parent property to different form.     

The DataModule would use the eventForm code for future events Say enable submit button

when channel is on line and data fields all entered. 

27 minutes ago, Lars Fosdal said:

@Pat Foley - That is something entirely different. I was talking about naming parameters to a method.

Oops. sidetracked into Application.Run 

I like the Tshape in VCL  It surfaces the pen and brush for setting in Object inspector properties. 

Here's some simple drawing techniques.

implementation

{$R *.dfm}
uses
  Vcl.Imaging.pngimage;
var
  png: TPngImage;
type
    TStarArray = array[0..10] of TPoint;

var
 StarPoints: TStarArray;

procedure drawStar(aImage: Timage; aPoint: TPoint; Ascale: single);
    begin
      var r: FixedInt := round(1 * ascale);
      var r12: FixedInt := round(0.45 * ascale);
      var tau: double := 2 * pi;
      for var I := Low(StarPoints) to High(StarPoints) do
        begin
          var rf: double;
          If odd(I) then rf:=r12 else rf := r;
          StarPoints[I].X := round(apoint.x + rf * SIN(tau * I/10));
          StarPoints[I].Y := round(apoint.Y + rf * -COS(tau * I/10));
        end;
      aImage.canvas.Brush.color := clred;
      aImage.canvas.polyGON(StarPoints);
    end;
procedure drawStarBM(aBM: TCanvas; aPoint: TPoint; Ascale: single);
    begin
      var r: FixedInt := round(1 * ascale);
      var r12: FixedInt := round(0.45 * ascale);
      var tau: double := 2 * pi;
      for var I := Low(StarPoints) to High(StarPoints) do
        begin
          var rf: double;
          If odd(I) then rf:=r12 else rf := r;
          //SineCosine()
          StarPoints[I].X := round(apoint.x + rf * SIN(tau * I/10));
          StarPoints[I].Y := round(apoint.Y + rf * -COS(tau * I/10));
        end;
      aBM.Brush.color := clred;
      aBM.polygon(StarPoints);
    end;

procedure TForm21.Button1Click(Sender: TObject);
begin
  with
  // self.
  // PaintBox.
    Image1. // finally persistent and could be passed as an argument if refactored
    canvas do
  begin
    var
    s := 'Stars';
    var
    Ycount := Height div 40; //
    var
    Xcount := Width div 80;
    var
      r: TRect;
    Brush.Color := clSilver;
    FillRect(ClientRect);

    for var Y := 0 to Ycount do
      for var X := 0 to Xcount do
      begin
        var
        Xa := 0 + round(X / Xcount * width);
        var
        Ya := 0 + round(Y / Ycount * Height);
        if  ((Xa=0) and (Ya=0)) then
          continue;

        if((Xa=0) or (Ya=0)) then
          Brush.Color := clSkyBlue
        else
          Brush.Color := clYellow;

        r.SetLocation(Xa, Ya);
        r.width := 145;
        r.Height := 80;
        roundrect(TRect(r), 18, 8);
        Textout(Xa + 6, Ya + 6, s);
        if not ((Xa=0) or (Ya=0)) and (random(10)>7) then
        DrawStar(Image1,point(Xa + 65, Ya + 15), 11);
      end;
     //Image1.Picture.SaveToFile('blobs.bmp');
     (*png := TPngImage.Create;
     png.Assign(Image1.Picture.Bitmap);
     png.SaveToFile('blobx.png');  *)

    // publish as html png later done
  end;
end;


// extended Tshape paint 
{ TSuperShape }

procedure TSuperShape.Paint;
var
  w, h: integer;
  textSize: TSize;
begin
  inherited;
  Brush.Color := clBtnFace;
  with Canvas do
  begin
    drawStarBM(Canvas,point(50,50),25);
    font.Size := -15;
	  textSize := TextExtent(Moniker);
	  w := (Width - textSize.cx) div 2;
	  h := (Height - textSize.cy) div 2;
    TextOut(w,h,Moniker);
  end;
end;

8 minutes ago, Lars Fosdal said:

I sometimes wish I could call Delphi code in SQL style.

Run(aText2='my text'); 

i.e. specify individual parameter(s) and leave the rest as their default.

 

 

Quote

//Running Delphi Applications With Parameters
By Zarko Gajic
Updated February 02, 2019
Though it was much more common in the days of DOS, modern operating systems also let you run command line parameters against an application so that you can specify what the application should do.

The same is true for your Delphi application, whether it be for a console application or one with a GUI. You can pass a parameter from Command Prompt in Windows or from the development environment in Delphi, under the Run > Parameters menu option.
//

Quote

btnChangeS.Create(grid1);

 

btnChangeS := TButton.Create(grid1);

  Not that's important or relevant , found this https://stackoverflow.com/questions/7090053/read-all-ini-file-values-with-getprivateprofilestringthis . Would be able to go back to D1 🙂

Wouldn't the subclass work since would still descend from TcustomIniFile?   

1 hour ago, dummzeuch said:

 

if _Ini is TMemIniFile then
  HandleMemIniFile(_Ini)
else if _Ini is TRegistryIniFile then
  HandleRegistryIniFile(_Ini)
else
  raise Exception.Create('Only TMemIniFile or TRegistryIniFile supported');

But this just feels very clunky. Is there any better way?

 

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. 

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!   

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 

Quote

US 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 🙂

  numeric keypad shows . writes , 

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

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;

Quote

PROBLEM:  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.

Quote

the 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.  

Quote

So, 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? 

Quote

It 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;
*)

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.        

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

Quote

Turn 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.  

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;