rm_gridview.pas

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

{*****************************************}
{                                         }
{         Report Machine v2.0             }
{           Grid Add-In Object            }
{                                         }
{*****************************************}

unit RM_GridView;

interface

{$I RM.inc}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, Menus, Comctrls, RM_Class, RM_Grid, ToolWin, RM_Insp,
  RM_DsgCtrls
{$IFDEF Delphi4}, ImgList{$ENDIF}
{$IFDEF Delphi6}, Variants{$ENDIF};

type
  TRMGridObject = class(TComponent) // fake component
  end;

 { TRMGridView }
  TRMGridView = class(TRMView)
  private
    FGridPopupMenu: TPopupMenu;
    FGrid, FGrid1: TRMGridEx;

    function ParentPage: TRMPage;
    procedure CreateObject;
    procedure OnGridDblClickEvent(Sender: TObject);

    procedure OnItemMergeClick(Sender: TObject);
    procedure OnItemRevertClick(Sender: TObject);
    procedure OnItemInsertRowClick(Sender: TObject);
    procedure OnItemInsertColClick(Sender: TObject);
    procedure OnItemDeleteRowClick(Sender: TObject);
    procedure OnItemDeleteColClick(Sender: TObject);
  protected
    procedure AddChildView(aStringList: TStrings); override;
    procedure FreeChildControl; override;
    procedure GenTmpObjects; override;
    procedure HideControls; override;

    procedure SetPropValue(Index: string; Value: Variant); override;
    function GetPropValue(Index: string): Variant; override;
  public
    class function CanPlaceOnGridView: Boolean; override;
    constructor Create; override;
    destructor Destroy; override;
    procedure Draw(aCanvas: TCanvas); override;
    procedure DefineProperties; override;
    procedure LoadFromStream(Stream: TStream); override;
    procedure SaveToStream(Stream: TStream); override;
    procedure ShowEditor; override;
    property Grid: TRMGridEx read FGrid;
  end;

 { TRMGridViewForm }
  TRMGridViewForm = class(TRMReportDesigner)
    MainMenu1: TMainMenu;
    MenuFile: TMenuItem;
    MenuFileSave: TMenuItem;
    N1: TMenuItem;
    MenuFilePreview: TMenuItem;
    N5: TMenuItem;
    MenuFileExit: TMenuItem;
    N18: TMenuItem;
    MenuEditMerge: TMenuItem;
    MenuEditReverse: TMenuItem;
    MenuCell: TMenuItem;
    MenuCellProperty: TMenuItem;
    MenuEditInsertRow: TMenuItem;
    MenuEditInsertColumn: TMenuItem;
    MenuEditDeleteRow: TMenuItem;
    MenuEditDeleteColumn: TMenuItem;
    StatusBar1: TStatusBar;
    ToolImages: TImageList;
    SelectionMenu: TPopupMenu;
    itmMergeCells: TMenuItem;
    itmSplitCells: TMenuItem;
    N3: TMenuItem;
    itmCellType: TMenuItem;
    StandardBar: TToolBar;
    btnFrameLeft: TToolButton;
    btnFrameRight: TToolButton;
    btnFrameTop: TToolButton;
    btnFrameBottom: TToolButton;
    S5: TToolButton;
    btnNoBorder: TToolButton;
    btnSetBorder: TToolButton;
    btnTopBorder: TToolButton;
    btnBottomBorder: TToolButton;
    S6: TToolButton;
    btnBias1Border: TToolButton;
    btnBias2Border: TToolButton;
    FormattingBar: TToolBar;
    btnBold: TToolButton;
    btnItalic: TToolButton;
    btnUnderline: TToolButton;
    S8: TToolButton;
    btnLeft: TToolButton;
    btnCenter: TToolButton;
    btnRight: TToolButton;
    S9: TToolButton;
    btnTop: TToolButton;
    btnVCenter: TToolButton;
    btnBottom: TToolButton;
    S10: TToolButton;
    btnMerge: TToolButton;
    btnSplit: TToolButton;
    btnOK: TToolButton;
    ToolButton2: TToolButton;
    btnCancel: TToolButton;
    btnSpaceEqual: TToolButton;
    itmMemoView: TMenuItem;
    itmCalcMemoView: TMenuItem;
    itmPictureView: TMenuItem;
    N4: TMenuItem;
    itmFrameType: TMenuItem;
    itmEdit: TMenuItem;
    itmInsert: TMenuItem;
    itmDelete: TMenuItem;
    N6: TMenuItem;
    itmInsertLeftColumn: TMenuItem;
    itmInsertRightColumn: TMenuItem;
    N10: TMenuItem;
    itmInsertTopRow: TMenuItem;
    itmInsertBottomRow: TMenuItem;
    itmDeleteColumn: TMenuItem;
    itmDeleteRow: TMenuItem;
    ToolButton1: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    ToolButton6: TToolButton;
    MenuEdit: TMenuItem;
    MenuFileNew: TMenuItem;
    MenuFileOpen: TMenuItem;
    MenuFileSaveas: TMenuItem;
    ToolButton7: TToolButton;
    btnFileNew: TToolButton;
    btnFileOpen: TToolButton;
    btnFileSave: TToolButton;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btnMergeClick(Sender: TObject);
    procedure btnSplitClick(Sender: TObject);
    procedure btnOKClick(Sender: TObject);
    procedure btnCancelClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure btnFrameLeftClick(Sender: TObject);
    procedure SelectionMenuPopup(Sender: TObject);
    procedure itmMemoViewClick(Sender: TObject);
    procedure itmDeleteColumnClick(Sender: TObject);
    procedure itmDeleteRowClick(Sender: TObject);
    procedure itmInsertLeftColumnClick(Sender: TObject);
    procedure itmInsertRightColumnClick(Sender: TObject);
    procedure itmInsertTopRowClick(Sender: TObject);
    procedure itmInsertBottomRowClick(Sender: TObject);
    procedure itmEditClick(Sender: TObject);
    procedure itmFrameTypeClick(Sender: TObject);
    procedure btnLeftClick(Sender: TObject);
    procedure ToolButton3Click(Sender: TObject);
    procedure ToolButton4Click(Sender: TObject);
    procedure ToolButton5Click(Sender: TObject);
    procedure ToolButton6Click(Sender: TObject);
    procedure MenuFileSaveasClick(Sender: TObject);
    procedure MenuFileOpenClick(Sender: TObject);
    procedure MenuFileSaveClick(Sender: TObject);
    procedure btnBoldClick(Sender: TObject);
  private
    { Private declarations }
    FFileName: string;
    FGridView: TRMGridView;
    FGrid: TRMGridEx;
    FModify: boolean;
    FAddinObjects: TStringList;
    FInspForm: TRMInspForm;
    Fld: array[0..63] of string;
    FBusy, FInspBusy: Boolean;
    FNowView: TRMView;
    FNowCellInfo: TRMCellInfo;
    FcmbFont: TRMFontComboBox;
    FcmbFontSize: TComboBox;

    procedure Localize;
    procedure SaveState;
    procedure RestoreState;
    procedure Pan5Click(Sender: TObject);

    procedure OnModify(Item: Integer);
    procedure FillInspFields;
    procedure InspGetObjects(List: TStrings);

    procedure OnFontNameChange(Sender: TObject);
    procedure OnFontSizeChange(Sender: TObject);
    procedure GetCellState(aCell: TRMCellInfo);
    procedure OnGridDblClickEvent(Sender: TObject);
    procedure OnGridClick(Sender: TObject);
  protected
    function GetDesignerPage: TWinControl; override;
    function GetModified: Boolean; override;
    procedure SetModified(Value: Boolean); override;
  public
    { Public declarations }
    procedure RegisterObject(ButtonBmp: TBitmap; const ButtonHint: string; ButtonTag: Integer; IsControl: Boolean); override;
    procedure RegisterTool(MenuCaption: string; ButtonBmp: TBitmap; OnClick: TNotifyEvent); override;
    procedure BeforeChange; override;
    procedure AfterChange; override;
    function InsertDBField: string; override;
    function InsertExpression: string; override;
    procedure RedrawPage; override;
    procedure SelectObject(ObjName: string); override;
  end;

