frxinsp.pas

这个是功能强大的报表软件

  begin
    EditPanel.SetBounds(PB.Width - 15, y - 1, 15, FRowHeight - 1);
    EditBtn.SetBounds(0, 0, EditPanel.Width, EditPanel.Height);
    Dec(ww, 15);
  end;
  if ComboPanel.Visible then
  begin
    ComboPanel.SetBounds(PB.Width - 15, y - 1, 15, FRowHeight - 1);
    ComboBtn.SetBounds(0, 0, ComboPanel.Width, ComboPanel.Height);
    Dec(ww, 15);
  end;

  Edit1.Text := GetValue(FItemIndex);
  Edit1.Modified := False;
  Edit1.SetBounds(FSplitterPos + 2, y, ww, FRowHeight - 2);
  Edit1.SelectAll;

  if y + FRowHeight > Box.VertScrollBar.Position + Box.ClientHeight then
    Box.VertScrollBar.Position := y - Box.ClientHeight + FRowHeight;
  if y < Box.VertScrollBar.Position then
    Box.VertScrollBar.Position := y - 1;

  FUpdatingPB := False;
  PBPaint(nil);
end;

procedure TfrxObjectInspector.DrawOneLine(i: Integer; Selected: Boolean);
var
  R: TRect;
  s: String;
  p: TfrxPropertyItem;
  offs, add: Integer;

  procedure Line(x, y, dx, dy: Integer);
  begin
    FTempBMP.Canvas.MoveTo(x, y);
    FTempBMP.Canvas.LineTo(x + dx, y + dy);
  end;

  procedure DrawProperty;
  var
    x, y: Integer;
  begin
    x := offs + GetOffset(i) * (12 + add);
    y := 1 + i * FRowHeight;

    with FTempBMP.Canvas do
    begin
      Pen.Color := clGray;
      Brush.Color := clWhite;

      if offs < 12 then
      begin
        Rectangle(x + 1, y + 2 + add, x + 10, y + 11 + add);
        Line(x + 3, y + 6 + add, 5, 0);
        if s[1] = '+' then
          Line(x + 5, y + 4 + add, 0, 5);

        s := Copy(s, 2, 255);
        Inc(x, 12 + add);
      end;

      Brush.Style := bsClear;
      if ((s = 'Name') or (s = 'Width') or (s = 'Height') or (s = 'Left') or (s = 'Top'))
        and (GetOffset(i) = 0) then
        Font.Style := [fsBold];
      TextRect(R, x, y, s);
    end;
  end;

begin
  if Count > 0 then
  with FTempBMP.Canvas do
  begin
    Pen.Color := clBtnShadow;
    Font.Assign(Self.Font);
    R := Rect(0, i * FRowHeight, FSplitterPos, i * FRowHeight + FRowHeight - 1);

    if Screen.PixelsPerInch > 96 then
      add := 2
    else
      add := 0;
    p := GetItem(i);
    s := GetName(i);
    if p.SubProperty <> nil then
    begin
      offs := 1 + add;
      if p.Expanded then
        s := '-' + s else
        s := '+' + s;
    end
    else
      offs := 13 + add;

    p.Editor.ItemHeight := FRowHeight;

    if Selected then
    begin
      Pen.Color := clBtnFace;
      Line(0, FRowHeight + -1 + i * FRowHeight, PB.Width, 0);
      Brush.Color := clBtnFace;
      FillRect(R);
      DrawProperty;
    end
    else
    begin
      Pen.Color := clBtnFace;
      Line(0, FRowHeight + -1 + i * FRowHeight, PB.Width, 0);
      Pen.Color := clBtnFace;
      Line(FSplitterPos - 1, 0 + i * FRowHeight, 0, FRowHeight);
      DrawProperty;
      Font.Color := clNavy;
      if paOwnerDraw in p.Editor.GetAttributes then
        p.Editor.OnDrawItem(FTempBMP.Canvas,
          Rect(FSplitterPos + 2, 1 + i * FRowHeight, Width, 1 + (i + 1) * FRowHeight))
      else
        TextOut(FSplitterPos + 2, 1 + i * FRowHeight, GetValue(i));
    end;
  end;
end;


{ Form events }

