BorlandTalk.com

source code sale · Guest

I am trying to make this component work in D6.
can any body tell which part of this componet should be in the design
time
and which in run time?
Thank you.

{*******************************************************}
{ Run-Time Object Inspector component v1.2 }
{ Author: Gennadie Zuev }
{ E-mail: [email]zuev (AT) micex (DOT) ru[/email] }
{ Web: http://unicorn.micex.ru/users/gena }
{ }
{ Copyright (c) 1999 Gennadie Zuev }
{ }
{ Modified by Hector Mauricio Rodriguez }
{ ranametal at blistering.net }
{ }
{*******************************************************}

{ Revision History:

Version 1.2
===========
+ Fixed rare "division by zero" error in VisibleRowCount function
+ When setting CurObj any unsaved changes in InplaceEdit are discarded
+ Added events OnChanging, OnChange
+ Fixed bug with visible scrollbar on empty PropList
+ Added "autocomplete" feature for enum properties
+ Fixed bug with changing Ctl3D property at run-time

Version 1.1
===========
+ Now compatible with Delphi 2, 3, 4 and 5. In Delphi 5 you may need
to compile
Delphi5SourceToolsapiDsgnIntf.pas and put resulting DCU in
Delphi5Lib
folder
+ In Delphi 5 TPropertyEditor custom drawing is supported
+ if ShowHint is True, hint window will be shown when you move the
mouse over
a long property value (not working in D2)
+ Vertical scrollbar can be flat now (in D4, D5)
+ "+"/"-" button next to collapsed property can look like that found
in Delphi 5
+ Two events were added (in D2 only one event)
+ Corrected some bugs in destructor

Version 1.0
===========
Initial Delphi 4 version.

TZPropList property & events
============================

(public)
CurObj - determines the object we are viewing|editing
Modified - True if any property of CurObj was modified
VisibleRowCount - idicates number of rows that can fit in the
visible area
RowHeight - height of a single row

(published)
Filter - determines what kind of properties to show
IntegralHeight - determines whether to display the partial items
Middle - width of first column (containing property names)
NewButtons - determines whether to use D4 or D5 style when
displaing "+"/"-" button next to collapsed
property
PropColor - color used to display property values
ScrollBarStyle - can make vertical scrollbar flat (D4&5)

OnNewObject - occurs when a new value is assigned to CurObj
OnHint - occurs when the mouse pauses over the property,
whose
value is too long and doesn't fit in view. You can
change
hint color, position and text here (absent in D2)
}

unit ZPropLst;

{$IFDEF VER90}
{$DEFINE Delphi2}
{$DEFINE Prior4}
{$ENDIF}

{$IFDEF VER100}
{$DEFINE Delphi3}
{$DEFINE Prior4}
{$ENDIF}

{$IFDEF VER120}
{$DEFINE Delphi4}
{$DeFINE Post4}
{$ENDIF}

{$IFDEF VER130}
{$DEFINE Delphi5}
{$DeFINE Post4}
{$ENDIF}

interface

uses
{ !!! In Delphi 5 you may need to compile
Delphi5SourceToolsapiDsgnIntf.pas
and put resulting DCU in Delphi5Lib folder }
Windows, Messages, Classes, Graphics, Controls, TypInfo, StdCtrls,
SysUtils, Forms , Menus ;

type
TZPropList = class;
TZPropType = (ptSimple, ptEllipsis, ptPickList);

TZPropList = class(TCustomControl)
private
FCurObj: TObject;
FPropCount: Integer;
FEditors: TZEditorList;
FRowHeight: Integer;
FHasScrollBar: Boolean;
FTopRow: Integer;
FCurrent: Integer;
FVertLine: Integer;
FHitTest: TPoint;
FDividerHit: Boolean;
FInplaceEdit: TZInplaceEdit;
FInUpdate: Boolean;
FPropColor: TColor;
FDesigner: TZFormDesigner;
FIntegralHeight: Boolean;
FDefFormProc: Pointer;
FFormHandle: HWND;
FFilter: TTypeKinds;
FModified: Boolean;
FCurrentIdent: Integer;
FCurrentPos: Integer;
FTracking: Boolean;
FNewButtons: Boolean;
FDestroying: Boolean;
FBorderStyle: TBorderStyle;
{$IFDEF Post4}
FScrollBarStyle: TScrollBarStyle;
{$ENDIF}
FOnNewObject: TNewObjectEvent;
{$IFNDEF Delphi2}
FOnHint: THintEvent;
{$ENDIF}
FOnChanging: TChangingEvent;
FOnChange: TChangeEvent;
//HMRS
FOnAddProperty: TAddPropertyEvent;
procedure CMFontChanged(var Message: TMessage); message
CM_FONTCHANGED;
procedure CMShowingChanged(var Message: TMessage); message
CM_SHOWINGCHANGED;
procedure CMDesignHitTest(var Msg: TCMDesignHitTest); message
CM_DESIGNHITTEST;
procedure CMCancelMode(var Msg: TMessage); message CM_CANCELMODE;
{$IFNDEF Delphi2}
procedure CMHintShow(var Msg: TCMHintShow); message CM_HINTSHOW;
{$ENDIF}
procedure SetCurObj(const Value: TObject);
procedure UpdateScrollRange;
procedure WMEraseBkGnd(var Msg: TWMEraseBkGnd); message
WM_ERASEBKGND;
procedure WMSize(var Msg: TWMSize); message WM_SIZE;
procedure WMVScroll(var Msg: TWMVScroll); message WM_VSCROLL;
procedure WMGetDlgCode(var Msg: TWMGetDlgCode); message
WM_GETDLGCODE;
procedure WMNCHitTest(var Msg: TWMNCHitTest); message
WM_NCHITTEST;
procedure WMSetCursor(var Msg: TWMSetCursor); message
WM_SETCURSOR;
procedure WMCancelMode(var Msg: TMessage); message WM_CANCELMODE;
procedure WMSetFocus(var Msg: TWMSetFocus); message WM_SETFOCUS;
procedure ModifyScrollBar(ScrollCode: Integer);
procedure MoveTop(NewTop: Integer);
function MoveCurrent(NewCur: Integer): Boolean;
procedure InvalidateSelection;
function VertLineHit(X: Integer): Boolean;
function YToRow(Y: Integer): Integer;
procedure SizeColumn(X: Integer);
function GetValue(Index: Integer): string;
function GetPrintableValue(Index: Integer): string;
procedure DoEdit(E: TPropertyEditor; DoEdit: Boolean; const Value:
string);
procedure SetValue(Index: Integer; const Value: string);
procedure CancelMode;
function GetEditRect: TRect;
function UpdateText(Exiting: Boolean): Boolean;
procedure SetPropColor(const Value: TColor);
function ColumnSized(X: Integer): Boolean;
procedure FreePropList;
procedure InitPropList;
procedure PropEnumProc(Prop: TPropertyEditor);
procedure SetIntegralHeight(const Value: Boolean);
procedure FormWndProc(var Message: TMessage);
procedure SetFilter(const Value: TTypeKinds);
procedure ChangeCurObj(const Value: TObject);
function GetName(Index: Integer): string;
procedure CMCtl3DChanged(var Message: TMessage); message
CM_CTL3DCHANGED;
function GetValueRect(ARow: Integer): TRect;
procedure SetNewButtons(const Value: Boolean);
procedure SetMiddle(const Value: Integer);
{$IFDEF Post4}
procedure SetScrollBarStyle(const Value: TScrollBarStyle);
{$ENDIF}
procedure NodeClicked;
function ButtonHit(X: Integer): Boolean;
procedure SetBorderStyle(Value: TBorderStyle);
function GetFullPropName(Index: Integer): string;
protected
procedure Paint; override;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure DblClick; override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
function GetPropType: TZPropType;
procedure Edit;
function Editor: TPropertyEditor;
procedure CreateWnd; override;
procedure DestroyWnd; override;
procedure Notification(AComponent: TComponent; Operation:
TOperation); override;
procedure UpdateEditor(CallActivate: Boolean);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure InitCurrent(const PropName: string);
procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
override;
procedure CreateParams(var Params: TCreateParams); override;
function VisibleRowCount: Integer;
procedure MarkModified;
procedure ClearModified;
procedure Synchronize;
procedure SetFocus; override;
// HMRS
procedure ReloadProperties;
property CurObj: TObject read FCurObj write SetCurObj;
property Modified: Boolean read FModified;
property RowHeight: Integer read FRowHeight;
property PropCount: Integer read FPropCount;
property InplaceEdit: TZInplaceEdit read FInplaceEdit;
published
property PropColor: TColor read FPropColor write SetPropColor
default clNavy;
property IntegralHeight: Boolean read FIntegralHeight
write SetIntegralHeight default False;
property Filter: TTypeKinds read FFilter write SetFilter default
tkProperties;
property NewButtons: Boolean read FNewButtons write SetNewButtons
default {$IFDEF Delphi5}True{$ELSE}False{$ENDIF};
property Middle: Integer read FVertLine write SetMiddle default
85;
{$IFDEF Post4}
property ScrollBarStyle: TScrollBarStyle read FScrollBarStyle
write SetScrollBarStyle default ssRegular;
{$ENDIF}
property OnNewObject: TNewObjectEvent read FOnNewObject write
FOnNewObject;
{$IFNDEF Delphi2}
property OnHint: THintEvent read FOnHint write FOnHint;
{$ENDIF}
property OnChanging: TChangingEvent read FOnChanging write
FOnChanging;
property OnChange: TChangeEvent read FOnChange write FOnChange;
// HMRS
property OnAddProperty: TAddPropertyEvent read FOnAddProperty
write FOnAddProperty;

property Align;
property BorderStyle: TBorderStyle read FBorderStyle write
SetBorderStyle default bsSingle;
property Color default clBtnFace;
property Ctl3D;
property Cursor;
property Enabled;
property Font;
property ParentColor default False;
property ParentFont;
property ParentShowHint default False;
property PopupMenu;
property ShowHint default True;
property TabOrder;
property TabStop default True;
property Visible;
end;

procedure Register;

implementation

uses
CommCtrl;

const
MINCOLSIZE = 32;
DROPDOWNROWS = 8;

procedure Register;
begin
RegisterComponents('Gena''s', [TZPropList]);
end;

{ Return mimimum of two signed integers }
function EMax(A, B: Integer): Integer;
asm
{ ->EAX A
EDX B
<-EAX Min(A, B) }

CMP EAX,EDX
JGE @@Exit
MOV EAX,EDX
@@Exit:
end;

{ Return maximum of two signed integers }
function EMin(A, B: Integer): Integer;
asm
{ ->EAX A
EDX B
<-EAX Max(A, B) }

CMP EAX,EDX
JLE @@Exit
MOV EAX,EDX
@@Exit:
end;

{ TZEditorList }
{ TZPropList }

constructor TZPropList.Create(AOwner: TComponent);
const
PropListStyle = [csCaptureMouse, csOpaque, csDoubleClicks];
begin
inherited;
FInplaceEdit := TZInplaceEdit.Create(Self);
FPropColor := clNavy;
FEditors := TZEditorList.Create(Self);
FDesigner := TZFormDesigner.Create(Self);
{$IFDEF Post4}
FDesigner._AddRef;
{$ENDIF}
{$IFDEF Delphi5}
FNewButtons := True;
{$ENDIF}
FCurrent := -1;
FFilter := tkProperties;
FBorderStyle := bsSingle;

if NewStyleControls then
ControlStyle := PropListStyle else
ControlStyle := PropListStyle + [csFramed];
Color := clBtnFace;
ParentColor := False;
TabStop := True;
SetBounds(Left, Top, 200, 200);
FVertLine := 85;
ShowHint := True;
ParentShowHint := False;
// CurObj := Self;
// DoubleBuffered := False;
end;

procedure TZPropList.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
with Params do
begin
Style := Style + WS_TABSTOP;
Style := Style + WS_VSCROLL;
WindowClass.style := CS_DBLCLKS;
if FBorderStyle = bsSingle then
if NewStyleControls and Ctl3D then
begin
Style := Style and not WS_BORDER;
ExStyle := ExStyle or WS_EX_CLIENTEDGE;
end
else
Style := Style or WS_BORDER;
end;
end;

procedure TZPropList.InitCurrent(const PropName: string);
begin
// FCurrent := FEditors.FindPropName(PropName);
MoveCurrent(FEditors.FindPropName(PropName));
// if Assigned(FInplaceEdit) then FInplaceEdit.Move(GetEditRect);
end;

procedure TZPropList.FreePropList;
begin
FEditors.Clear;
FPropCount := 0;
end;

procedure TZPropList.InitPropList;
var
Components: {$IFDEF
Delphi5}TDesignerSelectionList{$ELSE}TComponentList{$ENDIF};
begin
Components := {$IFDEF
Delphi5}TDesignerSelectionList{$ELSE}TComponentList{$ENDIF}.Create;
try
Components.Add({$IFDEF
Delphi2}TComponent{$ELSE}TPersistent{$ENDIF}(FCurObj));
FCurrentIdent := 0;
FCurrentPos := 0;
GetComponentProperties(Components, FFilter, FDesigner,
PropEnumProc);
FPropCount := FEditors.Count;
finally
Components.Free;
end;
end;

function TZPropList.GetFullPropName(Index: Integer): string;
begin
Result := FEditors[Index].peEditor.GetName;
while Index > 0 do
begin
if FEditors[Pred(Index)].peIdent <> FEditors[Index].peIdent then
Result := FEditors[Pred(Index)].peEditor.GetName + '' + Result;
Dec(Index);
end;
end;

procedure TZPropList.ChangeCurObj(const Value: TObject);
var
SavedPropName: string;
begin
if (FCurrent >= 0) and (FCurrent < FPropCount) then
SavedPropName := GetFullPropName(FCurrent)
else SavedPropName := '';

FCurObj := Value;
FreePropList;
if not FDestroying then
begin
InitCurrent('');

if Assigned(Value) then
begin
InitPropList;
InitCurrent(SavedPropName);
UpdateEditor(True);
end;

Invalidate;
UpdateScrollRange;
end;
end;

procedure TZPropList.SetCurObj(const Value: TObject);
begin
if FCurObj <> Value then
begin
if Assigned(FOnNewObject) then FOnNewObject(Self, FCurObj, Value);
if not FDestroying then
FInplaceEdit.Modified := False;
FModified := False;
ChangeCurObj(Value);

if Value is TComponent then
TComponent(Value).FreeNotification(Self);
end;
end;

procedure TZPropList.CMFontChanged(var Message: TMessage);
begin
inherited;
Canvas.Font := Font;
FRowHeight := Canvas.TextHeight('Wg') + 3;
Invalidate;
UpdateScrollRange;
FInplaceEdit.Move(GetEditRect);
end;

procedure TZPropList.UpdateScrollRange;
var
si: TScrollInfo;
diVisibleCount, diCurrentPos: Integer;
begin
if not FHasScrollBar or not HandleAllocated or not Showing then
Exit;

{ Temporarily mark us as not having scroll bars to avoid recursion }
FHasScrollBar := False;
try
with si do
begin
cbSize := SizeOf(TScrollInfo);
fMask := SIF_RANGE + SIF_PAGE + SIF_POS;
nMin := 0;
diVisibleCount := VisibleRowCount;
diCurrentPos := FTopRow;

if FPropCount <= diVisibleCount then
begin
nPage := 0;
nMax := 0;
end
else
begin
nPage := diVisibleCount;
nMax := FPropCount - 1;
end;

if diCurrentPos + diVisibleCount > FPropCount then
diCurrentPos := EMax(0, FPropCount - diVisibleCount);
nPos := diCurrentPos;
{$IFDEF Prior4}
SetScrollInfo(Handle, SB_VERT, si, True);
{$ELSE}
FlatSB_SetScrollInfo(Handle, SB_VERT, si, True);
{$ENDIF}
MoveTop(diCurrentPos);
end;
finally
FHasScrollBar := True;
end;
end;

function TZPropList.VisibleRowCount: Integer;
begin
if FRowHeight > 0 then // avoid division by zero
Result := EMin(ClientHeight div FRowHeight, FPropCount)
else
Result := FPropCount;
end;

procedure TZPropList.CMShowingChanged(var Message: TMessage);
begin
inherited;
if Showing then
begin
FHasScrollBar := True;
Perform(CM_FONTCHANGED, 0, 0);
FInplaceEdit.FListButton.Perform(CM_FONTCHANGED, 0, 0);
if csDesigning in ComponentState then CurObj := Self;
Parent.Realign;
{ UpdateScrollRange;
InitCurrent;
UpdateEditor(True);}
end;
end;

procedure TZPropList.WMEraseBkGnd(var Msg: TWMEraseBkGnd);
begin
Msg.Result := 1;
end;

procedure TZPropList.WMSize(var Msg: TWMSize);
begin
inherited;
if FRowHeight <= 0 then Exit;
ColumnSized(FVertLine); // move divider if needed
Invalidate;
FInplaceEdit.UpdateLoc(GetEditRect);
UpdateScrollRange;
end;

procedure TZPropList.ModifyScrollBar(ScrollCode: Integer);
var
OldPos, NewPos, MaxPos: Integer;
si: TScrollInfo;
begin
OldPos := FTopRow;
NewPos := OldPos;

with si do
begin
cbSize := SizeOf(TScrollInfo);
fMask := SIF_ALL;
{$IFDEF Prior4}
GetScrollInfo(Handle, SB_VERT, si);
{$ELSE}
FlatSB_GetScrollInfo(Handle, SB_VERT, si);
{$ENDIF}
MaxPos := nMax - Integer(nPage) + 1;

case ScrollCode of
SB_LINEUP: Dec(NewPos);
SB_LINEDOWN: Inc(NewPos);
SB_PAGEUP: Dec(NewPos, nPage);
SB_PAGEDOWN: Inc(NewPos, nPage);
SB_THUMBPOSITION, SB_THUMBTRACK: NewPos := nTrackPos;
SB_TOP: NewPos := nMin;
SB_BOTTOM: NewPos := MaxPos;
else Exit;
end;

{ if NewPos < 0 then NewPos := 0;
if NewPos > MaxPos then NewPos := MaxPos;}
MoveTop(NewPos);
end;
end;

procedure TZPropList.WMVScroll(var Msg: TWMVScroll);
begin
ModifyScrollBar(Msg.ScrollCode);
end;

procedure TZPropList.MoveTop(NewTop: Integer);
var
VertCount, ShiftY: Integer;
ScrollArea: TRect;
begin
if NewTop < 0 then NewTop := 0;
VertCount := VisibleRowCount;
if NewTop + VertCount > FPropCount then
NewTop := FPropCount - VertCount;

if NewTop = FTopRow then Exit;

ShiftY := (FTopRow - NewTop) * FRowHeight;
FTopRow := NewTop;
ScrollArea := ClientRect;
{$IFDEF Prior4}
SetScrollPos(Handle, SB_VERT, NewTop, True);
{$ELSE}
FlatSB_SetScrollPos(Handle, SB_VERT, NewTop, True);
{$ENDIF}
if Abs(ShiftY) >= VertCount * FRowHeight then
InvalidateRect(Handle, @ScrollArea, True)
else
ScrollWindowEx(Handle, 0, ShiftY,
@ScrollArea, @ScrollArea, 0, nil, SW_INVALIDATE);

FInplaceEdit.Move(GetEditRect);
end;

function TZPropList.GetValueRect(ARow: Integer): TRect;
var
RowStart: Integer;
begin
RowStart := (ARow - FTopRow) * FRowHeight;
Result := Rect(FVertLine + 1, RowStart, ClientWidth, RowStart +
FRowHeight - 1);
end;

function TZPropList.GetEditRect: TRect;
begin
Result := GetValueRect(FCurrent);
end;

procedure TZPropList.Paint;

{ procedure DrawValue(const S: string; R: TRect; XOfs: Integer);
begin
ExtTextOut(Canvas.Handle, R.Left + XOfs, R.Top + 1,
ETO_CLIPPED or ETO_OPAQUE, @R, PChar(S), Length(S), nil);
end;}

procedure DrawName(Index: Integer; R: TRect; XOfs: Integer);
var
S: string;
E: PZEditor;
BColor, PColor: TColor;
YOfs: Integer;
begin
if FNewButtons then
begin
E := FEditors[Index];
S := E.peEditor.GetName;
Inc(XOfs, R.Left + E.peIdent * 10);
ExtTextOut(Canvas.Handle, XOfs + 11, R.Top + 1,
ETO_CLIPPED or ETO_OPAQUE, @R, PChar(S), Length(S), nil);

if E.peNode then
with Canvas do
begin
BColor := Brush.Color;
PColor := Pen.Color;
Brush.Color := clWindow;
Pen.Color := Font.Color;

YOfs := R.Top + (FRowHeight - 9) shr 1;
Rectangle(XOfs, YOfs, XOfs + 9, YOfs + 9);
PolyLine([Point(XOfs + 2, YOfs + 4), Point(XOfs + 7, YOfs +
4)]);
if not E.peExpanded then
PolyLine([Point(XOfs + 4, YOfs + 2), Point(XOfs + 4, YOfs +
7)]);

Brush.Color := BColor;
Pen.Color := PColor;
end;
end
else
begin
Canvas.TextRect(R, R.Left + XOfs, R.Top + 1, GetName(Index));
end;
end;

function GetPenColor(Color: Integer): Integer;
type
TRGB = record
R, G, B, A: Byte;
end;
begin
// produce slightly darker color
if Color < 0 then Color := GetSysColor(Color and $FFFFFF);
Dec(TRGB(Color).R, EMin(TRGB(Color).R, $10));
Dec(TRGB(Color).G, EMin(TRGB(Color).G, $10));
Dec(TRGB(Color).B, EMin(TRGB(Color).B, $10));
Result := Color;
end;

var
RedrawRect, NameRect, ValueRect, CurRect: TRect;
FirstRow, LastRow, Y, RowIdx, CW, Offset: Integer;
NameColor: TColor;
DrawCurrent: Boolean;
begin
if FRowHeight < 1 then Exit;
FInplaceEdit.Move(GetEditRect);

with Canvas do
begin
RedrawRect := ClipRect;
FirstRow := RedrawRect.Top div FRowHeight;
LastRow := EMin(FPropCount - FTopRow - 1, (RedrawRect.Bottom - 1)
div FRowHeight);
if LastRow + FTopRow = Pred(FCurrent) then Inc(LastRow); //
Selection occupies 2 rows

{with RedrawRect do
Form1.p1.Caption := Format('%d, %d, %d, %d: %d-%d',
[Left, Top, Right, Bottom, FirstRow, LastRow]);}

NameRect := Bounds(0, FirstRow * FRowHeight, FVertLine, FRowHeight
- 1);
ValueRect := NameRect;
ValueRect.Left := FVertLine + 2;
CW := ClientWidth;
ValueRect.Right := CW;
Brush.Color := Self.Color;
Pen.Color := GetPenColor(Self.Color);
Font := Self.Font;
NameColor := Font.Color;
DrawCurrent := False;

for Y := FirstRow to LastRow do
begin
RowIdx := Y + FTopRow;
Font.Color := NameColor;

if RowIdx = FCurrent then
begin
CurRect := Rect(0, NameRect.Top - 2, CW, NameRect.Bottom + 1);
DrawCurrent := True;
Inc(NameRect.Left); // Space for DrawEdge
DrawName(RowIdx, NameRect, 1);
Dec(NameRect.Left);
end
else
begin
if RowIdx <> Pred(FCurrent) then
begin
Offset := 0;
PolyLine([Point(0, NameRect.Bottom), Point(CW,
NameRect.Bottom)]);
end
else
Offset := 1;
Dec(NameRect.Bottom, Offset);
DrawName(RowIdx, NameRect, 2);
Inc(NameRect.Bottom, Offset);
Font.Color := FPropColor;
{$IFDEF Delphi5}
FEditors[RowIdx].peEditor.PropDrawValue(Self.Canvas,
ValueRect, False);
{$ELSE}
Dec(ValueRect.Bottom, Offset);
TextRect(ValueRect, ValueRect.Left + 1, ValueRect.Top + 1,
GetPrintableValue(RowIdx));
Inc(ValueRect.Bottom, Offset);
{$ENDIF}
end;

OffsetRect(NameRect, 0, FRowHeight);
OffsetRect(ValueRect, 0, FRowHeight);
end;

Dec(NameRect.Bottom, FRowHeight - 1);
NameRect.Right := CW;
ValueRect := Rect(FVertLine, RedrawRect.Top, 10, NameRect.Bottom -
1);
DrawEdge(Handle, ValueRect, EDGE_ETCHED, BF_LEFT);

if DrawCurrent then
begin
DrawEdge(Handle, CurRect, BDR_SUNKENOUTER, BF_LEFT + BF_BOTTOM +
BF_RIGHT);
DrawEdge(Handle, CurRect, EDGE_SUNKEN, BF_TOP);
end;

if NameRect.Bottom < RedrawRect.Bottom then
begin
Brush.Color := Self.Color;
RedrawRect.Top := NameRect.Bottom;
FillRect(RedrawRect);
end;
end;
end;

procedure TZPropList.WMGetDlgCode(var Msg: TWMGetDlgCode);
begin
Msg.Result := DLGC_WANTARROWS;
end;

procedure TZPropList.KeyDown(var Key: Word; Shift: TShiftState);
var
PageHeight, NewCurrent: Integer;
begin
inherited KeyDown(Key, Shift);
NewCurrent := FCurrent;
PageHeight := VisibleRowCount - 1;
case Key of
VK_UP: Dec(NewCurrent);
VK_DOWN: Inc(NewCurrent);
VK_NEXT: Inc(NewCurrent, PageHeight);
VK_PRIOR: Dec(NewCurrent, PageHeight);
else Exit;
end;
MoveCurrent(NewCurrent);
end;

procedure TZPropList.InvalidateSelection;
var
R: TRect;
RowStart: Integer;
begin
RowStart := (FCurrent - FTopRow) * FRowHeight;
R := Rect(0, RowStart - 2, ClientWidth, RowStart + FRowHeight + 1);
InvalidateRect(Handle, @R, True);
end;

function TZPropList.MoveCurrent(NewCur: Integer): Boolean;
var
NewTop, VertCount: Integer;
begin
Result := UpdateText(True);
if not Result then Exit;

if NewCur < 0 then NewCur := 0;
if NewCur >= FPropCount then NewCur := FPropCount - 1;
if NewCur = FCurrent then Exit;

InvalidateSelection;
FCurrent := NewCur;
InvalidateSelection;

NewTop := FTopRow;
VertCount := VisibleRowCount;
if NewCur < NewTop then NewTop := NewCur;
if NewCur >= NewTop + VertCount then NewTop := NewCur - VertCount +
1;

FInplaceEdit.Move(GetEditRect);
UpdateEditor(True);
MoveTop(NewTop);
end;

procedure TZPropList.MarkModified;
begin
FModified := True;
end;

procedure TZPropList.ClearModified;
begin
FModified := False;
end;

procedure TZPropList.Synchronize;
begin
MarkModified;
Invalidate;
UpdateEditor(False);
end;

procedure TZPropList.UpdateEditor(CallActivate: Boolean);
var
Attr: TPropertyAttributes;
begin
if Assigned(FInplaceEdit) and (FCurrent >= 0) then
with FInplaceEdit, Editor do
begin
if CallActivate then Activate;
MaxLength := GetEditLimit;
Attr := GetAttributes;
ReadOnly := paReadOnly in Attr;
FAutoUpdate := paAutoUpdate in Attr;
Text := GetPrintableValue(FCurrent);
SelectAll;
Modified := False;
end;
end;

function TZPropList.UpdateText(Exiting: Boolean): Boolean;
begin
Result := True;
if not FInUpdate and Assigned(FInplaceEdit) and
(FCurrent >= 0) and (FInplaceEdit.Modified) then
begin
FInUpdate := True;
try
SetValue(FCurrent, FInplaceEdit.Text);
except
Result := False;
FTracking := False;
//Application.ShowException(Exception(ExceptObject));
// HMRS
Application.HandleException(Self);
end;
if Exiting then UpdateEditor(False);
Invalidate; // repaint all dependent properties
FInUpdate := False;
end;
end;

procedure TZPropList.WMNCHitTest(var Msg: TWMNCHitTest);
begin
inherited;
FHitTest := ScreenToClient(SmallPointToPoint(Msg.Pos));
end;

function TZPropList.VertLineHit(X: Integer): Boolean;
begin
Result := Abs(X - FVertLine) < 3;
end;

function TZPropList.ButtonHit(X: Integer): Boolean;
begin
// whether we hit collapse/expand button next to property with
subproperties
if FCurrent >= 0 then
begin
Dec(X, FEditors[FCurrent].peIdent * 10);
Result := (X > 0) and (X < 12);
end
else
Result := False;
end;

procedure TZPropList.SetBorderStyle(Value: TBorderStyle);
begin
if FBorderStyle <> Value then
begin
FBorderStyle := Value;
RecreateWnd;
end;
end;

procedure TZPropList.WMSetCursor(var Msg: TWMSetCursor);
var
Cur: HCURSOR;
begin
Cur := 0;
if (Msg.HitTest = HTCLIENT) and VertLineHit(FHitTest.X) then
Cur := Screen.Cursors[crHSplit];
if Cur <> 0 then SetCursor(Cur) else inherited;
end;

procedure TZPropList.CMDesignHitTest(var Msg: TCMDesignHitTest);
begin
Msg.Result := Integer(FDividerHit or VertLineHit(Msg.XPos));
end;

function TZPropList.YToRow(Y: Integer): Integer;
begin
Result := FTopRow + Y div FRowHeight;
end;

procedure TZPropList.MouseDown(Button: TMouseButton; Shift:
TShiftState; X,
Y: Integer);
begin
if not (csDesigning in ComponentState) and
(CanFocus or (GetParentForm(Self) = nil)) then SetFocus;

if ssDouble in Shift then DblClick
else
begin
FDividerHit := VertLineHit(X) and (Button = mbLeft);
if not FDividerHit and (Button = mbLeft) then
begin
if not MoveCurrent(YToRow(Y)) then Exit;
if FNewButtons and ButtonHit(X) then NodeClicked
else
begin
FTracking := True;
FInplaceEdit.FClickTime := GetMessageTime;
end;
end;
end;

inherited;
end;

procedure TZPropList.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
if FDividerHit then SizeColumn(X)
else
if FTracking and (ssLeft in Shift) then MoveCurrent(YToRow(Y));

inherited;
end;

procedure TZPropList.MouseUp(Button: TMouseButton; Shift: TShiftState;
X,
Y: Integer);
begin
FDividerHit := False;
FTracking := False;
inherited;
end;

function TZPropList.ColumnSized(X: Integer): Boolean;
var
NewSizingPos: Integer;
begin
NewSizingPos := EMax(MINCOLSIZE, EMin(X, ClientWidth - MINCOLSIZE));
Result := NewSizingPos <> FVertLine;
FVertLine := NewSizingPos
end;

procedure TZPropList.SizeColumn(X: Integer);
begin
if ColumnSized(X) then
begin
Invalidate;
FInplaceEdit.UpdateLoc(GetEditRect);
end;
end;

procedure TZPropList.CMCancelMode(var Msg: TMessage);
begin
inherited;
CancelMode;
end;

procedure TZPropList.CancelMode;
begin
FDividerHit := False;
FTracking := False;
end;

procedure TZPropList.WMCancelMode(var Msg: TMessage);
begin
inherited;
CancelMode;
end;

destructor TZPropList.Destroy;
begin
FDestroying := True;
FHasScrollBar := False; // disable UpdateScrollRange
FInplaceEdit := nil;
CurObj := nil;
{$IFDEF Prior4}
FDesigner.Free;
{$ELSE}
FDesigner._Release;
{$ENDIF}
FEditors.Free;
inherited;
end;

procedure TZPropList.WMSetFocus(var Msg: TWMSetFocus);
begin
inherited;
FInplaceEdit.SetFocus;
end;

function TZPropList.GetName(Index: Integer): string;
var
Ident: Integer;
begin
with FEditors[Index]^ do
begin
Ident := peIdent shl 1;
if not peNode then Inc(Ident, 2);
Result := peEditor.GetName;
if peNode then
if peExpanded then Result := '- ' + Result
else Result := '+' + Result;
Result := StringOfChar(' ', Ident) + Result;
end;
end;

function TZPropList.GetValue(Index: Integer): string;
begin
Result := FEditors[Index].peEditor.GetValue;
end;

function TZPropList.GetPrintableValue(Index: Integer): string;
var
I: Integer;
P: PChar;
begin
Result := GetValue(Index);
UniqueString(Result);
P := Pointer(Result);
for I := 0 to Length(Result) - 1 do
begin
if P^ < #32 then P^ := '.';
Inc(P);
end;
end;

procedure TZPropList.DoEdit(E: TPropertyEditor; DoEdit: Boolean; const
Value: string);
var
CanChange: Boolean;
Obj: Integer;
begin
CanChange := True;
if Assigned(FOnChanging) then FOnChanging(Self, E, CanChange);
if CanChange then
begin
Obj := 0;
if E is TClassProperty then Obj := THPropEdit(E).GetOrdValue;
if DoEdit then E.Edit else E.SetValue(Value);
if (E is TClassProperty) and (Obj <> THPropEdit(E).GetOrdValue)
and FEditors[FCurrent].peExpanded then NodeClicked; // collapse
modified prop
if Assigned(FOnChange) then FOnChange(Self, E);
end;
end;

procedure TZPropList.SetValue(Index: Integer; const Value: string);
begin
DoEdit(FEditors[Index].peEditor, False, Value);
end;

procedure TZPropList.SetPropColor(const Value: TColor);
begin
if FPropColor <> Value then
begin
FPropColor := Value;
Invalidate;
end;
end;

function TZPropList.GetPropType: TZPropType;
var
Attr: TPropertyAttributes;
begin
Result := ptSimple;
if (FCurrent >= 0) and (FCurrent < FPropCount) then
begin
Attr := Editor.GetAttributes;
if paValueList in Attr then Result := ptPickList
else
if paDialog in Attr then Result := ptEllipsis;
end;
end;

procedure TZPropList.PropEnumProc(Prop: TPropertyEditor);
var
P: PZEditor;
AllowAdd: Boolean;
begin
// HMRS
AllowAdd := True;
if Assigned(FOnAddProperty) then
FOnAddProperty(Self, Prop, AllowAdd);
if not AllowAdd then Exit;

New(P);
P.peEditor := Prop;
P.peIdent := FCurrentIdent;
P.peExpanded := False;
P.peNode := paSubProperties in Prop.GetAttributes;
FEditors.Insert(FCurrentPos, P);
Inc(FCurrentPos);
end;

procedure TZPropList.Edit;
begin
DoEdit(Editor, True, '');
UpdateEditor(False);
Invalidate; // repaint all dependent properties
end;

procedure TZPropList.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
var
NCH: Integer;
begin
if FIntegralHeight and (FRowHeight > 0) then
begin
NCH := Height - ClientHeight;
AHeight := ((AHeight - NCH) div FRowHeight) * FRowHeight + NCH;
end;
inherited;
end;

procedure TZPropList.SetIntegralHeight(const Value: Boolean);
begin
if FIntegralHeight <> Value then
begin
FIntegralHeight := Value;
{$IFDEF Prior4}
Parent.Realign;
{$ELSE}
AdjustSize;
{$ENDIF}
end;
end;

{$IFDEF Post4}
const
Styles: array[TScrollBarStyle] of Integer = (FSB_REGULAR_MODE,
FSB_ENCARTA_MODE, FSB_FLAT_MODE);
{$ENDIF}

procedure TZPropList.DestroyWnd;
begin
if FFormHandle <> 0 then
begin
SetWindowLong(FFormHandle, GWL_WNDPROC, Integer(FDefFormProc));
FFormHandle := 0;
end;
inherited;
end;

procedure TZPropList.CreateWnd;
begin
inherited;
{$IFDEF Post4}
ShowScrollBar(Handle, SB_BOTH, False);
InitializeFlatSB(Handle);
FlatSB_SetScrollProp(Handle, WSB_PROP_VSTYLE,
Styles[FScrollBarStyle], False);
{$ENDIF}

if not (csDesigning in ComponentState) then
begin
FFormHandle := GetParentForm(Self).Handle;
if FFormHandle <> 0 then
FDefFormProc := Pointer(SetWindowLong(FFormHandle, GWL_WNDPROC,
Integer(MakeObjectInstance(FormWndProc))));
end;
end;

procedure TZPropList.FormWndProc(var Message: TMessage);
begin
with Message do
begin
if (Msg = WM_NCLBUTTONDOWN) or (Msg = WM_LBUTTONDOWN) then
FInplaceEdit.FListButton.CloseUp(False);
Result := CallWindowProc(FDefFormProc, FFormHandle, Msg, WParam,
LParam);
end;
end;

procedure TZPropList.SetFilter(const Value: TTypeKinds);
begin
if FFilter <> Value then
begin
FFilter := Value;
ChangeCurObj(FCurObj);
end;
end;

procedure TZPropList.CMCtl3DChanged(var Message: TMessage);
begin
RecreateWnd;
inherited;
end;

procedure TZPropList.DblClick;
begin
inherited;
NodeClicked;
end;

procedure TZPropList.NodeClicked;
var
Index, CurIdent, AddedCount, NewTop: Integer;
begin
// Expand|collapse node subproperties
if (FCurrent >= 0) and (FEditors[FCurrent].peNode) then
with FEditors[FCurrent]^ do
begin
if peExpanded then
begin
Index := FCurrent + 1;
CurIdent := peIdent;
while (Index < FEditors.Count) and
(FEditors[Index].peIdent > CurIdent) do
begin
FEditors.DeleteEditor(Index);
FEditors.Delete(Index);
end
end
else
begin
FCurrentIdent := peIdent + 1;
FCurrentPos := FCurrent + 1;
try
Editor.GetProperties(PropEnumProc);
except
end;
end;

peExpanded := not peExpanded;
AddedCount := FEditors.Count - FPropCount;
FPropCount := FEditors.Count;
if AddedCount > 0 then // Bring expanded properties in view
begin
Dec(AddedCount, VisibleRowCount - 1);
if AddedCount > 0 then AddedCount := 0;
NewTop := FCurrent + AddedCount;
if NewTop > FTopRow then MoveTop(NewTop);
end
{ else
if AddedCount = 0 then peNode := False};
Invalidate;
UpdateScrollRange;
end;
end;

function TZPropList.Editor: TPropertyEditor;
begin
Result := FEditors[FCurrent].peEditor;
end;

procedure TZPropList.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited;
if (Operation = opRemove) and not FDestroying then
begin
if AComponent = FCurObj then CurObj := nil;
end;
end;

{$IFNDEF Delphi2}
procedure TZPropList.CMHintShow(var Msg: TCMHintShow);
var
Row, W: Integer;
S: string;
{$IFDEF Delphi5}
W2: Integer;
{$ENDIF}
begin
with Msg, HintInfo^ do
begin
Result := 1;
Row := YToRow(CursorPos.Y);
if (CursorPos.X > FVertLine) and (Row < FPropCount) then
begin
S := GetValue(Row);
CursorRect := GetValueRect(Row);
if Pos(#10, S) > 0 then // Multiline string
W := MaxInt
else
begin
W := Canvas.TextWidth(S);
{$IFDEF Delphi5}
W2 := W;
FEditors[Row].peEditor.ListMeasureWidth(S, Canvas, W2);
if W2 <> W then W := W2 + 4; // add extra space in case of
custom drawing
{$ENDIF}
end;

if W >= CursorRect.Right - CursorRect.Left - 1 then
begin
Inc(CursorRect.Bottom);
HintPos := ClientToScreen(
Point(CursorRect.Left - 1, CursorRect.Top - 2));
HintStr := S;
if Assigned(FOnHint) then FOnHint(Self,
FEditors[Row].peEditor, HintInfo);
Result := 0;
end;
end;
end;
end;
{$ENDIF}

procedure TZPropList.ReloadProperties;
begin
ChangeCurObj(FCurObj);
end;

{$IFDEF Post4}
procedure TZPropList.SetScrollBarStyle(const Value: TScrollBarStyle);
begin
if FScrollBarStyle <> Value then
begin
FScrollBarStyle := Value;
FlatSB_SetScrollProp(Handle, WSB_PROP_VSTYLE, Styles[Value],
True);
end;
end;
{$ENDIF}

procedure TZPropList.SetNewButtons(const Value: Boolean);
begin
if FNewButtons <> Value then
begin
FNewButtons := Value;
Invalidate;
end;
end;

procedure TZPropList.SetMiddle(const Value: Integer);
begin
SizeColumn(Value);
end;

procedure TZPropList.SetFocus;
begin
if IsWindowVisible(Handle) then inherited SetFocus;
end;

end.