frxdmpclass.pas

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

begin
  Value := PInteger(@FontStyle)^;
  Result := S_OK;
end;

function TfrxDMPMemoView.Set_FontStyle(Value: frxFontStyle): HResult; stdcall;
type
  PfrxDMPFontStyles = ^ TfrxDMPFontStyles;
var
  dst: TfrxDMPFontStyles;
  src:  Integer;
begin
  src := Value;
  dst := PfrxDMPFontStyles(@src)^;
  FontStyle := dst;
  Result := S_OK;
end;
{$ENDIF}

function TfrxDMPMemoView.GetoutBoundText: String;
var
  idx, mH: Integer;
begin
  Result := '';
  mH := Round(Height/fr1CharY);
  for idx := 0 to Memo.Count - 1 do
  if mH >= idx + 1 then
  begin
   Result := Result + Copy(Memo.Strings[idx], 1, Round(Width/fr1CharX)) + #13#10;
  end;
end;

{ TfrxDMPLineView }

class function TfrxDMPLineView.GetDescription: String;
begin
  Result := frxResources.Get('obDMPLine');
end;

procedure TfrxDMPLineView.SetLeft(Value: Extended);
begin
  if Value < 0 then
    Value := Trunc(Value / fr1CharX) * fr1CharX - fr1CharX / 2
  else if Align = baRight then
    Value := Round(Value / fr1CharX) * fr1CharX - fr1CharX / 2
  else
    Value := Trunc(Value / fr1CharX) * fr1CharX + fr1CharX / 2;
  inherited;
end;

procedure TfrxDMPLineView.SetTop(Value: Extended);
begin
  Value := Trunc(Value / fr1CharY) * fr1CharY + fr1CharY / 2;
  inherited;
end;

procedure TfrxDMPLineView.SetWidth(Value: Extended);
begin
  if Align = baWidth then
    Value := Trunc(Value / fr1CharX) * fr1CharX
  else
    Value := Round(Value / fr1CharX) * fr1CharX;
  inherited;
end;

procedure TfrxDMPLineView.SetFontStyle(const Value: TfrxDMPFontStyles);
begin
  FFontStyle := Value;
  ParentFont := False;
end;

procedure TfrxDMPLineView.SetParentFont(const Value: Boolean);
begin
  inherited;
  if Value then
    if Page is TfrxDMPPage then
      FFontStyle := TfrxDMPPage(Page).FontStyle;
end;

function TfrxDMPLineView.IsFontStyleStored: Boolean;
begin
  Result := not ParentFont;
end;

function TfrxDMPLineView.Diff(AComponent: TfrxComponent): String;
var
  l: TfrxDMPLineView;
begin
  Result := inherited Diff(AComponent);
  l := TfrxDMPLineView(AComponent);
  if FFontStyle <> l.FontStyle then
    Result := Result + DiffFontStyle(FFontStyle);
end;

{$IFDEF FR_COM}
function TfrxDMPLineView.Get_FontStyle(out Value: frxFontStyle): HResult;
begin
  Value := PInteger(@FontStyle)^;
  Result := S_OK;
end;

function TfrxDMPLineView.Set_FontStyle(Value: frxFontStyle): HResult; stdcall;
type
  PfrxDMPFontStyles = ^ TfrxDMPFontStyles;
var
  dst: TfrxDMPFontStyles;
  src:  Integer;
begin
  src := Value;
  dst := PfrxDMPFontStyles(@src)^;
  FontStyle := dst;
  Result := S_OK;
end;
{$ENDIF}

{ TfrxDMPCommand }

class function TfrxDMPCommand.GetDescription: String;
begin
  Result := frxResources.Get('obDMPCmd');
end;

procedure TfrxDMPCommand.SetLeft(Value: Extended);
begin
  Value := Round(Value / fr1CharX) * fr1CharX;
  inherited;
end;

procedure TfrxDMPCommand.SetTop(Value: Extended);
begin
  Value := Round(Value / fr1CharY) * fr1CharY;
  inherited;
end;

function TfrxDMPCommand.Diff(AComponent: TfrxComponent): String;
begin
  Result := inherited Diff(AComponent);
  if FCommand <> TfrxDMPCommand(AComponent).Command then
    Result := Result + frxStrToXML(FCommand);
end;

function TfrxDMPCommand.ToChr: String;
var
  i: Integer;
  s, s1: String;
