davornik

I had to remove WP-plugin from Layout for now, it was exactly what I (and we all) need in previous versions, but now it is unusable I have to use "Open Recent" Hope you will fix it fast.

I am using the GKSoft welcome component https://dwp.gksoft.ch/en/index.html to move between projects in the newest Delphi Athens 12.3. When I click to open another project file, it adds it to the current ProjectGroup instead of closing the previous project and then opening a new one. This was not the case in Delphi Athens 12.2. What do I need to set to return to previous behavior?

If I correctly understood goal is to then find private TGlyph class name and then its handle? TGlyph is private inside the Vcl.ButtonedEdit unit. I can search for Glyph handle, and do GetWindowLongPtr/SetWindowLongPtr to detect WM_LBUTTONDOWN and WM_LBUTTONUP messages. var OldGlyphWndProc: Pointer = nil; function CustomGlyphWndProc(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; begin if Msg = WM_LBUTTONUP then Form1.ButtonedEdit1.PasswordChar:='*' // <- this does not fire else if Msg = WM_LBUTTONDOWN then Form1.ButtonedEdit1.PasswordChar:=#0; // <- this now fires Result := CallWindowProc(OldGlyphWndProc, hWnd, Msg, wParam, lParam); end; procedure SubclassRightButtonGlyph(Edit: TButtonedEdit); var GlyphHandle: HWND; ClassName: array[0..255] of Char; begin GlyphHandle := GetWindow(Edit.Handle, GW_CHILD); while GlyphHandle <> 0 do begin if GetClassName(GlyphHandle, ClassName, Length(ClassName)) > 0 then if ClassName = 'TEditButton.TGlyph' then begin OldGlyphWndProc := Pointer(GetWindowLongPtr(GlyphHandle, GWL_WNDPROC)); SetWindowLongPtr(GlyphHandle, GWL_WNDPROC, LONG_PTR(@CustomGlyphWndProc)); Break; end; GlyphHandle := GetWindow(Edit.Handle, GW_HWNDNEXT); end; end; procedure TForm1.FormCreate(Sender: TObject); begin SubclassRightButtonGlyph(ButtonedEdit1); end; How I can see password OnMouseDown, but it does not goes to hidden OnMouseUp?

Is it possible to detect OnMouseDown and on MouseUp events on the TButtonedEdit RightButton (TEditButton)? I am trying to set it to Show/Hide password when I press/unpress the right button, but there is only an OnClick event for the right button. Tried also subclassing, but there is no handle for the right button in TButtonedEdit? procedure TForm1.FormCreate(Sender: TObject); begin //SetWindowSubclass(ButtonedEdit1.RightButton.Handle, @ButtonedEditSubclassProc, 1, DWORD_PTR(ButtonedEdit1.RightButton)); <- no Handle for RightButton SetWindowSubclass(ButtonedEdit1.Handle, @ButtonedEditSubclassProc, 1, DWORD_PTR(ButtonedEdit1)); end; function ButtonedEditSubclassProc(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM; uIdSubclass: UINT_PTR; dwRefData: DWORD_PTR): LRESULT; stdcall; begin case uMsg of WM_LBUTTONDOWN: Form1.ButtonedEdit1.PasswordChar:=#0; WM_LBUTTONUP: Form1.ButtonedEdit1.PasswordChar:='*'; WM_NCDESTROY: RemoveWindowSubclass(hWnd, @ButtonedEditSubclassProc, uIdSubclass); end; Result := DefSubclassProc(hWnd, uMsg, wParam, lParam); end; Password is hidden When I press right button is it possible for password to be shown and on unpress to be hidden again?

Finally, made it work 🙂 ... procedure DrawColoredTxt(aBtn: TButton; aCaption: string); private FOriginalButtonProc: LONG_PTR; FButtonWndProcInstance: Pointer; procedure ButtonWndProc(var Message: TMessage); ... procedure TForm1.DrawColoredTxt(aBtn: TButton; aCaption: string); ... end; procedure TForm1.ButtonWndProc(var Message: TMessage); var PS: TPaintStruct; begin case Message.Msg of WM_PAINT: begin BeginPaint(Button2.Handle, PS); try // 1. Let Windows paint default button CallWindowProc(Pointer(FOriginalButtonProc), Button2.Handle, Message.Msg, Message.WParam, Message.LParam); // 2. Add our custom text DrawColoredTxt(Button2, 'Admin'); finally EndPaint(Button2.Handle, PS); end; end; // Forward all other messages to original handler else Message.Result := CallWindowProc(Pointer(FOriginalButtonProc), Button2.Handle, Message.Msg, Message.wParam, Message.lParam); end; end; procedure TForm1.Button1Click(Sender: TObject); begin //do OnCreate // 1. Create a method pointer instance FButtonWndProcInstance := MakeObjectInstance(ButtonWndProc); // 2. Store original proc FOriginalButtonProc := GetWindowLongPtr(Button2.Handle, GWLP_WNDPROC); // 3. Set new proc using the instance SetWindowLongPtr(Button2.Handle, GWLP_WNDPROC, LONG_PTR(FButtonWndProcInstance)); Button2.Repaint; end; procedure TForm1.Button3Click(Sender: TObject); begin //do OnDestroy if (Button2.HandleAllocated) and (FOriginalButtonProc <> 0) then SetWindowLongPtr(Button2.Handle, GWLP_WNDPROC, FOriginalButtonProc); // Clean up the method pointer if Assigned(FButtonWndProcInstance) then FreeObjectInstance(FButtonWndProcInstance); Button2.Caption := 'Admin'; Button2.Repaint; end; Literally, I can now set color and clear it 🙂

I have tried to catch OnPaint message, something like this, but no success 😞 ... procedure DrawColoredTxt(aBtn: TButton; aCaption: string); private procedure WM_PAINT(var Msg: TWMPaint); message WM_PAINT; ... procedure TForm1.DrawColoredTxt(aBtn: TButton; aCaption: string); var Canvas: TCanvas; R: TRect; begin aBtn.Caption := ''; // Clear default caption to avoid overlap Canvas := TCanvas.Create; try Canvas.Handle := GetDC(aBtn.Handle); try //Draw default button appearance SendMessage(aBtn.Handle, WM_ERASEBKGND, Canvas.Handle, 0); SendMessage(aBtn.Handle, WM_PRINTCLIENT, Canvas.Handle, PRF_CLIENT); // Draw custom text R := aBtn.ClientRect; Inc(R.Left, -15); //move to left for width of drop-down-split-btn Canvas.Brush.Style := bsClear; Canvas.Font.Color := clRed; // Change font color DrawText(Canvas.Handle, PChar(aCaption), -1, R, DT_CENTER or DT_VCENTER or DT_SINGLELINE); finally ReleaseDC(aBtn.Handle, Canvas.Handle); end; finally Canvas.Free; end; end; //OnPaint Msg procedure TForm1.WM_PAINT(var Msg: TWMPaint); begin inherited; if Assigned(Button2) then DrawColoredTxt(Button2, 'Admin'); //<- this does not work end; procedure TForm1.Button1Click(Sender: TObject); begin DrawColoredTxt(Button2, 'Admin'); //<- this works end; What am I missing?

U should use Format 🙂

What I like about Delphi and Windows is that there is always some way for a workaround 🙂 I have tried to do drawtext over text on TButton and it works partially. var aCaption: string; procedure DrawColoredTxt(aBtn: TButton); var Canvas: TCanvas; R: TRect; begin // Bckp Caption if aCaption = '' then begin aCaption:=aBtn.Caption; aBtn.Caption := ''; // Hide default caption to avoid overlap end; //DoDraw Canvas := TCanvas.Create; try Canvas.Handle := GetDC(aBtn.Handle); try R := aBtn.ClientRect; Inc(R.Left, -15); //move to left for width of dropsplitbtn Canvas.Brush.Style := bsClear; Canvas.Font.Color := clRed; // Change font color DrawText(Canvas.Handle, PChar(aCaption), -1, R, DT_CENTER or DT_VCENTER or DT_SINGLELINE); finally ReleaseDC(aBtn.Handle, Canvas.Handle); end; finally Canvas.Free; end; end; procedure TForm1.Button1Click(Sender: TObject); begin DrawColoredTxt(Button2); end; I get changed font color like this: But when I move the mouse into Button2 everything falls apart 😞 Is there any way to fix this to have properly painted text in Button2?

I have seen this example. Is there any way to just change font color without drawing a complete button?

Unfortunatelly, TButton is exactly what I need because TCustomButton.TButtonStyle.bsSplitButton State.

I am trying to use TButton, but with changed caption Font.Color. Remy suggested to use BS_OWNERDRAW and intercept WM_DRAWITEM. and here also to subclass: https://stackoverflow.com/a/23125580 I tried it to use like this but no success, font color does not change. ... type TMyButton = class(TButton) protected procedure CreateParams(var Params: TCreateParams); override; end; function ButtonSubclassProc(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM; uIdSubclass: UINT_PTR; dwRefData: DWORD_PTR): LRESULT; stdcall; var btnFntClr: TMyButton; ... function ButtonSubclassProc(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM; uIdSubclass: UINT_PTR; dwRefData: DWORD_PTR): LRESULT; stdcall; begin case uMsg of WM_DRAWITEM: TMyButton(dwRefData).Font.Color := clRed; WM_NCDESTROY: RemoveWindowSubclass(hWnd, @ButtonSubclassProc, uIdSubclass); end; Result := DefSubclassProc(hWnd, uMsg, wParam, lParam); end; procedure TMyButton.CreateParams(var Params: TCreateParams); begin inherited CreateParams(Params); with Params do Style := Style or BS_OWNERDRAW; end; procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); begin btnFntClr.Free; end; procedure TForm1.FormCreate(Sender: TObject); begin btnFntClr:=TMyButton.Create(Form1); btnFntClr.Parent:=Form1; btnFntClr.Style:=TCustomButton.TButtonStyle.bsSplitButton; btnFntClr.Caption:='Options'; with btnFntClr do begin Left:=10; Top:=10; Width:=120; end; SetWindowSubclass(btnFntClr.Handle, @ButtonSubclassProc, 1, DWORD_PTR(btnFntClr)); end; How to properly change font color in TButton?

Yes, that is ok, but a solution with an "attached" TPanel (TStatusbar) is more practical. I have found in some article on SO from Remy Lebeau (thanks Remy for help) that in Designmode you must override WM_NCHitTest message to move TPanel with DBGrid! ... protected procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHitTest; ... procedure TEnhDBGrid.WMNCHitTest(var Message: TWMNCHitTest); begin inherited; if (csDesigning in ComponentState) then SetRecPanelPos; end; That's what I tried first, but it does not work. Since DBGrid is usually placed on TForm, RecPanel.Parent:=TWinControl(AOwner); will be better alternative, thanks.

No, Panel is below DBGrid because of that. Only thing left is to move it when DBGrid moves in Designmode. Everything else works fine, did not notice any other issue (yet ).

This would be component in simplest way possible. On Resize, TPanel moves/resizes with DBGrid. Only thing I don't know is how to make TPanel move with DBGrid in DesignMode? unit EnhDBGrid; interface uses SysUtils, Classes, DBGrids, ExtCtrls, Messages; type TEnhDBGrid = class(TDBGrid) private RecPanel: TPanel; procedure SetRecPanelPos; protected procedure UpdateScrollBar; override; procedure Resize; override; public constructor Create(AOwner: TComponent); override; end; procedure Register; implementation constructor TEnhDBGrid.Create(AOwner: TComponent); begin inherited; RecPanel:=TPanel.Create(Self); RecPanel.Parent:=TDBGrid(AOwner); RecPanel.Alignment:=taLeftJustify; RecPanel.Caption := '0/0'; RecPanel.Height := 16; end; procedure TEnhDBGrid.Resize; begin inherited; if Assigned(RecPanel) then SetRecPanelPos; end; procedure TEnhDBGrid.UpdateScrollBar; begin inherited; // to keep the expected behavior if Assigned(DataSource) and Assigned(DataSource.DataSet) and DataSource.DataSet.Active then RecPanel.Caption := DataSource.DataSet.RecNo.ToString+'/'+DataSource.DataSet.RecordCount.ToString; end; procedure TEnhDBGrid.SetRecPanelPos; begin RecPanel.Left := Left; RecPanel.Width := Width; RecPanel.Top := Top + Height; end; procedure Register; begin RegisterComponents('Data Controls', [TEnhDBGrid]); end; end.

Ok, then probably the next step is to make it like this without destructor, perhaps like this? type TDBGrid = class(Vcl.DBGrids.TDBGrid) private RecPanel: TPanel; procedure SetRecPanelPos; protected procedure UpdateScrollBar; override; procedure Resize; override; public constructor Create(AOwner: TComponent); override; end; ... procedure TDBGrid.SetRecPanelPos; begin RecPanel.Left := Self.Left; RecPanel.Width := Self.Width; RecPanel.Top := Self.Top + Self.Height end; procedure TDBGrid.Resize; begin inherited; SetRecPanelPos; end; procedure TDBGrid.UpdateScrollBar; begin //this must be updated here if Assigned(Self.DataSource.DataSet) then RecPanel.Caption := Self.DataSource.DataSet.RecNo.ToString+'/'+Self.DataSource.DataSet.RecordCount.ToString; inherited; // to keep the expected behavior end; constructor TDBGrid.Create(AOwner: TComponent); begin inherited; RecPanel:=TPanel.Create(Self); RecPanel.Parent:=TDBGrid(AOwner); RecPanel.Alignment:=taLeftJustify; RecPanel.Caption := '0/0'; RecPanel.Height := 16; end; As far of DataChange event, then I get a message like this: Method 'DataChange' not found in base class... When doing it like this in designtime I don't have Panel shown below the DBGrid. I always have to reduce height of DBGrid for height of Panel. I suppose the next step is to create it like a component and install it in Delphi? Then Panel would be shown in designtime?