zproplst.~pas

delphi object inspector

  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;

type
  THPropEdit = class(TPropertyEditor)
  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;
begin
  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}

{$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;

{ TZFormDesigner }

constructor TZFormDesigner.Create(APropList: TZPropList);
begin
  inherited Create;
  FPropList := APropList;
end;

function TZFormDesigner.CreateComponent(ComponentClass: TComponentClass;
  Parent: TComponent; Left, Top, Width, Height: Integer): TComponent;
begin
// Not used by TPropertyEditor
  Result := nil;
end;

function TZFormDesigner.CreateMethod(const Name: string;
  TypeData: PTypeData): TMethod;
begin
{ CreateMethod is the abstract prototype of a method that creates an event
  handler. Call CreateMethod to add an event handler to the unit of the object
  returned by the GetRoot method. Allocate a TTypeData structure and fill in
  the MethodKind, ParamCount, and ParamList fields. The event handler gets the
  name specified by the Name parameter and the type specified by the TypeData
  parameter. CreateMethod returns a method pointer to the new event handler }
  Result.Code := nil;
  Result.Data := nil;
end;

{$IFDEF Post4}
function TZFormDesigner.GetAncestorDesigner: IFormDesigner;
begin
// Not used by TPropertyEditor
  Result := nil;
end;

procedure TZFormDesigner.GetProjectModules(Proc: TGetModuleProc);
begin
// Not used by TPropertyEditor
end;

function TZFormDesigner.IsSourceReadOnly: Boolean;
begin
// Not used by TPropertyEditor
  Result := True;
end;

function TZFormDesigner.GetCustomForm: TCustomForm;
begin
// Not used by TPropertyEditor
  Result := nil;
end;

procedure TZFormDesigner.SetCustomForm(Value: TCustomForm);
begin
// Not used by TPropertyEditor
end;

function TZFormDesigner.GetIsControl: Boolean;
begin
// Not used by TPropertyEditor
  Result := False;
end;

procedure TZFormDesigner.SetIsControl(Value: Boolean);
begin
// Not used by TPropertyEditor
end;

procedure TZFormDesigner.AddToInterface(InvKind: Integer;
  const Name: string; VT: Word; const TypeInfo: string);
begin
// Not used by TPropertyEditor
end;
{$ENDIF}

function TZFormDesigner.GetComponent(const Name: string): TComponent;
begin
{ GetComponent is the abstract prototype for a method that returns the
  component with the name passed as a parameter. Call GetComponent to access a
  component given its name. If the component is not in the current root object,
  the Name parameter should include the name of the entity in which it resides }
  Result := nil;
end;

function TZFormDesigner.GetComponentName(Component: TComponent): string;
begin
{ GetComponentName is the abstract prototype of a method that returns the name
  of the component passed as its parameter. Call GetComponentName to obtain the
  name of a component. This is the inverse of GetComponent }
  if Assigned(Component) then
    Result := Component.Name
  else
    Result := '';
end;

procedure TZFormDesigner.GetComponentNames(TypeData: P