rm_gridview.pas

中小企业管理系统------ ERP系统原代码

  FGrid.InvalidateGrid;
end;

procedure TRMGridViewForm.SelectionMenuPopup(Sender: TObject);
var
  liCell: TRMCellInfo;
  MenuItem: TMenuItem;
begin
  liCell := FGrid.GetCellInfo(FGrid.Selection.Left, FGrid.Selection.Top);
  case liCell.View.Typ of
    gtMemo: itmMemoView.Checked := True;
    gtCalcMemo: itmCalcMemoView.Checked := True;
    gtPicture: itmPictureView.Checked := True;
  else
    itmCellType.Items[3 + FAddinObjects.IndexOf(liCell.View.ClassName)].Checked := True;
  end;

  while SelectionMenu.Items.Count > 10 do
    SelectionMenu.Items.Delete(10);

//  Page.Objects.Clear;
//  Page.Objects.Add(liCell.View);
  liCell.View.Selected := True;
  liCell.View.DefinePopupMenu(SelectionMenu);

  MenuItem := TMenuItem.Create(Self);
  MenuItem.Caption := '-';
  SelectionMenu.Items.Add(MenuItem);

  MenuItem := TMenuItem.Create(Self);
  MenuItem.Caption := RMLoadStr(rmRes + 211);
  MenuItem.RadioItem := TRUE;
  MenuItem.Checked := FInspForm.Visible;
  MenuItem.OnClick := Pan5Click;
  SelectionMenu.Items.Add(MenuItem);
end;

procedure TRMGridViewForm.itmMemoViewClick(Sender: TObject);
var
  NewType: Integer;
  NewClassName: string;
  liCell: TRMCellInfo;
begin
  liCell := FGrid.GetCellInfo(FGrid.Selection.Left, FGrid.Selection.Top);
  NewClassName := '';
  case TMenuItem(Sender).Tag of
    gtMemo: NewType := gtMemo;
    gtCalcMemo: NewType := gtCalcMemo;
    gtPicture: NewType := gtPicture;
  else
    NewType := gtAddin;
    NewClassName := FAddinObjects[itmCellType.IndexOf(TMenuItem(Sender)) - 3];
  end;

  liCell.ReCreateView(NewType, NewClassName);
end;

type
  THackObject = class(TRMObject)
  end;

procedure TRMGridViewForm.InspGetObjects(List: TStrings);
var
  liCol, liRow: Integer;
  liCell: TRMCellInfo;
  liSelection: TRect;
begin
  List.Clear;
  liSelection := FGrid.Selection;
  for liCol := liSelection.Left to liSelection.Right do
  begin
    for liRow := liSelection.Top to liSelection.Bottom do
    begin
      liCell := FGrid.Cells[liCol, liRow];
      if (liCell.StartCol = liCol) and (liCell.StartRow = liRow) then
      begin
        liCell.View.Selected := True;
        List.Add(liCell.View.Name);
      end;
    end;
  end;
end;