begin
  Result := '';
  s := FCommand;
  s1 := '';
  if Pos('#', s) = 1 then
  begin
    s := s + '#';
    for i := 2 to Length(s) do
      if s[i] = '#' then
      begin
        Result := Result + Chr(StrToInt(s1));
        s1 := '';
      end
      else
        s1 := s1 + s[i];
  end
  else
  begin
    for i := 1 to Length(s) do
    begin
      s1 := s1 + s[i];
      if i mod 2 = 0 then
      begin
        Result := Result + Chr(StrToInt('$' + s1));
        s1 := '';
      end;
    end;
  end;
end;

{$IFDEF FR_COM}
function TfrxDMPCommand.Get_Command(out Value: WideString): HResult;
begin
  Value := Command;
  Result := S_OK;
end;

function TfrxDMPCommand.Set_Command(const Value: WideString): HResult;
begin
  Command := Value;
  Result := S_OK;
end;
{$ENDIF}

{ TfrxDMPPage }

constructor TfrxDMPPage.Create(AOwner: TComponent);
begin
  inherited;
  ResetFontOptions;
end;

procedure TfrxDMPPage.ResetFontOptions;
begin
  Font.OnChange := nil;
  Font.Name := 'Courier New';
  Font.Size := 12;
  Font.Style := [];
  if fsxBold in FFontStyle then
    Font.Style := Font.Style + [fsBold];
  if fsxItalic in FFontStyle then
    Font.Style := Font.Style + [fsItalic];
  if fsxUnderline in FFontStyle then
    Font.Style := Font.Style + [fsUnderline];
end;

procedure TfrxDMPPage.SetDefaults;
begin
  inherited;
  LeftMargin := fr1CharX / fr01cm;
  RightMargin := fr1CharX / fr01cm;
  TopMargin := fr1CharY / fr01cm;
  BottomMargin := fr1CharY / fr01cm;
  FPaperWidth := Trunc(FPaperWidth * fr01cm / fr1CharX) * fr1CharX / fr01cm;
  FPaperHeight := Trunc(FPaperHeight * fr01cm / fr1CharY) * fr1CharY / fr01cm;
  UpdateDimensions;
end;

procedure TfrxDMPPage.SetFontStyle(const Value: TfrxDMPFontStyles);
var
  i: Integer;
  l: TList;
  c: TfrxComponent;
begin
  FFontStyle := Value;
  ResetFontOptions;

  l := AllObjects;
  for i := 0 to l.Count - 1 do
  begin
    c := l[i];
    if c.ParentFont then
      c.ParentFont := True;
  end;
end;

procedure TfrxDMPPage.SetPaperHeight(const Value: Extended);
begin
  inherited;
  FPaperHeight := Round(FPaperHeight * fr01cm / fr1CharY) * fr1CharY / fr01cm;
  UpdateDimensions;
end;

procedure TfrxDMPPage.SetPaperSize(const Value: Integer);
begin
  inherited;
  FPaperWidth := Round(FPaperWidth * fr01cm / fr1CharX) * fr1CharX / fr01cm;
  FPaperHeight := Round(FPaperHeight * fr01cm / fr1CharY) * fr1CharY / fr01cm;
  UpdateDimensions;
end;

procedure TfrxDMPPage.SetPaperWidth(const Value: Extended);
begin
  inherited;
  FPaperWidth := Round(FPaperWidth * fr01cm / fr1CharX) * fr1CharX / fr01cm;
  UpdateDimensions;
end;

{$IFDEF FR_COM}
function TfrxDMPPage.Get_FontStyle(out Value: frxFontStyle): HResult;
begin
  Value := PInteger(@FontStyle)^;
  Result := S_OK;
end;

function TfrxDMPPage.Set_FontStyle(Value: frxFontStyle): HResult; stdcall;
type
  PfrxDMPFontStyles = ^ TfrxDMPFontStyles;
var
  dst: TfrxDMPFontStyles;
  src:  Integer;
begin
  src := Value;
  dst := PfrxDMPFontStyles(@src)^;
  FontStyle := dst;
  Result := S_OK;
end;
{$ENDIF}

initialization
  RegisterClasses([TfrxDMPPage]);
  frxObjects.RegisterObject1(TfrxDMPMemoView, nil, '', '', 0, 2, [ctDMP]);
  frxObjects.RegisterObject1(TfrxDMPLineView, nil, '', '', 0, 5, [ctDMP]);
  frxObjects.RegisterObject1(TfrxDMPCommand, nil, '', '', 0, 21, [ctDMP]);

finalization
  UnRegisterClasses([TfrxDMPPage]);
  frxObjects.UnRegister(TfrxDMPMemoView);
  frxObjects.UnRegister(TfrxDMPLineView);
  frxObjects.UnRegister(TfrxDMPCommand);


end.


//