rm_shape.pas

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

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

unit RM_shape;

interface

{$I RM.inc}

uses
  Windows, Messages, SysUtils, Classes, Graphics, RM_Class, StdCtrls,
  Controls, ExtCtrls, Menus
{$IFDEF Delphi6}, Variants{$ENDIF};

const
  rmskRectangle = 0;
  rmskRoundRectangle = 1;
  rmskEllipse = 2;
  rmskTriangle = 3;
  rmskDiagonal1 = 4;
  rmskDiagonal2 = 5;

	rmskSquare = 100;
  rmskRoundSquare = 101;
  rmskCircle = 102;
  rmHorLine = 103;
  rmRightAndLeft = 104;
  rmTopAndBottom = 105;
  rmVertLine = 106;

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

  TRMShapeView = class(TRMView)
  private
    procedure DrawShape;
	protected
  	function GetViewCommon: string; override;
    procedure SetPropValue(Index: String; Value: Variant); override;
    function GetPropValue(Index: String): Variant; override;
  public
    ShapeType: Byte;
    PenMode: TPenMode;
    constructor Create; override;
    procedure Draw(aCanvas: TCanvas); override;
    procedure LoadFromStream(Stream: TStream); override;
    procedure SaveToStream(Stream: TStream); override;
    procedure DefinePopupMenu(Popup: TPopupMenu); override;
    procedure DefineProperties; override;
  end;

implementation

uses RM_CmpReg, RM_Utils, RM_Const;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TRMShapeView }
constructor TRMShapeView.Create;
begin
  inherited Create;
  ShapeType := rmskRectangle;
  PenMode := pmCopy;
  BaseName := 'Shape';

  RMConsts['skRectangle'] := rmskRectangle;
  RMConsts['skRoundRectangle'] := rmskRoundRectangle;
  RMConsts['skEllipse'] := rmskEllipse;
  RMConsts['skTriangle'] := rmskTriangle;
  RMConsts['skDiagonal1'] := rmskDiagonal1;
  RMConsts['skDiagonal2'] := rmskDiagonal2;
  RMConsts['skSquare'] := rmskSquare;
  RMConsts['skRoundSquare'] := rmskRoundSquare;
  RMConsts['skCircle'] := rmskCircle;

  RMConsts['pmBlack'] := pmBlack;
  RMConsts['pmWhite'] := pmWhite;
  RMConsts['pmNop'] := pmNop;
  RMConsts['pmNot'] := pmNot;
  RMConsts['pmCopy'] := pmCopy;
  RMConsts['pmNotCopy'] := pmNotCopy;
  RMConsts['pmMergePenNot'] := pmMergePenNot;
  RMConsts['pmMaskPenNot'] := pmMaskPenNot;
  RMConsts['pmMergeNotPen'] := pmMergeNotPen;
  RMConsts['pmMaskNotPen'] := pmMaskNotPen;
  RMConsts['pmNotMerge'] := pmNotMerge;
  RMConsts['pmMask'] := pmMask;
  RMConsts['pmNotMask'] := pmNotMask;
  RMConsts['pmXor'] := pmXor;
  RMConsts['pmNotXor'] := pmNotXor;
end;

procedure TRMShapeView.DefineProperties;
begin
  inherited DefineProperties;
  AddEnumProperty('Shape',
    'skRectangle;skRoundRectangle;skEllipse;skTriangle;skDiagonal1;skDiagonal2;skSquare;skRoundSquare;skCircle',
    [rmskRectangle,rmskRoundRectangle,rmskEllipse,rmskTriangle,rmskDiagonal1,rmskDiagonal2,rmskSquare,rmskRoundSquare,rmskCircle], nil);
  AddEnumProperty('PenMode',
    'pmBlack;pmWhite;pmNop;pmNot;pmCopy;pmNotCopy;pmMergePenNot;pmMaskPenNot;' +
    'pmMergeNotPen;pmMaskNotPenpmMerge;pmNotMerge;pmMask;pmNotMask;pmXor;pmNotXor',
    [pmBlack,pmWhite,pmNop,pmNot,pmCopy,pmNotCopy,pmMergePenNot,pmMaskPenNot,
    pmMergeNotPen,pmMaskNotPen,pmNotMerge,pmMask,pmNotMask,pmXor,pmNotXor], nil);

  AddProperty('OnBeforePrint', [RMdtHasEditor, RMdtOneObject], RMScript_BeforePrintEditor);
  AddProperty('OnAfterPrint', [RMdtHasEditor, RMdtOneObject], RMScript_AfterPrintEditor);
end;

