How can I avoid a form getting focus when dragged - delphi

I have a simple form that only contains a TTouchKeyboard. The forms BorderStyle is set to bsToolWindow. To avoid the form getting focus when clicking the touch keyboard I handle the WM_MOUSEACTIVATE message with this implementation:
procedure TKeyboardForm.WMMouseActivate(var Message: TWMMouseActivate);
begin
Message.Result := MA_NOACTIVATE;
end;
The BorderStyle setting allows the form to be dragged with the title bar, but in that case the form still gets the focus. Is there a way to avoid this?
Update: I tried adding WS_EX_NOACTIVATE to ExStyle in CreateParams, but unfortunately that doesn't hinder the form to receive focus when dragged.
procedure TKeyboardForm.CreateParams(var Params: TCreateParams);
begin
inherited;
Params.ExStyle := Params.ExStyle or WS_EX_NOACTIVATE;
end;

Because I was not very pleased with the approach that requires me to manually update the focused form variable in the keyboard form, I searched for a more transparent solution and came up with this approach.
Update: The previous approach had some issues with VCL styles. In addition not all of the message handlers were really necessary, though others turned out to be helpful, too. This version works well with VCL styles avoiding any flicker as far as possible:
type
TKeyboardForm = class(TForm)
TouchKeyboard1: TTouchKeyboard;
private
FLastFocusedForm: TCustomForm;
procedure SetLastFocusedForm(const Value: TCustomForm);
protected
procedure WMActivate(var Message: TWMActivate); message WM_ACTIVATE;
procedure WMMouseActivate(var Message: TWMMouseActivate); message WM_MOUSEACTIVATE;
procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
property LastFocusedForm: TCustomForm read FLastFocusedForm write SetLastFocusedForm;
public
class constructor Create;
destructor Destroy; override;
function SetFocusedControl(Control: TWinControl): Boolean; override;
end;
type
TKeyboardFormStyleHook = class(TFormStyleHook)
protected
procedure WMNCActivate(var Message: TWMNCActivate); message WM_NCACTIVATE;
end;
procedure TKeyboardFormStyleHook.WMNCActivate(var Message: TWMNCActivate);
begin
{ avoids the title bar being drawn active for blink }
Message.Active := False;
inherited;
end;
class constructor TKeyboardForm.Create;
begin
TCustomStyleEngine.RegisterStyleHook(TKeyboardForm, TKeyboardFormStyleHook);
end;
destructor TKeyboardForm.Destroy;
begin
LastFocusedForm := nil;
inherited;
end;
procedure TKeyboardForm.Notification(AComponent: TComponent; Operation: TOperation);
begin
if (Operation = opRemove) and (AComponent = FLastFocusedForm) then begin
FLastFocusedForm := nil;
end;
inherited;
end;
function TKeyboardForm.SetFocusedControl(Control: TWinControl): Boolean;
begin
LastFocusedForm := Screen.FocusedForm;
result := inherited;
end;
procedure TKeyboardForm.SetLastFocusedForm(const Value: TCustomForm);
begin
if FLastFocusedForm <> Value then
begin
if FLastFocusedForm <> nil then begin
FLastFocusedForm.RemoveFreeNotification(Self);
end;
FLastFocusedForm := Value;
if FLastFocusedForm <> nil then begin
FLastFocusedForm.FreeNotification(Self);
end;
end;
end;
procedure TKeyboardForm.WMActivate(var Message: TWMActivate);
begin
Message.Active := WA_INACTIVE;
inherited;
end;
procedure TKeyboardForm.WMMouseActivate(var Message: TWMMouseActivate);
begin
inherited;
Message.Result := MA_NOACTIVATE;
end;
procedure TKeyboardForm.WMSetFocus(var Message: TWMSetFocus);
begin
inherited;
if (FLastFocusedForm <> nil) and (message.FocusedWnd <> FLastFocusedForm.Handle) then begin
SendMessage(FLastFocusedForm.Handle, WM_SETFOCUS, 0, 0);
Message.FocusedWnd := FLastFocusedForm.Handle;
end;
end;

