rm_cross.pas

进销存·完整的·有数据库的·非常完整·只得参考

  else
    Result := s;
end;

constructor TRMCrossList.Create;
begin
  inherited Create;
  FList := TList.Create;
end;

destructor TRMCrossList.Destroy;
begin
  FList.Free;
  inherited Destroy;
end;

procedure TRMCrossList.Add(v: TRMCrossView);
begin
  FList.Add(v);
  v.FSavedOnBeginDoc := v.FReport.OnCrossBeginDoc;
  v.FReport.OnCrossBeginDoc := v.ReportBeginDoc;
  v.FSavedOnEndDoc := v.FReport.OnCrossEndDoc;
  v.FReport.OnCrossEndDoc := v.ReportEndDoc;
  v.FSavedOnBeforePrint := v.FReport.OnBeforePrint;
  v.FReport.OnBeforePrint := v.ReportBeforePrint;
  v.FSavedOnPrintColumn := v.FReport.OnPrintColumn;
  v.FReport.OnPrintColumn := v.ReportPrintColumn;
end;

procedure TRMCrossList.Delete(v: TRMCrossView);
var
  i: Integer;
  v1: TRMCrossView;
begin
  v.FReport.OnCrossBeginDoc := v.FSavedOnBeginDoc;
  v.FReport.OnCrossEndDoc := v.FSavedOnEndDoc;
  v.FReport.OnBeforePrint := v.FSavedOnBeforePrint;
  v.FReport.OnPrintColumn := v.FSavedOnPrintColumn;

  i := FList.IndexOf(v);
  FList.Delete(i);

  if (i = 0) and (FList.Count > 0) then
  begin
    v := TRMCrossView(FList[0]);
    v.FSavedOnBeginDoc := v.FReport.OnCrossBeginDoc;
    v.FSavedOnEndDoc := v.FReport.OnCrossEndDoc;
    v.FSavedOnBeforePrint := v.FReport.OnBeforePrint;
    v.FSavedOnPrintColumn := v.FReport.OnPrintColumn;
  end;

  for i := 1 to FList.Count - 1 do
  begin
    v := TRMCrossView(FList[i]);
    v1 := TRMCrossView(FList[i - 1]);
    v.FSavedOnBeginDoc := v1.ReportBeginDoc;
    v.FSavedOnEndDoc := v1.ReportEndDoc;
    v.FSavedOnBeforePrint := v1.ReportBeforePrint;
    v.FSavedOnPrintColumn := v1.ReportPrintColumn;
  end;

  if FList.Count > 0 then
  begin
    v := TRMCrossView(FList[FList.Count - 1]);
    v.FReport.OnCrossBeginDoc := v.ReportBeginDoc;
  end;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMCrossView}

class function TRMCrossView.CanPlaceOnGridView: Boolean;
begin
  Result := False;
end;

constructor TRMCrossView.Create;
begin
  inherited Create;
  FCross := nil;
  Typ := gtAddIn;
  BaseName := 'Cross';
  Flags := Flags + flDontUndo;
  POnePerPage := True;
  Restrictions := RMrfDontEditMemo + RMrfDontSize;
  dx := 348;
  dy := 94;
  Visible := False;
  LeftFrame.Visible := True;
  TopFrame.Visible := True;
  RightFrame.Visible := True;
  BottomFrame.Visible := True;

  FReport := CurReport;
  RMCrossList.Add(Self);

  PShowRowTotal := False;
  PShowColTotal := False;
  PShowIndicator := True;
  PSortColHeader := True;
  PSortRowHeader := True;
  FInternalFrame := True;
  FDataWidth := 0; FDataHeight := 0;
  FHeaderWidth := '0';
  FHeaderHeight := '0';
  FDefDY := 18;
  FDictionary := TStringList.Create;
  FAddColumnsHeader := TStringList.Create;
end;

destructor TRMCrossView.Destroy;
var
  i: Integer;
  p: TRMPage;

  procedure Del(s: string);
  var
    v: TRMView;
  begin
    if p <> nil then
    begin
      v := p.FindObject(s);
      if v <> nil then
        p.Delete(p.Objects.IndexOf(v));
    end;
  end;