implementation

uses Printers, Registry, RM_CmpReg, RM_Intrp, RM_Utils, RM_Const, RM_Const1,
  RM_prntr, RM_Common;

{$R *.DFM}

type
  THackDesigner = class(TRMReportDesigner)
  end;

  THackView = class(TRMView)
  end;

var
  SaveDesigner: TRMReportDesigner;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMGridView}

constructor TRMGridView.Create;
begin
  inherited Create;
  BaseName := 'GridView';
  CanGenObject := True;
  Flags := Flags + flDontUndo;

  FGrid := TRMGridEx.Create(nil);
  FGrid.DefaultRowHeight := 17;
  FGrid.ColWidths[0] := 13;
  FGrid.RowHeights[0] := 14;
  FGrid1 := FGrid;
end;

destructor TRMGridView.Destroy;
begin
  FGrid.Free; FGrid := nil;
  FGridPopupMenu.Free; FGridPopupMenu := nil;
  inherited Destroy;
end;

function TRMGridView.ParentPage: TRMPage;
var
  i: Integer;
begin
  Result := nil;
  for i := 0 to CurReport.Pages.Count - 1 do
  begin
    if CurReport.Pages[i].FindObject(Self.Name) <> nil then
    begin
      Result := CurReport.Pages[i];
      Break;
    end;
  end;