The following combination of WMMouseActivate(), WMNCActivate() and reseting focus seems to fulfill your wishes:
The keyboard form (with BorderStyle = bsToolWindow) has message handlers for WM_MOUSEACTIVATE (as you already have) and WM_NCACTIVATE. The latter for having a point where to reset focus to the window with the edit control.
In addition the keyboardform will keep track of which form holds the edit (or other) control that has focus, and does that by introducing a new method for showing, which I called ShowUnfocused() and a field called FocusedForm: THandle.
procedure TKbdForm.ShowUnfocused(FocusedWindow: THandle);
begin
FocusedForm := FocusedWindow;
Show;
end;
procedure TKbdForm.FormShow(Sender: TObject);
begin
SetForegroundWindow(FocusedForm);
end;
procedure TKbdForm.WMMouseActivate(var Message: TWMMouseActivate);
begin
Message.Result := MA_NOACTIVATE;
end;
procedure TKbdForm.WMNCActivate(var Message: TWMNCActivate);
begin
Message.Result := 1; // important
SetForegroundWindow(FocusedForm);
end;
The keyboardform is invoked by the following common code of the edit controls:
procedure TForm17.EditClick(Sender: TObject);
begin
KbdForm.ShowUnfocused(self.Handle);
(Sender as TWinControl).SetFocus;
end;
An alternative to what is said above, could be to set the BorderStyle = bsNone and arrange the dragging of the form with the Mouse Down, Move, Up events directly from the forms surface (or maybe a panel to mimic a top frame), and adding a close button. The challenge would be to get it visually acceptable.

Related

ComboBox doesn't behave the same inside panel