begin
  p := nil;
  for i := 0 to FReport.Pages.Count - 1 do
  begin
    if FReport.Pages[i].FindObject(Self.Name) <> nil then
    begin
      p := FReport.Pages[i];
      Break;
    end;
  end;

  Del('ColumnHeaderMemo' + Name);
  Del('ColumnTotalMemo' + Name);
  Del('GrandColumnTotalMemo' + Name);
  Del('RowHeaderMemo' + Name);
  Del('CellMemo' + Name);
  Del('RowTotalMemo' + Name);
  Del('GrandRowTotalMemo' + Name);
  Del('ColHeaderMemo' + Name);
  Del('IndicatorMemo' + Name);
  RMCrossList.Delete(Self);
  FDictionary.Free;
  FAddColumnsHeader.Free;
  inherited Destroy;
end;

type
  THackMemoView = class(TRMMemoView)
  end;

  THackUserDataset = class(TRMUserDataset)
  end;

function TRMCrossView.OneObject(p: TRMPage; Name1, Name2: string): TRMMemoView;
begin
  Result := TRMMemoView(RMCreateObject(gtMemo, ''));
  Result.Name := Name1 + Name;
  Result.Memo.Add(Name2);
  Result.Font.Style := [fsBold];
  Result.dx := 80;
  Result.dy := FDefDY;
  Result.Visible := False;
  Result.Alignment := RMtaCenter + RMtaMiddle;
  Result.Prop['FrameTyp'] := 15;
  Result.Restrictions := RMrfDontSize + RMrfDontMove + RMrfDontDelete;
  Result.PChildView := True;
  p.Objects.Add(Result);
end;

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

procedure TRMCrossView.CreateObjects;
var
  v: TRMMemoView;
  p: TRMPage;
begin
  p := ParentPage;

  OneObject(p, 'ColumnHeaderMemo', RMLoadStr(rmRes + 755)); //'Header'

  v := OneObject(p, 'ColumnTotalMemo', RMLoadStr(rmRes + 756)); //'Total'
  v.FillColor := $F5F5F5;

  v := OneObject(p, 'GrandColumnTotalMemo', RMLoadStr(rmRes + 757)); //'Grand total'
  v.FillColor := clSilver;

  OneObject(p, 'RowHeaderMemo', RMLoadStr(rmRes + 755)); //'Header'

  v := OneObject(p, 'CellMemo', RMLoadStr(rmRes + 758)); //'Cell'
  v.Alignment := RMtaRight;
  v.Font.Style := [];

  v := OneObject(p, 'RowTotalMemo', RMLoadStr(rmRes + 756)); //'Total'
  v.FillColor := $F5F5F5;

  v := OneObject(p, 'GrandRowTotalMemo', RMLoadStr(rmRes + 757)); //'Grand total'
  v.FillColor := clSilver;

  OneObject(p, 'IndicatorMemo', '');
end;

procedure TRMCrossView.DefineProperties;
begin
  inherited DefineProperties;
  AddProperty('InternalFrame', [RMdtBoolean], nil);
  AddProperty('RepeatCaptions', [RMdtBoolean], nil);
  AddProperty('ShowRowTotal', [rmdtBoolean], nil);
  AddProperty('ShowColTotal', [rmdtBoolean], nil);
  AddProperty('ShowIndicator', [rmdtBoolean], nil);
  AddProperty('DataWidth', [rmdtInteger], nil);
  AddProperty('DataHeight', [rmdtInteger], nil);
  AddProperty('HeaderWidth', [rmdtString], nil);
  AddProperty('HeaderHeight', [rmdtString], nil);
  AddProperty('SortColHeader', [rmdtBoolean], nil);
  AddProperty('SortRowHeader', [rmdtBoolean], nil);
  AddProperty('MergeRowHeader', [rmdtBoolean], nil);
  AddProperty('ShowRowNo', [rmdtBoolean], nil);
  AddProperty('RowNoHeader', [rmdtString], nil);

  AddProperty('ShowHeader', [rmdtBoolean], nil);
  AddProperty('Dictionary', [rmdtOneObject, rmdtHasEditor], DictionaryEditor);
  AddProperty('AddColumnHeader', [rmdtOneObject, rmdtHasEditor], AddColumnHeaderEditor);

  RemoveProperty('Name');
  RemoveProperty('BandAlign');
  RemoveProperty('PrintFrame');
  RemoveProperty('PrintVisible');
  RemoveProperty('FillColor');
  RemoveProperty('FrameColor');
  RemoveProperty('FrameStyle');
  RemoveProperty('FrameTyp');
  RemoveProperty('FrameWidth');
