rm_propinsp.pas

这是一个功能强大

          begin
            LEditor.Free;
            LEditor := nil;
          end;
        except
          LEditor.Free;
          raise;
        end;
      end;
    end;
  finally
        { Free prop lists }
    for LI := 0 to LObjCount - 1 do
      FreeMem(LPropLists[LI].Props);
  end;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TRMPropInfoList }

constructor TRMPropInfoList.Create;
begin
  inherited Create;
  GetResource;
end;

procedure TRMPropInfoList.Clear;
begin
  while Count > 0 do
  begin
    Dispose(PRMPropInfo(Items[0]));
    inherited Delete(0);
  end;
  inherited;
end;

procedure TRMPropInfoList.GetResource;
var
  i: Integer;
  s: string;
  lPropInfo: PRMPropInfo;

  function _GetOneCsv: string;
  var
    lPos: Integer;
  begin
    lPos := System.Pos(';', s);
    if lPos < 1 then
    begin
      Result := s;
      s := '';
    end
    else
    begin
      Result := System.Copy(s, 1, lpos - 1);
      System.Delete(s, 1, lpos);
    end;
  end;

begin
  Clear;
  for i := rmRes + 5001 to 65535 do
  begin
    s := RMLoadStr(i);
    if s = '' then
      Break;
    if (Pos('=', s) = 0) or (Pos('=', s) = Length(s)) then
      Continue;

    New(lPropInfo);
    lPropInfo.PropTrueName := Copy(s, 1, Pos('=', s) - 1);
    s := Copy(s, Pos('=', s) + 1, 9999);
    lPropInfo.PropName := _GetOneCsv;
    lPropInfo.PropCommon := _GetOneCsv;
    lPropInfo.ObjectClass := _GetOneCsv;
    inherited Add(lPropInfo);
  end;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TELObjectList }

function TELObjectList.Add: Integer;
begin
  ValidateAddition;
  Result := FItems.Add(CreateItem);
  Added;
  if not FChangingCount then Change;
end;

constructor TELObjectList.Create;
begin
  FItems := TList.Create;
end;

function TELObjectList.CreateItem: TObject;
begin
  Result := nil;
end;

procedure TELObjectList.Delete(AIndex: Integer);
begin
  ValidateDeletion;
  TObject(FItems[AIndex]).Free;
  FItems.Delete(AIndex);
  Deleted;
  if not FChangingCount then Change;
end;

destructor TELObjectList.Destroy;
begin
  Clear;
  FItems.Free;
  inherited;
end;

function TELObjectList.DoFind(AData: Pointer; AItemByProc: TELItemByProc): TObject;
var
  LI: Integer;
  LResult: Boolean;
begin
  Result := nil;
  for LI := 0 to Count - 1 do
  begin
    LResult := False;
    AItemByProc(Items[LI], AData, LResult);
    if LResult then
    begin
      Result := Items[LI];
      Break;
    end;
  end;
end;

function TELObjectList.GetCount: Integer;
begin
  Result := FItems.Count;
end;

function TELObjectList.GetItems(AIndex: Integer): TObject;
begin
  Result := FItems[AIndex];
end;

function TELObjectList.IndexOf(AItem: TObject): Integer;
begin
  Result := FItems.IndexOf(AItem);
end;

function TELObjectList.DoItemBy(AData: Pointer; AItemByProc: TELItemByProc): TObject;
begin
  Result := DoFind(AData, AItemByProc);
  if Result = nil then raise EELObjectList.Create('Item not found');
end;

procedure TELObjectList.Remove(AItem: TObject);
var
  LI: Integer;
begin
  LI := FItems.IndexOf(AItem);
  if LI <> -1 then Delete(LI);
end;

procedure TELObjectList.SetCount(const Value: Integer);
begin
  FChangingCount := True;
  try
    if Value > Count then
      while Count < Value do Add
    else if Value < Count then
      while Count > Value do Delete(Count - 1);
  finally
    FChangingCount := False;
  end;
  Change;
end;

procedure TELObjectList.Clear;
begin
  Count := 0;
