BorlandTalk.com

oleavr@gmail.com · Guest

Hi,

Using Borland Delphi 2005 Professional I'm experiencing some
anomalies when using my newly developed TWinControl-derived component
wrapping WC_IPADDRESS. The component works fine at runtime, and almost
fine at designtime. If I place the component on a form and delete it,
it will make the fonts in the IDE _big_ on first redraw... So it seems
some resource gets freed that shouldn't be, I just haven't yet been
able to figure out exactly what. Would really appreciate it if someone
could take a look at the code for my component below.

TIA,
Ole André

unit IPAddressEdit;

interface

uses
SysUtils, Classes, Controls;

type
TIPAddressEdit = class(TWinControl)
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
private
{ Private declarations }
FIPAddress: Cardinal;

FField0RangeLow: Byte;
FField0RangeHigh: Byte;

FField1RangeLow: Byte;
FField1RangeHigh: Byte;

FField2RangeLow: Byte;
FField2RangeHigh: Byte;

FField3RangeLow: Byte;
FField3RangeHigh: Byte;
protected
{ Protected declarations }
procedure CreateWnd; override;
procedure CreateParams(var Params: TCreateParams); override;

function GetAddress: String;
procedure SetAddress(const Value: String);

procedure SetField0RangeLow(const Value: Byte);
procedure SetField0RangeHigh(const Value: Byte);

procedure SetField1RangeLow(const Value: Byte);
procedure SetField1RangeHigh(const Value: Byte);

procedure SetField2RangeLow(const Value: Byte);
procedure SetField2RangeHigh(const Value: Byte);

procedure SetField3RangeLow(const Value: Byte);
procedure SetField3RangeHigh(const Value: Byte);

procedure SetFieldRangeLow(var LowVar, HighVar: Byte; Value: Byte);
procedure SetFieldRangeHigh(var LowVar, HighVar: Byte; Value:
Byte);

procedure RangeChanged;
public
{ Public declarations }
procedure Clear;
published
{ Published declarations }
property Address: String read GetAddress write SetAddress;

property Field0RangeLow: Byte read FField0RangeLow write
SetField0RangeLow
default 0;
property Field0RangeHigh: Byte read FField0RangeHigh write
SetField0RangeHigh
default 255;

property Field1RangeLow: Byte read FField1RangeLow write
SetField1RangeLow
default 0;
property Field1RangeHigh: Byte read FField1RangeHigh write
SetField1RangeHigh
default 255;

property Field2RangeLow: Byte read FField2RangeLow write
SetField2RangeLow
default 0;
property Field2RangeHigh: Byte read FField2RangeHigh write
SetField2RangeHigh
default 255;

property Field3RangeLow: Byte read FField3RangeLow write
SetField3RangeLow
default 0;
property Field3RangeHigh: Byte read FField3RangeHigh write
SetField3RangeHigh
default 255;

property Width default 125;
property Height default 20;

property Anchors;
property BevelEdges;
property BevelInner;
property BevelKind default bkNone;
property BevelOuter;
property BiDiMode;
property Color;
property Constraints;
property Ctl3D;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property Font;
property ParentBiDiMode;
property ParentColor default False;
property ParentCtl3D;
property ParentFont default True;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property TabOrder;
property TabStop default True;
property Visible;

property OnClick;
property OnDblClick;
property OnContextPopup;
property OnStartDock;
property OnEndDock;
property OnStartDrag;
property OnEndDrag;
property OnDragDrop;
property OnDragOver;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyUp;
property OnKeyPress;
property OnMouseDown;
property OnMouseUp;
property OnMouseMove;
end;

procedure Register;

implementation

uses
Windows, CommCtrl, ComCtrls, {temporary}Dialogs{/temporary};

constructor TIPAddressEdit.Create(AOwner: TComponent);
begin
InitCommonControl(ICC_INTERNET_CLASSES);

inherited Create(AOwner);

FIPAddress := 0;

FField0RangeLow := 0;
FField0RangeHigh := 255;
FField1RangeLow := 0;
FField1RangeHigh := 255;
FField2RangeLow := 0;
FField2RangeHigh := 255;
FField3RangeLow := 0;
FField3RangeHigh := 255;

Width := 125;
Height := 20;

BevelKind := bkNone;
ParentColor := False;
ParentFont := True;
TabStop := True;
end;

destructor TIPAddressEdit.Destroy;
begin
inherited Destroy;
end;

procedure TIPAddressEdit.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
CreateSubClass(Params, WC_IPADDRESS);
end;

procedure TIPAddressEdit.CreateWnd;
begin
inherited CreateWnd;

if HandleAllocated then begin
SendMessage(Handle, IPM_SETADDRESS, 0, FIPAddress);
RangeChanged;
end;

ControlStyle := ControlStyle - [csFixedHeight]
end;

function TIPAddressEdit.GetAddress: String;
begin
if HandleAllocated then
SendMessage(Handle, IPM_GETADDRESS, 0, Cardinal(@FIPAddress));
Result := IntToStr(FIRST_IPADDRESS(FIPAddress)) + '.'
+ IntToStr(SECOND_IPADDRESS(FIPAddress)) + '.'
+ IntToStr(THIRD_IPADDRESS(FIPAddress)) + '.'
+ IntToStr(FOURTH_IPADDRESS(FIPAddress));
end;