end;

procedure TRMCrossView.SetPropValue(Index: string; Value: Variant);
begin
  inherited SetPropValue(Index, Value);
  Index := AnsiUpperCase(Index);
  if Index = 'INTERNALFRAME' then
    FInternalFrame := Value
  else if Index = 'REPEATCAPTIONS' then
    FRepeatCaptions := Value
  else if Index = 'SHOWHEADER' then
    FShowHeader := Value
  else if Index = 'SHOWROWTOTAL' then
    PShowRowTotal := Value
  else if Index = 'SHOWCOLTOTAL' then
    PShowColTotal := Value
  else if Index = 'SHOWINDICATOR' then
    PShowIndicator := Value
  else if Index = 'DATAWIDTH' then
    FDataWidth := Value
  else if Index = 'DATAHEIGHT' then
    FDataHeight := Value
  else if Index = 'HEADERWIDTH' then
    FHeaderWidth := Value
  else if Index = 'HEADERHEIGHT' then
    FHeaderHeight := Value
  else if Index = 'SORTCOLHEADER' then
    PSortColHeader := Value
  else if Index = 'SORTROWHEADER' then
    PSortRowHeader := Value
  else if Index = 'MERGEROWHEADER' then
    PMergeRowHeader := Value
  else if Index = 'SHOWROWNO' then
    PShowRowNo := Value
  else if Index = 'ROWNOHEADER' then
    RowNoHeader := Value
end;

function TRMCrossView.GetPropValue(Index: string): Variant;
begin
  Index := AnsiUpperCase(Index);
  Result := inherited GetPropValue(Index);
  if Result <> Null then
    Exit;
  if Index = 'INTERNALFRAME' then
    Result := FInternalFrame
  else if Index = 'REPEATCAPTIONS' then
    Result := FRepeatCaptions
  else if Index = 'SHOWHEADER' then
    Result := FShowHeader
  else if Index = 'SHOWROWTOTAL' then
    Result := PShowRowTotal
  else if Index = 'SHOWCOLTOTAL' then
    Result := PShowColTotal
  else if Index = 'SHOWINDICATOR' then
    Result := PShowIndicator
  else if Index = 'DATAWIDTH' then
    Result := FDataWidth
  else if Index = 'DATAHEIGHT' then
    Result := FDataHeight
  else if Index = 'HEADERWIDTH' then
    Result := FHeaderWidth
  else if Index = 'HEADERHEIGHT' then
    Result := FHeaderHeight
  else if Index = 'SORTCOLHEADER' then
    Result := PSortColHeader
  else if Index = 'SORTROWHEADER' then
    Result := PSortRowHeader
  else if Index = 'MERGEROWHEADER' then
    Result := PMergeRowHeader
  else if Index = 'SHOWROWNO' then
    Result := PShowRowNo
  else if Index = 'ROWNOHEADER' then
    Result := RowNoHeader;
end;

procedure TRMCrossView.ShowEditor;
var
  tmp: TRMCrossForm;
begin
  tmp := TRMCrossForm.Create(Application);
  try
    tmp.Cross := Self;
    tmp.ShowModal;
  finally
    tmp.Free;
  end;
end;

procedure TRMCrossView.Draw(aCanvas: TCanvas);
var
  v: TRMView;
  bmp: TBitmap;
  p: TRMPage;