Using some answers in StackOverflow I've created a searcheable TComboBox in Delphi. It works fine when you add it directly to a Form, but breaks as soon as you add it to a TPanel and I can't seem to figure out why.
Directly on the form:
After typing t:
Inside a panel:
After typing t:
Here is the component's code:
unit uSmartCombo;
interface
uses
Vcl.StdCtrls, Classes, Winapi.Messages, Controls;
type
TSmartComboBox = class(TComboBox)
private
FStoredItems: TStringList;
procedure FilterItems;
procedure CNCommand(var AMessage: TWMCommand); message CN_COMMAND;
procedure RedefineCombo;
procedure SetStoredItems(const Value: TStringList);
procedure StoredItemsChange(Sender: TObject);
protected
procedure KeyPress(var Key: Char); override;
procedure CloseUp; override;
procedure Loaded; override;
procedure DoExit; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property StoredItems: TStringList read FStoredItems write SetStoredItems;
end;
procedure Register;
implementation
uses
SysUtils, Winapi.Windows, Vcl.Forms;
procedure Register;
begin
RegisterComponents('Standard', [TSmartComboBox]);
end;
constructor TSmartComboBox.Create(AOwner: TComponent);
begin
inherited;
FStoredItems := TStringList.Create;
FStoredItems.OnChange := StoredItemsChange;
end;
destructor TSmartComboBox.Destroy;
begin
FStoredItems.Free;
inherited;
end;
procedure TSmartComboBox.DoExit;
begin
inherited;
RedefineCombo;
end;
procedure TSmartComboBox.Loaded;
var LParent: TWinControl;
LPoint: TPoint;
begin
inherited;
if Items.Count > 0 then
FStoredItems.Assign(Items);
AutoComplete := False;
Style := csDropDownList;
// The ComboBox doesn't behave properly if the parent is not the form.
// Workaround to pull it from any parenting
//if not (Parent is TForm) then
//begin
// LParent := Parent;
// while (not (LParent is TForm)) and Assigned(LParent) do
// LParent := LParent.Parent;
// LPoint := ClientToParent(Point(0,0), LParent);
// Parent := LParent;
// Left := LPoint.X;
// Top := LPoint.Y;
// BringToFront;
//end;
end;
procedure TSmartComboBox.RedefineCombo;
var S: String;
begin
if Style = csDropDown then
begin
if ItemIndex <> -1 then
S := Items[ItemIndex];
Style := csDropDownList;
Items.Assign(FStoredItems);
if S <> '' then
ItemIndex := Items.IndexOf(S);
end;
end;
procedure TSmartComboBox.SetStoredItems(const Value: TStringList);
begin
if Assigned(FStoredItems) then
FStoredItems.Assign(Value)
else
FStoredItems := Value;
end;
procedure TSmartComboBox.StoredItemsChange(Sender: TObject);
begin
if Assigned(FStoredItems) then
begin
RedefineCombo;
Items.Assign(FStoredItems);
end;
end;
procedure TSmartComboBox.KeyPress(var Key: Char);
begin
if CharInSet(Key, ['a'..'z']) and not (Style = csDropDown) then
begin
DroppedDown := False;
Style := csDropDown;
end;
inherited;
if not (Ord(Key) in [13,27]) then
DroppedDown := True;
end;
procedure TSmartComboBox.CloseUp;
begin
if Style = csDropDown then
RedefineCombo;
inherited;
end;
procedure TSmartComboBox.CNCommand(var AMessage: TWMCommand);
begin
inherited;
if (AMessage.Ctl = Handle) and (AMessage.NotifyCode = CBN_EDITUPDATE) then
FilterItems;
end;
procedure TSmartComboBox.FilterItems;
var I: Integer;
Selection: TSelection;
begin
SendMessage(Handle, CB_GETEDITSEL, WPARAM(#Selection.StartPos), LPARAM(#Selection.EndPos));
Items.BeginUpdate;
Try
if Text <> '' then
begin
Items.Clear;
for I := 0 to FStoredItems.Count - 1 do
if (Pos(Uppercase(Text), Uppercase(FStoredItems[I])) > 0) then
Items.Add(FStoredItems[I]);
end
else
Items.Assign(FStoredItems);
Finally
Items.EndUpdate;
End;
SendMessage(Handle, CB_SETEDITSEL, 0, MakeLParam(Selection.StartPos, Selection.EndPos));
end;
end.
Any help in how I can proceed to figure out why this is happening would be greatly appreciated!
Edit 1:
After doing some extra debugging, I've noticed the messages being sent to the ComboBox differ from the ones inside the panel.
A CBN_EDITUPDATE is never sent, like #Sherlock70 mentioned in the comments, which makes the FilterItems procedure never trigger.
I've also noticed the form behaves strangely after using the ComboBox inside the panel, sometimes freezing and even not responding, like it gets stuck in a loop.
This unpredictable behavior has made me move away from this approach, and I'm probably going to take an alternate route to create a "searchable ComboBox".
Going to leave the question open if someone wants to figure it out and maybe even use the component.
I hope this will help someone in future even after 7 months of the question. Setting the style of a Combobox will destroy the window handle of that Combobox and create a new one. This means windows will free your control's Window Handle and create a new one.
You are setting your Combobx style while searching and this is wrong. Try removing Style := from your code and test it again you will get the same results for Combobox on a form and Combobox on a panel or other TWinControl. As you can see in the following code, setting Style will call RecreateWnd.
procedure TCustomComboBox.SetStyle(Value: TComboBoxStyle);
begin
if FStyle <> Value then
begin
FStyle := Value;
if Value = csSimple then
ControlStyle := ControlStyle - [csFixedHeight] else
ControlStyle := ControlStyle + [csFixedHeight];
RecreateWnd;
end;
end;
RecreateWnd will call DestroyHandle()
procedure TWinControl.CMRecreateWnd(var Message: TMessage);
var
WasFocused: Boolean;
begin
WasFocused := Focused;
DestroyHandle;
UpdateControlState;
if WasFocused and (FHandle <> 0) then Windows.SetFocus(FHandle);
end;
Then DestroyHandle will call DestroyWnd() which will call DestroyWindowHandle().

How to stop TRadioButton reacting at arrow keys?

I have a panel with a few TRadioButtons placed horizontally. If the most left button is focused and I press Left Arrow, the focus jumps to the most right button. I want to stop this behavoir for all arrows when they reach the edge. Is it possible ?
I tried overriding the WM_KEYDOWN but the buttons never receive this message when a arrow key is pressed.
TRadioButton = class(StdCtrls.TRadioButton)
protected
procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
procedure WMKeyUp(var Message: TWMKeyUp); message WM_KEYUP;
public
BlockLeft, BlockRight: Boolean;
constructor Create(AOwner: TComponent); override;
end;
constructor TRadioButton.Create(AOwner: TComponent);
begin
inherited;
BlockLeft:= False;
BlockRight:= False;
end;
procedure TRadioButton.WMKeyDown(var Message: TWMKeyDown);
begin
if BlockLeft and (Message.CharCode = VK_LEFT) then Exit;
if BlockRight and (Message.CharCode = VK_RIGHT) then Exit;
inherited;
end;
procedure TRadioButton.WMKeyUp(var Message: TWMKeyUp);
begin
if BlockLeft and (Message.CharCode = VK_LEFT) then Exit;
if BlockRight and (Message.CharCode = VK_RIGHT) then Exit;
inherited;
end;
VCL offsets keyboard messages to become a control notification and sends it to the message's destined control. Hence you should be intercepting a CN_KEYDOWN message instead.
If this is for a one time design consideration, I would prefer to handle this behavior at the form level since IMO a control, itself, shouldn't care where it is placed on. For a form where all radio buttons are expected to behave similar, an example could be:
procedure TForm1.CMDialogKey(var Message: TCMDialogKey);
begin
if ActiveControl is TRadioButton then
case Message.CharCode of
VK_LEFT, VK_UP: begin
if ActiveControl.Parent.Controls[0] = ActiveControl then begin
Message.Result := 1;
Exit;
end;
end;
VK_RIGHT, VK_DOWN: begin
if ActiveControl.Parent.Controls[ActiveControl.Parent.ControlCount - 1]
= ActiveControl then begin
Message.Result := 1;
Exit;
end;
end;
end;
inherited;
end;
If this is not for a one time behavior, I'd go for writing a container control as Victoria mentioned in the comments to the question.

ModalResult not acting inside of a component

Below you can see the code for a component that have inside a TPersistent class that allow me to assign some TCustomButtons (TButton or TBitBtn).
I place my component on a modal form and I assign the 2 buttons (OK and Cancel).
Normally when I press any of this buttons, my form should getting closed.
My question is why the form is not getting closed?
type
TMyComp = class;
TButtons = class;
TMyComp = class(TComponent)
private
FButtons: TButtons;
procedure SetButtons(Value: TButtons);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Buttons: TButtons read FButtons write SetButtons;
end;
TButtons = class(TPersistent)
private
FOwner: TMyComp;
FBtnOk: TCustomButton;
FBtnCancel: TCustomButton;
procedure SetCustomButton(Index: Integer; Value: TCustomButton);
procedure BtnOkOnClick(Sender: TObject);
procedure BtnCancelOnClick(Sender: TObject);
protected
public
constructor Create(AOwner: TMyComp); virtual;
procedure Assign(Source: TPersistent); override;
published
property BtnOk: TCustomButton index 0 read FBtnOk write SetCustomButton;
property BtnCancel: TCustomButton index 1 read FBtnCancel write SetCustomButton;
end;
implementation
constructor TMyComp.Create(AOwner: TComponent);
begin
inherited;
FButtons:= TButtons.Create(Self);
end;
destructor TMyComp.Destroy;
begin
FButtons.Free;
inherited;
end;
//------- TButtons ---------
constructor TButtons.Create(AOwner: TMyComp);
begin
inherited Create;
FOwner:= AOwner;
end;
procedure TButtons.Assign(Source: TPersistent);
begin
if Source is TButtons then
begin
FBtnOk:= TButtons(Source).BtnOk;
FBtnCancel:= TButtons(Source).BtnCancel;
end
else
inherited Assign(Source);
end;
procedure TButtons.SetCustomButton(Index: Integer; Value: TCustomButton);
begin
case Index of
0: if FBtnOk <> Value then
begin
FBtnOk:= Value;
if Assigned(FBtnOk) then
begin
//TBitBtn
if (FBtnOk is TBitBtn) then
(FBtnOk as TBitBtn).OnClick:= BtnOkOnClick;
//TButton
if (FBtnOk is TButton) then
(FBtnOk as TButton).OnClick:= BtnOkOnClick;
end;
end;
1: if FBtnCancel <> Value then
begin
FBtnCancel:= Value;
if Assigned(FBtnCancel) then
begin
//TBitBtn
if (FBtnCancel is TBitBtn) then
(FBtnCancel as TBitBtn).OnClick:= BtnCancelOnClick;
//TButton
if (FBtnCancel is TButton) then
(FBtnCancel as TButton).OnClick:= BtnCancelOnClick;
end;
end;
end;
if Assigned(Value) then Value.FreeNotification(FOwner);
end;
procedure TButtons.BtnCancelOnClick(Sender: TObject);
begin
showmessage('Cancel pressed!');
if Sender is TButton then
(Sender as TButton).ModalResult:= mrCancel;
if Sender is TBitBtn then
(Sender as TBitBtn).ModalResult:= mrCancel;
end;
procedure TButtons.BtnOkOnClick(Sender: TObject);
begin
//do some input validations here...
showmessage('Ok pressed!');
if Sender is TButton then
(Sender as TButton).ModalResult:= mrOk;
if Sender is TBitBtn then
(Sender as TBitBtn).ModalResult:= mrOk;
end;
Other answers/comments have explained why the code is not working - you are setting the button's ModalResult too late, so it is not propagating to the Form's ModalResult when you are expecting it to be.
I want to suggest an alternative implementation that also incorporates a solution, and addresses some other things your code is lacking:
type
TButtons = class;
TMyComp = class(TComponent)
private
FButtons: TButtons;
procedure SetButtons(Value: TButtons);
protected
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Buttons: TButtons read FButtons write SetButtons;
end;
TButtons = class(TPersistent)
private
FOwner: TMyComp;
FButtons: array[0..1] of TCustomButton;
FClickEvents: array[0..1] of TNotifyEvent;
function GetCustomButton(Index: Integer): TCustomButton;
procedure SetCustomButton(Index: Integer; Value: TCustomButton);
procedure BtnOkOnClick(Sender: TObject);
procedure BtnCancelOnClick(Sender: TObject);
public
constructor Create(AOwner: TMyComp);
destructor Destroy; override;
procedure Assign(Source: TPersistent); override;
published
property BtnOk: TCustomButton index 0 read GetCustomButton write SetCustomButton;
property BtnCancel: TCustomButton index 1 read GetCustomButton write SetCustomButton;
end;
implementation
//------- TMyComp ---------
constructor TMyComp.Create(AOwner: TComponent);
begin
inherited;
FButtons := TButtons.Create(Self);
end;
destructor TMyComp.Destroy;
begin
FButtons.Free;
inherited;
end;
procedure TMyComp.Notification(AComponent: TComponent; Operation: TOperation);
var
i: Index;
begin
inherited;
if Operation = opRemove then
begin
for i := Low(FButtons.FButtons) to High(FButtons.FButtons) do
begin
if AComponent = FButtons.FButtons[i] then
begin
FButtons.FButtons[i] := nil;
FButtons.FClickEvents[i] := nil;
Exit;
end;
end;
end;
end;
//------- TButtons ---------
constructor TButtons.Create(AOwner: TMyComp);
begin
inherited Create;
FOwner := AOwner;
end;
constructor TButtons.Destroy;
begin
Assign(nil);
inherited;
end;
procedure TButtons.Assign(Source: TPersistent);
var
i: Integer;
begin
if Source = nil then
begin
for i to Low(FButtons) to High(FButtons) do
SetCustomButton(i, nil);
end
else if Source is TButtons then
begin
for i to Low(FButtons) to High(FButtons) do
SetCustomButton(i, TButtons(Source).FButtons[i]);
end
else
inherited Assign(Source);
end;
function TButtons.GetCustomButton(Index: Integer): TCustomButton;
begin
Result := FButtons[Index];
end;
type
TCustomButtonAccess = class(TCustomButton)
end;
procedure TButtons.SetCustomButton(Index: Integer; Value: TCustomButton);
begin
if FButtons[Index] <> Value then
begin
if Assigned(FButtons[Index]) then
begin
TCustomButtonAccess(Value).OnClick := FClickEvents[Index];
FClickEvents[Index] := nil;
FButtons[Index].RemoveFreeNotification(FOwner);
end;
FButtons[Index] := Value;
if Assigned(Value) then
begin
Value.FreeNotification(FOwner);
FClickEvents[Index] := TCustomButtonAccess(Value).OnClick;
case Index of
0: TCustomButtonAccess(Value).OnClick := BtnOkOnClick;
1: TCustomButtonAccess(Value).OnClick := BtnCancelOnClick;
end;
end;
end;
end;
procedure TButtons.BtnOkOnClick(Sender: TObject);
var
Form: TCustomForm;
begin
//do some input validations here...
ShowMessage('Ok pressed!');
Form := GetParentForm(TControl(Sender));
if Form <> nil then
Form.ModalResult := mrOk;
// optional
if Assigned(FClickEvents[0]) then
FClickEvents[0](Sender);
end;
procedure TButtons.BtnCancelOnClick(Sender: TObject);
var
Form: TCustomForm;
begin
ShowMessage('Cancel pressed!');
Form := GetParentForm(TControl(Sender));
if Form <> nil then
Form.ModalResult := mrCancel;
// optional
if Assigned(FClickEvents[1]) then
FClickEvents[1](Sender);
end;
A simpler reproduction case can be like this:
Create an application with two forms, remove second form from the auto-created forms list. Add a button on each form with the following click handlers.
In unit1:
procedure TForm1.Button1Click(Sender: TObject);
var
F: TForm;
begin
F := TForm2.Create(nil);
try
F.ShowModal;
finally
F.Free;
end;
end;
In unit2:
procedure TForm2.Button1Click(Sender: TObject);
begin
Button1.ModalResult := mrOk;
end;
Run application, press button to launch the modal form. Press button on second form, the form does not close.
The reason the form is not closed is, the button's click handler is too late to set the modal result of the form.
You can see why it is too late from the code in TCustomButton.Click; in 'Vcl.StdCtrls.pas'. Comments are by me.
procedure TCustomButton.Click;
var
Form: TCustomForm;
begin
Form := GetParentForm(Self);
if Form <> nil then Form.ModalResult := ModalResult; // this is where modal result is checked
inherited Click; // this is where your click handler is run
end;
You'd notice a second click closes the form. That's because the button's modal result is already set after the first click.
In your event handler you're setting ModalResult of the button. A modal form closes when that form's ModalResult is set.
The purpose of a button's ModalResult is that the framework will set the parent form's ModalResult to the same value.
Setting the button component's ModalResult property is an easy way to make clicking the button close a modal form. When a button is clicked, the ModalResult property of its parent form is set to the same value as the button's ModalResult property.
For example, if a dialog box has OK and Cancel buttons, their ModalResult properties could be set at design time to mrOk and mrCancel, respectively. At run time, clicking the OK button then changes the dialog's ModalResult property to mrOk, and clicking the Cancel button changes the dialog's ModalResult property to mrCancel. Unless further processing is required, no OnClick event handlers are required for the buttons.
So, basically what you're doing wrong is that you failed to predefine the ModalResult of the button. So:
At the time the button is clicked, its ModalResult is still mrNone.
And therefore doesn't change the form's ModalResult.
(I suspect that if you click the button a second time it will behave as you expect.)
To resolve your problem, you have 2 options:
Preferably set the ModalResult of the button sooner. There's no reason for a "Cancel" button to ever have a ModalResult <> mrCancel. That's why it's usually streamed in the DFM.
If you absolutely must use the event handler; set the form's ModalResult.

Seeking FOSS IPv4 address picker VCL component

Strictly for use in the reserved address ranges, so IPv4 is good enough. I don't know yet if I will use class A, B or C (probably C, but ...) so it would be a bonus to be able to handle all.
And extra bonus if I can also enter something like "localhost", although I can live without that.
So, minimum requirement is to specify a 192.xxx.xxx.xxx and make sure that xxx does not exceed 255.
Sure, I could knock one up with a few mask edits, but surely someone has invented that particular (FOSS) wheel before?
Note to self: if you do have to code it, this page looks useful
Windows has a built-in IP Address edit control. You can wrap that in a custom TWinControl descendant component for easy access and reuse, eg:
type
TIPAddressFieldChange = procedure(Sender: TObject; Field: Integer; Value: Integer) of object;
TIPAddress = class(TWinControl)
private
FOnFieldChange: TIPAddressFieldChange;
function GetIP: String;
function GetIsEmpty: Boolean;
procedure SetIP(const Value: String);
protected
procedure CreateParams(var Params: TCreateParams); override;
procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
procedure WMGetDlgCode(var Message: TMessage); message WM_GETDLGCODE;
procedure WMSetFont(var Message: TWMSetFont); message WM_SETFONT;
public
constructor Create(Owner: TComponent); override;
procedure Clear;
property IP: String read GetIP write SetIP;
property IsEmpty: Boolean read GetIsEmpty;
published:
property OnFieldChange: TIPAddressFieldChange read FOnFieldChange write FOnFieldChange;
end;
.
uses
Commctrl;
constructor TIPAddress.Create(Owner: TComponent);
begin
inherited;
InitCommonControl(ICC_INTERNET_CLASSES};
end;
procedure TIPAddress.CreateParams(var Params: TCreateParams);
begin
inherited;
CreateSubClass(Params, WC_IPADDRESS);
Params.Style := WS_CHILD or WS_TABSTOP or WS_VISIBLE;
if NewStyleControls and Ctl3D then
begin
Params.Style := Params.Style and not WS_BORDER;
Params.ExStyle := Params.ExStyle or WS_EX_CLIENTEDGE;
end;
Params.WindowClass.style := Params.WindowClass.style and not (CS_HREDRAW or CS_VREDRAW);
end;
procedure TIPAddress.Clear;
begin
Perform(IPM_CLEARADDRESS, 0, 0);
end;
function TIPAddress.GetIP: String;
var
dwIp: DWORD;
begin
dwIp := 0;
Perform(IPM_GETADDRESS, 0, LPARAM(#dwIp));
Result := Format('%d.%d.%d.%d', [FIRST_IPADDRESS(dwIp), SECOND_IPADDRESS(dwIp),
THIRD_IPADDRESS(dwIp), FOURTH_IPADDRESS(dwIp)]);
end;
function TIPAddress.GetIsEmpty: Boolean;
begin
Result := Perform(IPM_ISBLANK, 0, 0) <> 0;
end;
procedure TIPAddress.SetIP(const Value: String);
var
dwIP: LPARAM;
begin
with TStringList.Create do try
Delimiter := '.';
StrictDelimiter := True;
DelimitedText := Value;
Assert(Count = 4);
dwIP := MAKEIPADDRESS(StrToInt(Strings[0]), StrToInt(Strings[1]), StrToInt(Strings[2]), StrToInt(Strings[3]));
finally
Free;
end;
Perform(IPM_SETADDRESS, 0, dwIP);
end;
procedure TIPAddress.CNNotify(var Message: TWMNotify);
begin
inherited;
if (Message.NMHdr^.code = IPN_FIELDCHANGED) and Assigned(FOnFieldChange) then
begin
with PNMIPAddress(Message.NMHdr)^ do
FOnFieldChange(Self, iField, iValue);
end;
end;
procedure TIPAddress.WMGetDlgCode(var Message: TMessage);
begin
inherited;
Message.Result := Message.Result or DLGC_WANTARROWS;
end;
procedure TIPAddress.WMSetFont(var Message: TWMSetFont);
var
LF: LOGFONT;
begin
if GetObject(Message.Font, SizeOf(LF), #LF) <> 0 then
begin
Message.Font := CreateFontIndirect(LF);
inherited;
end;
end;
What about to try the TJvIPAddress from the JEDI Visual Component Library ? It has the automatic range value correction and it derives from the standard Windows IP edit box.

How to set background image for Edit (Delphi)

how can i have a image for Editbox background ?
This is very possible, indeed. In your form, define
private
{ Private declarations }
FBitmap: TBitmap;
FBrush: HBRUSH;
protected
procedure WndProc(var Message: TMessage); override;
and do
procedure TForm1.FormCreate(Sender: TObject);
begin
FBitmap := TBitmap.Create;
FBitmap.LoadFromFile('C:\Users\Andreas Rejbrand\Pictures\AS20Utv.bmp');
FBrush := 0;
FBrush := CreatePatternBrush(FBitmap.Handle);
end;
and
procedure TForm1.WndProc(var Message: TMessage);
begin
inherited;
case Message.Msg of
WM_CTLCOLOREDIT, WM_CTLCOLORSTATIC:
if (Message.LParam = Edit1.Handle) and (FBrush <> 0) then
begin
SetBkMode(Message.WParam, TRANSPARENT);
Message.Result := FBrush;
end;
end;
end;
Of course you can wrap this into a component of your own, say TEditEx. If I get time over, I might do this. (And, notice that there is no need to buy an expensive (and maybe not that high-quality) component pack from a third-party company.)

Resources