procedure TIPAddressEdit.SetAddress(const Value: String);
var
I, Idx, N: Integer;
NewAddr: Cardinal;
Str: String;
begin
Str := Value;
NewAddr := 0;

try
for I := 0 to 3 do begin
Idx := Pos('.', Str);
if Idx <= 0 then
Idx := Length(Str) + 1
else if Idx = 1 then
raise EConvertError.Create(Value + ' is not a valid IP
address');

N := StrToInt(Copy(Str, 1, Idx - 1));
if (N < 0) or (N > 255) then
raise EConvertError.Create(Value + ' is not a valid IP
address');

Delete(Str, 1, Idx);

NewAddr := (NewAddr shl Cool

or Byte(N);
end;
except
raise EConvertError.Create(Value + ' is not a valid IP address');
end;

FIPAddress := NewAddr;
end;

procedure TIPAddressEdit.Clear;
begin
if HandleAllocated then
SendMessage(Handle, IPM_CLEARADDRESS, 0, 0);
FIPAddress := 0;
end;

procedure TIPAddressEdit.SetField0RangeLow(const Value: Byte);
begin
SetFieldRangeLow(FField0RangeLow, FField0RangeHigh, Value);
end;

procedure TIPAddressEdit.SetField0RangeHigh(const Value: Byte);
begin
SetFieldRangeHigh(FField0RangeLow, FField0RangeHigh, Value);
end;

procedure TIPAddressEdit.SetField1RangeLow(const Value: Byte);
begin
SetFieldRangeLow(FField1RangeLow, FField1RangeHigh, Value);
end;

procedure TIPAddressEdit.SetField1RangeHigh(const Value: Byte);
begin
SetFieldRangeHigh(FField1RangeLow, FField1RangeHigh, Value);
end;

procedure TIPAddressEdit.SetField2RangeLow(const Value: Byte);
begin
SetFieldRangeLow(FField2RangeLow, FField2RangeHigh, Value);
end;

procedure TIPAddressEdit.SetField2RangeHigh(const Value: Byte);
begin
SetFieldRangeHigh(FField2RangeLow, FField2RangeHigh, Value);
end;

procedure TIPAddressEdit.SetField3RangeLow(const Value: Byte);
begin
SetFieldRangeLow(FField3RangeLow, FField3RangeHigh, Value);
end;

procedure TIPAddressEdit.SetField3RangeHigh(const Value: Byte);
begin
SetFieldRangeHigh(FField3RangeLow, FField3RangeHigh, Value);
end;

procedure TIPAddressEdit.SetFieldRangeLow(var LowVar, HighVar: Byte;
Value: Byte);
begin
if Value = LowVar then
Exit;

LowVar := Value;

if LowVar > HighVar then
HighVar := LowVar;

RangeChanged;
end;

procedure TIPAddressEdit.SetFieldRangeHigh(var LowVar, HighVar: Byte;
Value: Byte);
begin
if Value = HighVar then
Exit;

HighVar := Value;

if LowVar > HighVar then
LowVar := HighVar;

RangeChanged;
end;

procedure TIPAddressEdit.RangeChanged;
begin
if not HandleAllocated then
Exit;

SendMessage(Handle, IPM_SETRANGE, 0, MAKEIPRANGE(FField0RangeLow,
FField0RangeHigh));
SendMessage(Handle, IPM_SETRANGE, 1, MAKEIPRANGE(FField1RangeLow,
FField1RangeHigh));
SendMessage(Handle, IPM_SETRANGE, 2, MAKEIPRANGE(FField2RangeLow,
FField2RangeHigh));
SendMessage(Handle, IPM_SETRANGE, 3, MAKEIPRANGE(FField3RangeLow,
FField3RangeHigh));
end;

procedure Register;
begin
RegisterComponents('OEM', [TIPAddressEdit]);
end;

end.

oleavr@gmail.com · Guest

Ok, I've found a solution to my problem. Here goes:

(*
* The control frees the font handle on destruction,
* which it shouldn't because it is owned by the VCL
* (which shares font handles between controls).
*
* In order to work around this we duplicate the
* font handle so that the copy gets freed instead
* of the shared handle.
*
* - Ole André
*)
if GetObject(Font.Handle, SizeOf(LF), @LF) <> 0 then begin
Font.Handle := CreateFontIndirect(LF);
end;

Quite a hack, so if someone knows how to prevent WC_IPADDRESS from
freeing the handle on destruction I'd very much like to know. I've
thought about catching one of the DESTROY-messages, but as I don't know
the internals I could very well be preventing other resources from
getting released.

Thanks,
Ole André

[email]oleavr (AT) gmail (DOT) com[/email] skrev:

Riki Wiki · Guest

Hoi Ole

Good that you found a solution yourself. Next time you post you need to the
Borland news server, if you want most people to see your message and
increase your chance of an answer.

Take a look here:
<http://tinyurl.com/8m5nw>
which links to
<http://delphi.wikicities.com/wiki/Delphi_Newsgroups>

oleavr@gmail.com · Guest

Thanks! I've posted there now, hopefully it'll help shed some light on
the subject.

Regards,
Ole André