begin
  if FReport.FindObject('ColumnHeaderMemo' + Name) = nil then
    CreateObjects;
  BeginDraw(aCanvas);
  CalcGaps;
  ShowBackground;
  ShowFrame;

  v := FReport.FindObject('ColumnHeaderMemo' + Name);
  v.SetBounds(x + 92, y + 8, v.dx, v.dy);
  v.Draw(aCanvas);

  v := FReport.FindObject('ColumnTotalMemo' + Name);
  v.SetBounds(x + 176, y + 8, v.dx, v.dy);
  v.Draw(aCanvas);

  v := FReport.FindObject('GrandColumnTotalMemo' + Name);
  v.SetBounds(x + 260, y + 8, v.dx, v.dy);
  v.Draw(aCanvas);

  v := FReport.FindObject('RowHeaderMemo' + Name);
  v.SetBounds(x + 8, y + 28, v.dx, v.dy);
  v.Draw(aCanvas);

  v := FReport.FindObject('CellMemo' + Name);
  v.SetBounds(x + 92, y + 28, v.dx, v.dy);
  v.Draw(aCanvas);

  v := FReport.FindObject('RowTotalMemo' + Name);
  v.SetBounds(x + 8, y + 48, v.dx, v.dy);
  v.Draw(aCanvas);

  v := FReport.FindObject('GrandRowTotalMemo' + Name);
  v.SetBounds(x + 8, y + 68, v.dx, v.dy);
  v.Draw(aCanvas);

  v := FReport.FindObject('IndicatorMemo' + Name);
  if v = nil then
  begin
    p := ParentPage;
    v := OneObject(p, 'IndicatorMemo', '');
  end;
  v.SetBounds(x + 8, y + 8, v.dx, v.dy);
  v.Draw(aCanvas);

  bmp := TBitmap.Create;
  try
    bmp.Handle := LoadBitmap(hInstance, 'RM_CrossObject');
    aCanvas.Draw(x + dx - 20, y + dy - 20, bmp);
  finally
    bmp.Free;
  end;
  RestoreCoord;
end;

procedure TRMCrossView.LoadFromStream(Stream: TStream);
begin
  inherited LoadFromStream(Stream);
  FInternalFrame := RMReadBoolean(Stream);
  FRepeatCaptions := RMReadBoolean(Stream);
  FShowHeader := RMReadBoolean(Stream);

  if RMVersion * 100 + HVersion * 10 + LVersion > 38 * 100 + 0 * 10 + 0 then
  begin
    FDataWidth := RMReadInteger(Stream);
    FDataHeight := RMReadInteger(Stream);
    if LVersion >= 10 then
    begin
      FHeaderWidth := RMReadString(Stream);
      FHeaderHeight := RMReadString(Stream);
    end
    else
    begin
      FHeaderWidth := IntToStr(RMReadInteger(Stream));
      FHeaderHeight := IntToStr(RMReadInteger(Stream));
    end;
  end;

  FDictionary.Text := '';
  if RMVersion * 100 + HVersion * 10 + LVersion > 41 * 100 + 0 * 10 + 0 then
  begin
    FDictionary.Text := RMReadString(Stream);
  end;
  if RMVersion * 100 + HVersion * 10 + LVersion > 42 * 100 + 0 * 10 + 0 then
  begin
    RowNoHeader := RMReadString(Stream);
    RMReadMemo(Stream, FAddColumnsHeader);
  end;
  POnePerPage := True;
end;

procedure TRMCrossView.SaveToStream(Stream: TStream);
begin
  LVersion := 10;
  inherited SaveToStream(Stream);
  RMWriteBoolean(Stream, FInternalFrame);
  RMWriteBoolean(Stream, FRepeatCaptions);
  RMWriteBoolean(Stream, FShowHeader);
  RMWriteInteger(Stream, FDataWidth);
  RMWriteInteger(Stream, FDataHeight);

  RMWriteString(Stream, FHeaderWidth);
  RMWriteString(Stream, FHeaderHeight);

  RMWriteString(Stream, FDictionary.Text);
  RMWriteString(Stream, RowNoHeader);
  RMWriteMemo(Stream, FAddColumnsHeader);
end;

procedure TRMCrossView.DefinePopupMenu(Popup: TPopupMenu);
var
  m: TMenuItem;
begin
  m := TMenuItem.Create(Popup);
  m.Caption := RMLoadStr(rmRes + 761); // 'Repeat captions';
  m.OnClick := P1Click;
  m.Checked := FRepeatCaptions;
  Popup.Items.Add(m);

  m := TMenuItem.Create(Popup);
  m.Caption := RMLoadStr(rmRes + 762); // 'Internal frame';
  m.OnClick := P2Click;
  m.Checked := FInternalFrame;
  Popup.Items.Add(m);

  m := TMenuItem.Create(Popup);