end;

procedure TRMGridView.CreateObject;

  procedure CreatePopupMenu;
  var
    MenuItem: TMenuItem;
  begin
    FGridPopupMenu := TPopupMenu.Create(nil);
    FGrid.PopupMenu := FGridPopupMenu;

    MenuItem := TMenuItem.Create(FGridPopupMenu);
    MenuItem.Caption := RMLoadStr(rmRes + 805);
    MenuItem.OnClick := OnItemMergeClick;
    FGridPopupMenu.Items.Add(MenuItem);

    MenuItem := TMenuItem.Create(FGridPopupMenu);
    MenuItem.Caption := RMLoadStr(rmRes + 806);
    MenuItem.OnClick := OnItemRevertClick;
    FGridPopupMenu.Items.Add(MenuItem);

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

    MenuItem := TMenuItem.Create(FGridPopupMenu);
    MenuItem.Caption := RMLoadStr(rmRes + 801);
    MenuItem.OnClick := OnItemInsertColClick;
    FGridPopupMenu.Items.Add(MenuItem);

    MenuItem := TMenuItem.Create(FGridPopupMenu);
    MenuItem.Caption := RMLoadStr(rmRes + 802);
    MenuItem.OnClick := OnItemInsertRowClick;
    FGridPopupMenu.Items.Add(MenuItem);

    MenuItem := TMenuItem.Create(FGridPopupMenu);
    MenuItem.Caption := RMLoadStr(rmRes + 803);
    MenuItem.OnClick := OnItemDeleteColClick;
    FGridPopupMenu.Items.Add(MenuItem);

    MenuItem := TMenuItem.Create(FGridPopupMenu);
    MenuItem.Caption := RMLoadStr(rmRes + 804);
    MenuItem.OnClick := OnItemDeleteRowClick;
    FGridPopupMenu.Items.Add(MenuItem);
  end;

begin
  FGrid.OnDblClick := OnGridDblClickEvent;
  CreatePopupMenu;
end;

procedure TRMGridView.AddChildView(aStringList: TStrings);
var
  liCol, liRow: Integer;
  liCell: TRMCellInfo;
begin
  for liCol := 1 to FGrid1.ColCount - 1 do
  begin
    for liRow := 1 to FGrid1.RowCount - 1 do
    begin
      liCell := FGrid1.Cells[liCol, liRow];
      if liCell.View.Name <> '' then
        aStringList.Add(UpperCase(liCell.View.Name));
    end;
  end;
end;

procedure TRMGridView.HideControls;
begin
  FGrid.Visible := False;
end;

procedure TRMGridView.FreeChildControl;
begin
  FGrid.Parent := nil;
end;