end;

function TELObjectList.DoSearch(AData: Pointer;
  AItemByProc: TELItemByProc): TObject;
var
  LI: Integer;
begin
  Result := DoFind(AData, AItemByProc);
  if Result = nil then
    for LI := 0 to Count - 1 do
      if (Items[LI] <> nil) and (Items[LI] is TELObjectList) then
      begin
        Result := TELObjectList(Items[LI]).DoSearch(AData, AItemByProc);
        if Result <> nil then Break;
      end;
end;

procedure TELObjectList.ValidateAddition;
begin
  // Do nothing
end;

procedure TELObjectList.ValidateDeletion;
begin
  // Do nothing
end;

procedure TELObjectList.Change;
begin
  // Do nothing
end;

procedure TELObjectList.Added;
begin
  // Do nothing
end;

procedure TELObjectList.Deleted;
begin
  // Do nothing
end;

{ TELCustomPropsPage }

constructor TELCustomPropsPage.Create(AOwner: TComponent);
begin
  inherited;

  ParentFont := False;
  Width := 188;
  Height := 193;
  DefaultColWidth := 84;
  DefaultRowHeight := 16;
  ColCount := 2;
  RowCount := 0;
  FixedRows := 0;
  FixedCols := 1;
  Color := clBtnFace;
  Options := [goEditing, goAlwaysShowEditor, goThumbTracking];
  DesignOptionsBoost := [];
  FSaveCellExtents := False;
  ScrollBars := ssNone;
  DefaultDrawing := False;
  FItems := TELPropsPageItems.Create(Self);
  FValuesColor := clNavy;
  FBitmap := Graphics.TBitmap.Create;
  UpdatePattern;
  FCellBitmap := Graphics.TBitmap.Create;

  FCellHints := True;
  FHintWnd := THintWindow.Create(Self);
  FHintWnd.Color := clInfoBk;
{$IFDEF COMPILER5_UP}
  FHintWnd.Font.Color := clInfoText;
{$ENDIF}
  FLastXPos := 0;
  FLastYPos := 0;
end;

function TELCustomPropsPage.CreateEditor: TInplaceEdit;
begin
  Result := TELPropsPageInplaceEdit.Create(Self);
end;

procedure TELCustomPropsPage.DrawCell(ACol, ARow: Integer; ARect: TRect; AState: TGridDrawState);

  procedure _DrawExpandButton(AX, AY: Integer; AExpanded: Boolean);
  begin
    if aY < 0 then aY := 0;
    with FCellBitmap.Canvas do
    begin
      Pen.Color := clBlack;
      Brush.Color := clWhite;
      Rectangle(AX, AY, AX + 9, AY + 9);
      Polyline([Point(AX + 2, AY + 4), Point(AX + 7, AY + 4)]);
      if not AExpanded then
        Polyline([Point(AX + 4, AY + 2), Point(AX + 4, AY + 7)]);
    end;
  end;

var
  LS: string;
  LExpandButton, LExpanded: Boolean;
  LIdent: Integer;
  LItem: TELPropsPageItem;
  LCaptionColor: TColor;

