Jump to content

Pat Foley

Members
  • Content Count

    403
  • Joined

  • Last visited

  • Days Won

    2

Everything posted by Pat Foley

  1. Pat Foley

    Is anybody but me using monitors with different scaling?

    I am running 17" 1920*1080 main and a 23"1920*1080 sec. since the 17" T550 laptop is smaller it's at 125. (running D10.4.2) Anyway using pbrush and alt-screen I took snapshots of your ASCII chart and it was reduced in size depending on monitor taken. I snapped a form in the different monitors and it "pasted" the same even though the form appears bigger on the bigger monitor. Shank when form scaled set to true. Grew when setting pixelsperinch to 120 was 96. Edit // Just dragging a form across monitors produces an interesting effect if Scaled := True. Hard to capture with alt-PrtScr. Using PrtScr key the image shows the form across the screens not adjusted for the dots per inch of the monitors. // end edit.
  2. Pat Foley

    Re-Index a PageControl.PageIndex

    You do not need to modify the PageIndex as Uwe mentions. Since you didn't change the tabIndex at that modification, the pagecontrol is giving out of synch results. Simply remove the for loop changing the pageIndex. Its wrong.
  3. 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.
  4. Pat Foley

    Prevent OnClick to be handled twice

    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.
  5. Oops. sidetracked into Application.Run
  6. Pat Foley

    How to create a grid that looks like this

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

    DBGrid DrawColumnCell

    btnChangeS := TButton.Create(grid1);
  8. 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?
  9. 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.
  10. 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!
  11. 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
  12. 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;
  13. 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');
  14. // 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
  15. 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
  16. 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;
  17. Most people consider this a feature. Append list elsewhere; Keep track of List count and start count at a lastProcessed count to reduce processing.
  18. 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.
  19. 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?
  20. 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; *)
  21. 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.
  22. 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
×