procedure TRMGridViewForm.FillInspFields;
var
  i: Integer;
  s, s1: TStringList;
  t: TRMView;
  liSelNum: Integer;

  procedure GetObjectProperties(t: TRMObject; s: TStrings);
  var
    i: Integer;
    p: PRMPropRec;
  begin
    s.Clear;
    for i := 0 to THackObject(t).PropList.Count - 1 do
    begin
      p := THackObject(t).PropList[i];
      if p^.PropType <> [] then
        s.Add(p^.PropName);
    end;
  end;

  procedure ExcludeStrings(t: TRMObject);
  var
    i: Integer;
    p: PRMPropRec;
  begin
    i := 0;
    while i < s.Count do
    begin
      p := t.PropRec[s[i]];
      if (s1.IndexOf(s[i]) = -1) or ((RMdtOneObject in p^.PropType) and (liSelNum > 1)) then
        s.Delete(i)
      else
        Inc(i);
    end;
  end;

  procedure FillProperties(t: TRMObject);
  var
    i: Integer;
    p: PRMPropRec;
    st: string;
  begin
    for i := 0 to s.Count - 1 do
    begin
      p := t.PropRec[s[i]];
      if (RMdtHasEditor in p^.PropType) and not (RMdtString in p^.PropType) then
        Fld[i] := '(' + p^.PropName + ')'
      else
      begin
        st := t.Prop[p.PropName];
        if (st <> Fld[i]) and (fld[i] <> '-') then
          st := '';
        Fld[i] := st;
      end;
    end;
  end;

  function ConvertToSize(s: string): string;
  var
    v: Double;
  begin
    v := StrToFloat(s);
    Result := FloatToStrF(v, ffGeneral, 4, 2);
  end;

  procedure CreateProperties(t: TRMObject);
  var
    p: PRMPropRec;
    i: Integer;
    dt: TRMDataTypes;
  begin
    for i := 0 to s.Count - 1 do
    begin
      p := t.PropRec[s[i]];
      dt := p^.PropType;
      if RMdtSize in p^.PropType then
      begin
        if fld[i] <> '' then
          fld[i] := ConvertToSize(fld[i]);
        if p^.PropType = [RMdtSize] then
        begin
          dt := dt + [RMdtInteger];
        end;
      end;

      if not (RMdtHasEditor in p.PropType) then
        FInspForm.AddProperty(s[i], fld[i], dt, p^.Enum, p^.EnumValues, p^.PropEditor)
      else
        FInspForm.AddProperty(s[i], fld[i], p^.PropType, p^.Enum, p^.EnumValues, p^.PropEditor);
    end;
  end;

begin
  if FInspBusy then
    Exit;
  FInspBusy := True;
  FInspForm.ClearProperties;
  FInspForm.ObjectName := '';
  FInspForm.CurObject := nil;

  s := TStringList.Create;
  s1 := TStringList.Create;
  try
    liSelNum := Objects.Count;
    for i := 0 to Objects.Count - 1 do
    begin
      t := Objects[i];
      t.DefineProperties;
      GetObjectProperties(t, s1);
      if s.Count = 0 then
        s.Assign(s1)
      else
        ExcludeStrings(t);
    end;

    t := Objects[0];
    if liSelNum = 1 then
    begin
      FInspForm.ObjectName := TRMView(t).Name;
      FInspForm.CurObject := t;
    end;
    s.Sort;

    for i := 0 to s.Count - 1 do
      Fld[i] := '-';

    for i := 0 to Objects.Count - 1 do
    begin
      t := Objects[i];
      if TRMView(t).Selected then
        FillProperties(t);
    end;

    t := Objects[0];
    CreateProperties(t);
  finally
    s.Free;
    s1.Free;
    FInspBusy := False;
  end
end;

procedure TRMGridViewForm.OnModify(Item: Integer);
var
  PropName: string;
  v: Variant;
  t: TRMView;
  i: Integer;

  function _CheckGridView(const aName: string): Boolean;
  var
    i, j: Integer;
    sl: TStringList;
    liPage: TRMPage;
  begin
    sl := TStringList.Create;
    Result := False;
    try
      for i := 0 to CurReport.Pages.Count - 1 do
      begin
        liPage := CurReport.Pages[i];
        for j := 0 to liPage.Objects.Count - 1 do
        begin
          sl.Add(UpperCase(TRMView(liPage.Objects[j]).Name));
          THackView(liPage.Objects[j]).AddChildView(sl);
        end;
      end;

      for i := 0 to sl.Count - 1 do
      begin
        if AnsiCompareText(sl[i], Name) = 0 then
        begin
          Result := True;
          Break;
        end;
      end;
    finally
      sl.Free;
    end;
  end;

begin
  try
    PropName := FInspForm.Items[Item];
    v := FInspForm.PropValue[Item];
    for i := 0 to Objects.Count - 1 do
    begin
      t := TRMView(Objects[i]);
      if PropName = 'Name' then
      begin
        if _CheckGridView(v) then
          t.Prop[PropName] := v;
      end
      else
        t.Prop[PropName] := v;
    end;
  finally
    FillInspFields;
    FInspForm.ItemsChanged;
  end;