procedure TfrxObjectInspector.FormShow(Sender: TObject);
begin
  AdjustControls;
end;

procedure TfrxObjectInspector.FormResize(Sender: TObject);
var
  h: Integer;
begin
  if Screen.PixelsPerInch > 96 then
    h := 26
  else
    h := 22;
  FTabs.SetBounds(0, ObjectsCB.Top + ObjectsCB.Height + 4, ClientWidth, h);
{$IFDEF UseTabset}
  BackPanel.Top := FTabs.Top + FTabs.Height - 1;
{$ELSE}
  BackPanel.Top := FTabs.Top + FTabs.Height - 2;
{$ENDIF}
  BackPanel.Width := ClientWidth;
  BackPanel.Height := ClientHeight - BackPanel.Top;
  ObjectsCB.Width := ClientWidth;

  FPanel.Height := Count * FRowHeight;
  FPanel.Width := Box.ClientWidth;
  AdjustControls;
end;

procedure TfrxObjectInspector.FormEndDock(Sender, Target: TObject; X, Y: Integer);
begin
  FormResize(nil);
end;

procedure TfrxObjectInspector.TabChange(Sender: TObject);
begin
  if FDesigner.IsPreviewDesigner then
  begin
    FTabs.TabIndex := 0;
    Exit;
  end;
  if FTabs.TabIndex = 0 then
    FList := FPropertyList else
{$IFNDEF FR_VER_BASIC}
    FList := FEventList;
{$ELSE}
    FTabs.TabIndex := 0;
{$ENDIF}
  FItemIndex := -1;
  FormResize(nil);
end;

procedure TfrxObjectInspector.N11Click(Sender: TObject);
begin
  if Edit1.Visible then
    Edit1.CutToClipboard;
end;

procedure TfrxObjectInspector.N21Click(Sender: TObject);
begin
  if Edit1.Visible then
    Edit1.PasteFromClipboard;
end;

procedure TfrxObjectInspector.N31Click(Sender: TObject);
begin
  if Edit1.Visible then
    Edit1.CopyToClipboard;
end;

procedure TfrxObjectInspector.FormDeactivate(Sender: TObject);
begin
  if FDisableUpdate then Exit;
  SetItemIndex(FItemIndex);
end;


{ PB events }

procedure TfrxObjectInspector.PBPaint(Sender: TObject);
var
  i: Integer;
  r: TRect;
begin
  if FUpdatingPB then Exit;

  r := PB.BoundsRect;
  FTempBMP.Width := PB.Width;
  FTempBMP.Height := PB.Height;
  with FTempBMP.Canvas do
  begin
    Brush.Color := Box.Color;
    FillRect(r);
  end;

  if not FDisableUpdate then
  begin
    for i := 0 to Count - 1 do
      if i <> ItemIndex then
        DrawOneLine(i, False);
    if FItemIndex <> -1 then
      DrawOneLine(ItemIndex, True);
  end;

  PB.Canvas.Draw(0, 0, FTempBMP);
end;

procedure TfrxObjectInspector.PBMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  p: TfrxPropertyItem;
  n, x1: Integer;
begin
  FDisableDblClick := False;
  if Count = 0 then Exit;
  if PB.Cursor = crHSplit then
    FDown := True
  else
  begin
    n := Y div FRowHeight;

    if (X > FSplitterPos) and (X < FSplitterPos + 15) and
       (n >= 0) and (n < Count) then
    begin
      p := GetItem(n);
      if p.Editor.ClassName = 'TfrxBooleanProperty' then
      begin
        p.Editor.Edit;
        DoModify;
        PBPaint(nil);
        Exit;
      end;
    end;

    ItemIndex := n;
    Edit1.SetFocus;
    FTickCount := GetTickCount;

    p := GetItem(ItemIndex);
    x1 := GetOffset(ItemIndex) * 12;
    if (X > x1) and (X < x1 + 13) and (p.SubProperty <> nil) then
    begin
      p.Expanded := not p.Expanded;
      FormResize(nil);
      FDisableDblClick := True;
    end;
  end;
end;

procedure TfrxObjectInspector.PBMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  FDown := False;
end;