begin
  if (ACol <> Col) or (ARow <> Row) or (InplaceEditor = nil) then
  begin
    FCellBitmap.Width := ARect.Right - ARect.Left;
    FCellBitmap.Height := ARect.Bottom - ARect.Top;

            { Fill }
    with FCellBitmap.Canvas do
    begin
      LItem := ItemByRow(ARow);
      if LItem <> nil then
      begin
        if ACol = 0 then
        begin
          if RMLocalizedPropertyNames then
            LS := LItem.VirtualCaption
          else
            LS := LItem.Caption;
        end
        else
          LS := LItem.DisplayValue;
        LExpandButton := LItem.CanExpand;
        LExpanded := LItem.Expanded;
        LIdent := LItem.Ident;
        LCaptionColor := GetItemCaptionColor(LItem);
      end
      else
      begin
        LS := '';
        LExpandButton := False;
        LExpanded := False;
        LIdent := 0;
        LCaptionColor := Font.Color;
      end;
      Brush.Color := Color;
      FCellBitmap.Canvas.Font := self.Font;
      if ACol = 0 then
        Font.Color := LCaptionColor
      else
        Font.Color := ValuesColor;
      TextRect(
        Rect(0, 0, FCellBitmap.Width, FCellBitmap.Height),
        1 + (12 + LIdent) * Ord(ACol = 0),
        1,
        LS
        );
      if LExpandButton and (ACol = 0) then
        _DrawExpandButton(2 + LIdent, (FCellBitmap.Height - 9) div 2{3}, LExpanded); // whf modify

      if ACol = 0 then
      begin
                            { Splitter }
        Pen.Color := clBtnShadow;
        Polyline([Point(FCellBitmap.Width - 2, 0), Point(FCellBitmap.Width - 2, FCellBitmap.Height)]);
        Pen.Color := clBtnHighlight;
        Polyline([Point(FCellBitmap.Width - 1, 0), Point(FCellBitmap.Width - 1, FCellBitmap.Height)]);
      end;
      if ARow = Row - 1 then
      begin
                            { Selected row ages }
        Pen.Color := cl3DDkShadow;
        Polyline([Point(0, FCellBitmap.Height - 2), Point(FCellBitmap.Width, FCellBitmap.Height - 2)]);
        Pen.Color := clBtnShadow;
        Polyline([Point(0, FCellBitmap.Height - 1), Point(FCellBitmap.Width, FCellBitmap.Height - 1)]);
      end
      else
        if ARow = Row then
        begin
                                { Selected row ages }
          if ACol = 0 then
          begin
            Pen.Color := cl3DDkShadow;
            Polyline([Point(0, 0), Point(0, FCellBitmap.Height)]);
            Pen.Color := clBtnShadow;
            Polyline([Point(1, 0), Point(1, FCellBitmap.Height)]);
          end;
          Pen.Color := clBtnHighlight;
          Polyline([Point(0, FCellBitmap.Height - 2), Point(FCellBitmap.Width, FCellBitmap.Height - 2)]);
          Pen.Color := cl3DLight;
          Polyline([Point(0, FCellBitmap.Height - 1), Point(FCellBitmap.Width, FCellBitmap.Height - 1)]);
        end
        else
        begin
                                { Row line }
          if FBitmapBkColor <> Color then
            UpdatePattern;
//          Windows.FillRect(Handle, Rect(0, FCellBitmap.Height - 1, FCellBitmap.Width, FCellBitmap.Height), FBitmap.Brush);

          // whf
//          Brush.Bitmap := FBitmap;
//          FillRect(Rect(0, FCellBitmap.Height - 1, FCellBitmap.Width, FCellBitmap.Height));
//          Brush.Bitmap := nil;
          Pen.Color := clBtnShadow;
          Polyline([Point(0, FCellBitmap.Height - 1), Point(FCellBitmap.Width, FCellBitmap.Height - 1)]);
        end;
    end;
    Canvas.Draw(ARect.Left, ARect.Top, FCellBitmap);
  end
  else
    with Canvas do
    begin
      Pen.Color := clBtnHighlight;
      Polyline([Point(ARect.Left, ARect.Bottom - 2), Point(ARect.Right, ARect.Bottom - 2)]);
      Pen.Color := cl3DLight;
      Polyline([Point(ARect.Left, ARect.Bottom - 1), Point(ARect.Right, ARect.Bottom - 1)]);
    end;
end;

function TELCustomPropsPage.SelectCell(ACol, ARow: Integer): Boolean;
begin
  UpdateData(FOldRow);
  Result := inherited SelectCell(ACol, ARow);
  InvalidateRow(FOldRow - 1);
  InvalidateRow(FOldRow);
  InvalidateRow(FOldRow + 1);
  InvalidateRow(ARow - 1);
  InvalidateRow(ARow);
  InvalidateRow(ARow + 1);
  FOldRow := ARow;
end;

procedure TELCustomPropsPage.Paint;
begin
  inherited;
  DrawCell(Col, Row, CellRect(Col, Row), []);