end;

procedure TRMGridViewForm.itmDeleteColumnClick(Sender: TObject);
begin
  FModify := True;
  FGrid.DeleteColumn(FGrid.Col);
end;

procedure TRMGridViewForm.itmDeleteRowClick(Sender: TObject);
begin
  FModify := True;
  FGrid.DeleteRow(FGrid.Row);
end;

procedure TRMGridViewForm.itmInsertLeftColumnClick(Sender: TObject);
begin
  FModify := True;
  FGrid.InsertColumn(FGrid.Col);
end;

procedure TRMGridViewForm.itmInsertRightColumnClick(Sender: TObject);
begin
  FModify := True;
  if FGrid.Col = FGrid.ColCount - 1 then
  begin
    FGrid.ColCount := FGrid.ColCount + 1;
  end
  else
    FGrid.InsertColumn(FGrid.Col + 1);
end;

procedure TRMGridViewForm.itmInsertTopRowClick(Sender: TObject);
begin
  FModify := True;
  FGrid.InsertRow(FGrid.Row);
end;

procedure TRMGridViewForm.itmInsertBottomRowClick(Sender: TObject);
begin
  FModify := True;
  if FGrid.Row = FGrid.RowCount - 1 then
  begin
    FGrid.RowCount := FGrid.RowCount + 1;
  end
  else
    FGrid.InsertRow(FGrid.Row + 1);
end;

procedure TRMGridViewForm.itmEditClick(Sender: TObject);
begin
  if FNowView <> nil then
    FNowView.ShowEditor;
end;

procedure TRMGridViewForm.itmFrameTypeClick(Sender: TObject);
begin
  if FNowView <> nil then
    RMFrameEditor(nil);
end;

procedure TRMGridViewForm.btnLeftClick(Sender: TObject);
var
  liCol, liRow: Integer;
begin
  FModify := True;
  for liCol := FGrid.Selection.Left to FGrid.Selection.Right do
  begin
    for liRow := FGrid.Selection.Top to FGrid.Selection.Bottom do
    begin
      case TToolButton(Sender).Tag of
        1: FGrid.Cells[liCol, liRow].HorizAlign := rmtaLeftJustify;
        2: FGrid.Cells[liCol, liRow].HorizAlign := rmtaCenterJustify;
        3: FGrid.Cells[liCol, liRow].HorizAlign := rmtaRightJustify;
        4: FGrid.Cells[liCol, liRow].HorizAlign := rmtaEuqalJustify;
        5: FGrid.Cells[liCol, liRow].VertAlign := rmtlTop;
        6: FGrid.Cells[liCol, liRow].VertAlign := rmtlCenter;
        7: FGrid.Cells[liCol, liRow].VertAlign := rmtlBottom;
      end;
    end;
  end;
  FGrid.InvalidateGrid; ;
end;

procedure TRMGridViewForm.ToolButton3Click(Sender: TObject);
begin
  FGrid.ColWidths[FGrid.Col] := FGrid.ColWidths[FGrid.Col] - 1;
end;

procedure TRMGridViewForm.ToolButton4Click(Sender: TObject);
begin
  FGrid.ColWidths[FGrid.Col] := FGrid.ColWidths[FGrid.Col] + 1;
end;

procedure TRMGridViewForm.ToolButton5Click(Sender: TObject);
begin
  FGrid.RowHeights[FGrid.Row] := FGrid.RowHeights[FGrid.Row] - 1;
end;

procedure TRMGridViewForm.ToolButton6Click(Sender: TObject);
begin
  FGrid.RowHeights[FGrid.Row] := FGrid.RowHeights[FGrid.Row] + 1;
end;

const
  rsInspPanelWidth = 'InspPanelWidth';
  rsInspPanelVisible = 'InspPanelVisible';

procedure TRMGridViewForm.SaveState;
var
  Ini: TRegIniFile;