procedure TfrxObjectInspector.PBMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
var
  n, OffsetX, MaxWidth: Integer;
  s: String;
  HideHint: Boolean;

  procedure ShowHint(const s: String; x, y: Integer);
  var
    HintRect: TRect;
    p: TPoint;
  begin
    p := PB.ClientToScreen(Point(x - 2, y - 2));
    HintRect := FHintWindow.CalcHintRect(1000, s, nil);
    OffsetRect(HintRect, p.X, p.Y);
    FHintWindow.ActivateHint(HintRect, s);
    HideHint := False;
  end;

begin
  HideHint := True;

  if not FDown then
  begin
    if (X > FSplitterPos - 4) and (X < FSplitterPos + 2) then
      PB.Cursor := crHSplit
    else
    begin
      PB.Cursor := crDefault;

      { hint window }
      n := Y div FRowHeight;
      if (X > 12) and (n >= 0) and (n < Count) then
      begin
        if X <= FSplitterPos - 4 then
        begin
          OffsetX := (GetOffset(n) + 1) * 12;
          s := GetName(n);
          MaxWidth := FSplitterPos - OffsetX;
        end
        else
        begin
          OffsetX := FSplitterPos + 1;
          s := GetValue(n);
          MaxWidth := PB.ClientWidth - FSplitterPos;
          if n = ItemIndex then
            MaxWidth := 1000;
        end;

        if PB.Canvas.TextWidth(s) > MaxWidth then
          ShowHint(s, OffsetX, n * FRowHeight);
      end;
    end;
  end
  else
  begin
    if (x > 30) and (x < PB.ClientWidth - 30) then
      FSplitterPos := X;
    AdjustControls;
  end;

  if HideHint then
    FHintWindow.ReleaseHandle;
end;

procedure TfrxObjectInspector.PBDblClick(Sender: TObject);
var
  p: TfrxPropertyItem;
begin
  if (Count = 0) or FDisableDblClick then Exit;

  p := GetItem(ItemIndex);
  if (p <> nil) and (p.SubProperty <> nil) then
  begin
    p.Expanded := not p.Expanded;
    FormResize(nil);
  end;
end;


{ Edit1 events }

procedure TfrxObjectInspector.Edit1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if GetTickCount - FTickCount < GetDoubleClickTime then
    EditBtnClick(nil);
end;

procedure TfrxObjectInspector.Edit1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
  i: Integer;
begin
  if Count = 0 then Exit;
  if Key = vk_Escape then
  begin
    Edit1.Perform(EM_UNDO, 0, 0);
    Edit1.Modified := False;
  end;
  if Key = vk_Up then
  begin
    if ItemIndex > 0 then
      ItemIndex := ItemIndex - 1;
    Key := 0;
  end
  else if Key = vk_Down then
  begin
    if ItemIndex < Count - 1 then
      ItemIndex := ItemIndex + 1;
    Key := 0;
  end
  else if Key = vk_Prior then
  begin
    i := Box.Height div FRowHeight;
    i := ItemIndex - i;
    if i < 0 then
      i := 0;
    ItemIndex := i;
    Key := 0;
  end
  else if Key = vk_Next then
  begin
    i := Box.Height div FRowHeight;
    i := ItemIndex + i;
    ItemIndex := i;
    Key := 0;
  end;
end;

procedure TfrxObjectInspector.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
  if Key = #13 then
  begin
    if paDialog in GetType(ItemIndex) then
      EditBtnClick(nil)
    else
      if Edit1.Modified then
      begin
        Edit1.Modified := False;
        SetValue(ItemIndex, Edit1.Text);
      end;
    Edit1.SelectAll;
    Key := #0;
  end;
end;


{ EditBtn and ComboBtn events }

procedure TfrxObjectInspector.EditBtnClick(Sender: TObject);
begin
  if GetItem(ItemIndex).Editor.Edit then
  begin
    ItemIndex := FItemIndex;
    DoModify;
  end;
end;

procedure TfrxObjectInspector.ComboBtnMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  FPopupLBVisible := GetTickCount - frxPopupFormCloseTime < 100;
end;

procedure TfrxObjectInspector.ComboBtnClick(Sender: TObject);
var
  i, wItems, nItems: Integer;
  p: TPoint;