procedure TRMShapeView.SetPropValue(Index: String; Value: Variant);
begin
  inherited SetPropValue(Index, Value);
  Index := AnsiUpperCase(Index);
  if Index = 'SHAPE' then
    ShapeType := Value
  else if Index = 'PENMODE' then
  	PenMode := Value
end;

function TRMShapeView.GetPropValue(Index: String): Variant;
begin
  Index := AnsiUpperCase(Index);
  Result := inherited GetPropValue(Index);
  if Result <> Null then Exit;
  if Index = 'SHAPE' then
    Result := ShapeType
  else if Index = 'PENMODE' then
  	Result := PenMode;
end;

procedure TRMShapeView.DrawShape;
var
  x1, y1, min: Integer;
begin
  x1 := Round((SaveX + SaveDX) * ScaleX + OffsX);
  y1 := Round((SaveY + SaveDY) * ScaleY + OffsY);
  min := dx;
  if dy < dx then
    min := dy;
  with Canvas do
  begin
		if TopFrame.Visible then
	    Pen.Width := Round(TopFrame.Width)
    else
    	Pen.Width := Round(SaveFWTop * ScaleX);

    Pen.Color := Prop['FrameColor'];
    Pen.Style := TPenStyle(Prop['FrameStyle']);  //    Pen.Style := psSolid;
    SetBkMode(Handle, Opaque);
    Brush.Style := bsClear;
    if FillColor <> clNone then
      Brush.Color := FillColor;
    case ShapeType of
      rmskRectangle:
      	Rectangle(x, y, x1 + 1, y1 + 1);
      rmskRoundRectangle:
      	RoundRect(x, y, x1 + 1, y1 + 1, min div 4, min div 4);
      rmskEllipse:
      	Ellipse(x, y, x1 + 1, y1 + 1);
      rmskTriangle:
        begin
          MoveTo(x1, y1);
          LineTo(x, y1);
          LineTo(x + (x1 - x) div 2, y);
          LineTo(x1, y1);
          FloodFill(x + (x1 - x) div 2, y + (y1 - y) div 2, clNone, fsSurface);
        end;
      rmskDiagonal1:
        begin
          MoveTo(x, y1);
          LineTo(x1, y);
        end;
      rmskDiagonal2:
        begin
          MoveTo(x, y);
          LineTo(x1, y1);
        end;
			rmskSquare:
      	begin
	        Rectangle(x, y, x + min, y + min);
        end;
		  rmskRoundSquare:
      	begin
        RoundRect(x, y, x + min, y + min, min div 4, min div 4);
        end;
		  rmskCircle:
	      begin
	        Ellipse(X, Y, X + min, Y + min);
  	    end;
		  rmHorLine:
      	begin
          MoveTo(x, y + dy div 2);
          LineTo(x1, y + dy div 2);
        end;
		  rmRightAndLeft:
      	begin
          MoveTo(x, y);
          LineTo(x, y1);
          MoveTo(x1 - 1, y);
          LineTo(x1 - 1, y1);
        end;
		  rmTopAndBottom:
      	begin
          MoveTo(x, y);
          LineTo(x1, y);
          MoveTo(x, y1 - 1);
          LineTo(x1, y1 - 1);
        end;
		  rmVertLine:
      	begin
          MoveTo(x + dx div 2, y);
          LineTo(x + dx div 2, y1);
        end;
    end;
  end;
end;

procedure TRMShapeView.Draw(aCanvas: TCanvas);
var
  FillC: Integer;
begin
	LeftFrame.Visible := True;
  RightFrame.Visible := True;
  TopFrame.Visible := True;
  BottomFrame.Visible := True;
  BeginDraw(aCanvas);
  Memo1.Assign(Memo);
  CalcGaps;
  FillC := FillColor;
  FillColor := clNone;
  ShowBackground;
  FillColor := FillC;
  DrawShape;
  RestoreCoord;
end;

procedure TRMShapeView.LoadFromStream(Stream: TStream);
begin
  inherited LoadFromStream(Stream);
  Stream.Read(ShapeType, 1);
  Stream.Read(PenMode, 1);
end;

procedure TRMShapeView.SaveToStream(Stream: TStream);
begin
	LVersion := 0;
  inherited SaveToStream(Stream);
  Stream.Write(ShapeType, 1);
  Stream.Write(PenMode, 1);
end;

procedure TRMShapeView.DefinePopupMenu(Popup: TPopupMenu);
begin
  // no specific items in popup menu
end;

function TRMShapeView.GetViewCommon: string;
begin
	Result := '[Shape]';
end;

initialization
  RMRegisterObjectByRes(TRMShapeView, 'RM_ShapeObject', RMLoadStr(SInsShape), nil);

finalization

end.



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