begin
  Ini := TRegIniFile.Create(RegRootKey);
  try
    Ini.WriteBool(rsForm + 'GridView\' + FInspForm.ClassName, rsVisible, FInspForm.Visible);
    Ini.WriteInteger(rsForm + 'GridView\' + FInspForm.ClassName, 'SplitPos', FInspForm.SplitterPos);
  finally
    Ini.Free;
  end;

  RMSaveToolWinPosition(FInspForm);
  RMSaveFormPosition(Self);
end;

procedure TRMGridViewForm.RestoreState;
var
  Ini: TRegIniFile;
  Nm: string;
begin
  Ini := TRegIniFile.Create(RegRootKey);
  try
    Nm := rsForm + Name;

    RMRestoreToolWinPosition(FInspForm);
    FInspForm.SplitterPos := Ini.ReadInteger(rsForm + 'GridView\' + FInspForm.ClassName, 'SplitPos', 75);
    FInspForm.Visible := Ini.ReadBool(rsForm + 'GridView\' + FInspForm.ClassName, rsVisible, True);
    if FInspForm.SplitterPos < 10 then
      FInspForm.SplitterPos := 10;
  finally
    Ini.Free;
  end;

  RMRestoreFormPosition(Self);
end;

procedure TRMGridViewForm.Pan5Click(Sender: TObject);
begin
  FInspForm.Visible := not FInspForm.Visible;
end;

procedure TRMGridViewForm.MenuFileSaveasClick(Sender: TObject);
begin
  if SaveDialog1.Execute then
  begin
    FFileName := SaveDialog1.FileName;
    FGrid.SaveToFile(FFileName);
  end;
end;

procedure TRMGridViewForm.MenuFileOpenClick(Sender: TObject);
begin
  if OpenDialog1.Execute then
    FGrid.LoadFromFile(OpenDialog1.FileName);
end;

procedure TRMGridViewForm.MenuFileSaveClick(Sender: TObject);
begin
  if FFileName = '' then
    MenuFileSaveas.Click
  else
    FGrid.SaveToFile(FFileName);
end;

procedure TRMGridViewForm.btnBoldClick(Sender: TObject);
var
  liCol, liRow: Integer;
  liFontStyle: TFontStyles;
begin
  FModify := True;
  liFontStyle := [];
  if btnBold.Down then
    liFontStyle := liFontStyle + [fsBold];
  if btnItalic.Down then
    liFontStyle := liFontStyle + [fsItalic];
  if btnUnderline.Down then
    liFontStyle := liFontStyle + [fsUnderline];
  for liCol := FGrid.Selection.Left to FGrid.Selection.Right do
  begin
    for liRow := FGrid.Selection.Top to FGrid.Selection.Bottom do
      FGrid.Cells[liCol, liRow].Font.Style := liFontStyle;
  end;
  FGrid.InvalidateGrid;
end;

initialization
  RMRegisterObjectByRes(TRMGridView, 'RM_GridObject', '插入Grid View', nil);

finalization

end.



//此源码由程序太平洋收集整理发布,任何人都可自由转载,但需保留本站信息
//╭⌒╮┅~ ¤　欢迎光临程序太平洋╭⌒╮
//╭⌒╭⌒╮╭⌒╮～╭⌒╮  ︶  ,︶︶
//,︶︶︶︶,''︶~~ ,''~︶︶　 ,''
//╔　╱◥███◣═╬╬╬╬╬╬╬╬╬╗
//╬ ︱田︱田 田 ︱　　　　　　　　　 ╬
//╬　　　　　　　http://www.5ivb.net ╬
//╬　 ╭○╮●　                   　╬
//╬　　/■\/■\　　                  ╬
//╬　　 <|　||　   有希望,就有成功！ ╬
//╬　　　　　　　　　　　　　　　　　╬
//╚╬╬╬╬╬╬╬╬╬╬╗  ╔╬╬╬╬╝
//
//说明：
//专业提供VB、．NET、Delphi、ASP、PB源码下载
//包括:程序源码,控件,商业源码,系统方案，开发工具，书籍教程，技术文档