begin
  if FPopupLBVisible then
    Edit1.SetFocus
  else
  begin
    FPopupForm := TfrxPopupForm.Create(Self);
    FPopupLB := TListBox.Create(FPopupForm);
    with FPopupLB do
    begin
      Parent := FPopupForm;
      Ctl3D := False;
      Align := alClient;
      if paOwnerDraw in GetItem(FItemIndex).Editor.GetAttributes then
        Style := lbOwnerDrawFixed;
      ItemHeight := FRowHeight;
      OnClick := LBClick;
      OnDrawItem := GetItem(FItemIndex).Editor.OnDrawLBItem;
      GetItem(FItemIndex).Editor.GetValues;
      Items.Assign(GetItem(FItemIndex).Editor.Values);

      if Items.Count > 0 then
      begin
        ItemIndex := Items.IndexOf(GetValue(FItemIndex));
        wItems := 0;
        for i := 0 to Items.Count - 1 do
        begin
          if Canvas.TextWidth(Items[i]) > wItems then
            wItems := Canvas.TextWidth(Items[i]);
        end;

        Inc(wItems, 8);
        if paOwnerDraw in GetItem(FItemIndex).Editor.GetAttributes then
          Inc(wItems, GetItem(FItemIndex).Editor.GetExtraLBSize);
        nItems := Items.Count;
        if nItems > 8 then
        begin
          nItems := 8;
          Inc(wItems, GetSystemMetrics(SM_CXVSCROLL));
        end;

        p := Edit1.ClientToScreen(Point(0, Edit1.Height));

        if wItems < PB.Width - FSplitterPos then
          FPopupForm.SetBounds(p.X - 3, p.Y,
                             PB.Width - FSplitterPos + 1, nItems * ItemHeight + 2)
        else
          FPopupForm.SetBounds(p.X + (PB.Width - FSplitterPos - wItems) - 2, p.Y,
                             wItems, nItems * ItemHeight + 2);
        if FPopupForm.Left < 0 then
          FPopupForm.Left := 0;
        if FPopupForm.Top + FPopupForm.Height > Screen.Height then
          FPopupForm.Top := Screen.Height - FPopupForm.Height;
        FDisableUpdate := True;
        FPopupForm.Show;
        FDisableUpdate := False;
      end;
    end;
  end;
end;

procedure TfrxObjectInspector.LBClick(Sender: TObject);
begin
  Edit1.Text := FPopupLB.Items[FPopupLB.ItemIndex];
  FPopupForm.Hide;
  Edit1.SetFocus;
  Edit1.SelectAll;
  SetValue(ItemIndex, Edit1.Text);
end;


{ ObjectsCB events }

procedure TfrxObjectInspector.ObjectsCBClick(Sender: TObject);
begin
  if FUpdatingObjectsCB then Exit;

  FSelectedObjects.Clear;
  if ObjectsCB.ItemIndex <> -1 then
    FSelectedObjects.Add(ObjectsCB.Items.Objects[ObjectsCB.ItemIndex]);
  SetSelectedObjects(FSelectedObjects);
  Edit1.SetFocus;
  if Assigned(FOnSelectionChanged) then
    FOnSelectionChanged(Self);
end;

procedure TfrxObjectInspector.ObjectsCBDrawItem(Control: TWinControl;
  Index: Integer; Rect: TRect; State: TOwnerDrawState);
begin
  if FDisableUpdate then exit;
  with ObjectsCB.Canvas do
  begin
    FillRect(Rect);
    if Index <> -1 then
      TextOut(Rect.Left + 2, Rect.Top + 1, ObjectsCB.Items[Index]);
  end;
end;


{ Mouse wheel }

procedure TfrxObjectInspector.FormMouseWheelDown(Sender: TObject;
  Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
begin
  with Box.VertScrollBar do
    Position := Position + FRowHeight;
end;

procedure TfrxObjectInspector.FormMouseWheelUp(Sender: TObject;
  Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
begin
  with Box.VertScrollBar do
    Position := Position - FRowHeight;
end;

procedure TfrxObjectInspector.CMMouseLeave(var Msg: TMessage);
begin
  FHintWindow.ReleaseHandle;
  inherited;
end;

end.


//