procedure TRMGridView.GenTmpObjects;
var
  i, j: Integer;
  liCell: TRMCellInfo;
  liPage: TRMPage;

  procedure SetCellInfo;
  var
    t: TRMView;
    i: Integer;
    liSize: Integer;
  begin
    t := RMCreateObject(liCell.View.Typ, liCell.View.ClassName);
    t.Assign(liCell.View);

    liSize := x + 1;
    for i := 0 to liCell.StartCol - 1 do
      liSize := liSize + FGrid.ColWidths[i] + 1;
    t.x := liSize;

    liSize := 0;
    for i := liCell.StartCol to liCell.EndCol do
      liSize := liSize + FGrid.ColWidths[i] + 1;
    t.dx := liSize;

    liSize := y + 1;
    for i := 0 to liCell.StartRow - 1 do
      liSize := liSize + FGrid.RowHeights[i] + 1;
    t.y := liSize;

    liSize := 0;
    for i := liCell.StartRow to liCell.EndRow do
      liSize := liSize + FGrid.RowHeights[i] + 1;
    t.dy := liSize;

    if liCell.FillColor = FGrid.Color then
      t.FillColor := clNone
    else
      t.FillColor := liCell.FillColor;

    if t is TRMMemoView then
    begin
      TRMMemoView(t).Font.Assign(liCell.Font);
      TRMMemoView(t).PAlignment := liCell.HorizAlign;
      TRMMemoView(t).PLayout := liCell.VertAlign;
    end;
    liPage.Objects.Add(t);
  end;

begin
  Visible := False;
  liPage := ParentPage;
  for i := 1 to FGrid.RowCount - 1 do
  begin
    j := 1;
    while j < FGrid.ColCount do
    begin
      liCell := FGrid.Cells[j, i];
      if liCell.StartRow = i then
      begin
        SetCellInfo;
      end;
      j := liCell.EndCol + 1;
    end;
  end;

//  CurReport.SaveToFile('e:\ls');
end;

procedure TRMGridView.DefineProperties;
begin
  inherited DefineProperties;
  RemoveProperty('FillColor');
  RemoveProperty('FrameColor');
  RemoveProperty('FrameStyle');
  RemoveProperty('FrameWidth');
  RemoveProperty('FrameTyp');
  RemoveProperty('FillColor');
  RemoveProperty('Memo');
  RemoveProperty('PrintFrame');
  RemoveProperty('PrintVisible');
  RemoveProperty('Visible');

  AddProperty('RowCount', [RMdtInteger], nil);
  AddProperty('ColCount', [RMdtInteger], nil);
end;

procedure TRMGridView.SetPropValue(Index: string; Value: Variant);
begin
  inherited SetPropValue(Index, Value);
  Index := AnsiUpperCase(Index);
  if Index = 'COLCOUNT' then
  begin
    FGrid.ColCount := Value + 1;
  end
  else if Index = 'ROWCOUNT' then
  begin
    FGrid.RowCount := Value + 1;
  end;
end;

function TRMGridView.GetPropValue(Index: string): Variant;
begin
  Index := AnsiUpperCase(Index);
  Result := inherited GetPropValue(Index);
  if Result <> Null then
    Exit;
  if Index = 'COLCOUNT' then
    Result := FGrid.ColCount - 1
  else if Index = 'ROWCOUNT' then
    Result := FGrid.RowCount - 1;
end;

procedure TRMGridView.Draw(aCanvas: TCanvas);
begin
  if DocMode = dmPrinting then
    Exit;

  if FGrid.Parent = nil then
    FGrid.Parent := THackDesigner(RMDesigner).GetDesignerPage;
  if FGridPopupMenu = nil then
    CreateObject;

  FGrid.SetBounds(x, y, dx - 10, dy - 10);
  FGrid.Visible := True;
  BeginDraw(aCanvas);
  CalcGaps;
  ShowBackGround;
  RestoreCoord;
end;

type
  THackCellInfo = class(TRMCellInfo)
  end;

procedure TRMGridView.LoadFromStream(Stream: TStream);
begin
  inherited LoadFromStream(Stream);
  if RMVersion * 100 + HVersion * 10 + LVersion > 40 * 100 + 0 * 10 + 0 then
    FGrid.LoadFromStream(Stream, False)
  else
    FGrid.LoadFromStream(Stream, True);
end;

procedure TRMGridView.SaveToStream(Stream: TStream);
begin
  LVersion := 0;
  inherited SaveToStream(Stream);
  FGrid.SaveToStream(Stream);
end;

class function TRMGridView.CanPlaceOnGridView: Boolean;