picbase.pas

很不错的delphi 画失量图的delphi源代码

//////////////////////////////////
//王昌雨
//2004-05-20
//图象基类
/////////////////////////////////
unit PicBase;

interface

uses Classes,Graphics,Controls,Windows, Messages,
  PicConst;

Type
  TDrawEndEvent=procedure(Pic:TComponent) of Object;

type
  TPicBase=Class(TComponent)
  private
    FPicPen:TPen;
    FPicBrush:TBrush;
    FPicRect:TRect;
    FPicFont:TFont;
    FChoosed:Boolean;
    FPicId:TPicType;
    fPicIndex:Integer;
    fFocusPen:TPen;
    fFocusBrush:TBrush;
    fDrawEndEvent: TDrawEndEvent;  //结束事件
  protected
  public
    constructor Create;   reintroduce;  overload; 
    destructor  Destroy;  override;
    procedure DrawPic(ACanvas:TCanvas);  virtual;        //在acanvas上画图
    procedure MovePic(ACanvas:TCanvas; APoint:TPoint); virtual; //在acanvas上移动
    function  MouseInPicRegion(ACanvas:TCanvas;APoint:TPoint): MOUSE_POS; virtual; //鼠标位置
    function  CreatePicRgn(ACanvas:TCanvas): HRGN; virtual; //产生图元区域的句柄
    procedure DrawFocusRect(ACanvas:TCanvas); Virtual; //在Acanvas上画焦点
    procedure PicChangeing(ACanvas:TCanvas; mouseInPos: MOUSE_POS; chooseRect:TRect;
        mouseDownOldX, mouseDownOldY, mouseOldX, mouseOldY, mouseX, mouseY:Integer); virtual;
    procedure PicChangedUpdate(ACanvas:TCanvas; mouseInPos: MOUSE_POS; chooseCellRect: TRect; //选择图元形成的矩形
        mouseDownOldX, mouseDownOldY: Integer;  mouseX, mouseY: Integer); virtual; //鼠标当前的坐标
    //鼠标响应
    procedure ParentMouseDown(ACanvas:TCanvas; CursorNum:Integer;Button: TMouseButton;Shift: TShiftState; APoint:TPoint); virtual;
    procedure ParentMouseUp(ACanvas:TCanvas;CursorNum:Integer; Button: TMouseButton;  Shift: TShiftState; APoint:TPoint); virtual;
    procedure ParentMouseMove(ACanvas:TCanvas;CursorNum:Integer; Shift: TShiftState;APoint:TPoint);  virtual;
    //键盘响应
    procedure ParentKeyDown(ACanvas:TCanvas;CursorNum:Integer; var Key: Word; mouse: TPoint; Shift:TShiftState); virtual;
    procedure ParentKeyUp(ACanvas:TCanvas; CursorNum:Integer; var Key: Word; mouse: TPoint; Shift: TShiftState); virtual;
    // function and procesure
    function  MouseInPicRect(x, y: Integer): Boolean;
    //判断(x,y) 点是否在图元矩形区域内
    //位置代码可参见 PicConst.pas
    procedure AssignPic(SourcePic: TPicBase); virtual;
    function  GetPicPosition: TRect; virtual;
    procedure GetClassDataFromChar(var Len:Integer; var Buf:Array of Char); virtual;
    procedure SaveClassDataToChar(var Len:Integer; var Buf:Array of Char);  virtual;

  published
    property PicPen:TPen read fPicPen Write fPicPen;
    property PicBrush:TBrush read fPicBrush write fPicBrush;
    property PicRect: TRect Read FPicRect Write fPicRect;
    property PicFont: TFont read fPicFont write fPicFont;
    property FocusPen:TPen read fFocusPen write fFocusPen;
    property FocusBrush:TBrush read fFocusBrush write fFocusBrush;
    property Choosed:Boolean read FChoosed write FChoosed;
    property PicId:TPicType read fPicId Write fPicId;
    property DrawEndEvent:TDrawEndEvent read fDrawEndEvent Write fDrawEndEvent;
    property PicIndex:Integer read fPicIndex write fPicIndex;
  end;

  //Function AddrOffSet(lp:Pointer;hp:Pointer):Integer;

implementation

{
Function AddrOffSet(lp:Pointer;hp:Pointer):Integer;
begin
  Result:=Abs(LongInt(hp)-LongInt(lp));
end; }

{TPicBase}
constructor TPicBase.Create;
begin
  inherited Create(nil);
  //画笔
  FPicPen:=TPen.Create;
  FPicPen.Color:=clRed;
  //画刷
  FPicBrush:=TBrush.Create;
  FPicBrush.Color:=clBlack;
  FPicBrush.Style:=bsClear;
  //字体
  FPicFont:=TFont.Create;
  FPicFont.Color:=clRed;
  FPicFont.Name:='宋体';
  FPicFont.Size:=10;
  //焦点画笔
  fFocusPen:=TPen.Create;
  fFocusPen.Style:=psSolid;
  fFocusPen.Mode:=pmCopy;
  fFocusPen.Color:=clWhite;
  //焦点画刷
  fFocusBrush:=TBrush.Create;
  fFocusBrush.Style:=bsSolid;
  fFocusBrush.Color:=clFuchsia;
  //标识为0，图型类型什么都不是
  fPicId:=PIC_NONE;
  //没有索引
  fPicIndex:=-1;
end;

destructor  TPicBase.Destroy;
begin
  //释放变量
  FPicPen.Free;
  FPicBrush.Free;
  FPicFont.Free;
  fFocusPen.Free;
  fFocusBrush.Free;
  Inherited Destroy;
end;


procedure TPicBase.DrawPic(ACanvas:TCanvas);
begin
  //在Acanvas上画图
end;

procedure TPicBase.MovePic(ACanvas:TCanvas; APoint:TPoint);
begin
  //在Acanvas上移动
end;

function  TPicBase.MouseInPicRegion(ACanvas:TCanvas;APoint:TPoint): MOUSE_POS;
begin
  //鼠标在图象中的位置
  Result:=POS_CENTER;
end;

function  TPicBase.CreatePicRgn(ACanvas:TCanvas): HRGN;
begin
  //产生图元区域的句柄
  Result := CreateRectRgn(FPicRect.Left,FPicRect.Top,FPicRect.Right,FPicRect.Bottom);
end;

procedure TPicBase.DrawFocusRect(ACanvas:TCanvas);
begin
  //在Acanvas上画焦点
end;

procedure TPicBase.PicChangeing(ACanvas:TCanvas; mouseInPos: MOUSE_POS; chooseRect:TRect;
  mouseDownOldX, mouseDownOldY, mouseOldX, mouseOldY, mouseX, mouseY:Integer);
begin

end;

procedure TPicBase.PicChangedUpdate(ACanvas:TCanvas; mouseInPos: MOUSE_POS; chooseCellRect: TRect; //选择图元形成的矩形
  mouseDownOldX, mouseDownOldY: Integer; mouseX, mouseY: Integer); //鼠标当前的坐标
begin

end;

procedure TPicBase.ParentMouseDown(ACanvas:TCanvas;CursorNum:Integer; Button: TMouseButton;Shift: TShiftState; APoint:TPoint);
begin

end;

procedure TPicBase.ParentMouseUp(ACanvas:TCanvas;CursorNum:Integer; Button: TMouseButton;  Shift: TShiftState; APoint:TPoint);
begin

end;

procedure TPicBase.ParentMouseMove(ACanvas:TCanvas;CursorNum:Integer;Shift: TShiftState;APoint:TPoint);
begin

end;

//键盘响应
procedure TPicBase.ParentKeyDown(ACanvas:TCanvas;CursorNum:Integer; var Key: Word; mouse: TPoint; Shift:TShiftState);
begin

end;

procedure TPicBase.ParentKeyUp(ACanvas:TCanvas;CursorNum:Integer; var Key: Word; mouse: TPoint; Shift: TShiftState);
begin

end;
// function and procesure
function  TPicBase.MouseInPicRect(x, y: Integer): Boolean;
begin
  Result:=True;
end;

//判断(x,y) 点是否在图元矩形区域内
//位置代码可参见 PicConst.pas
procedure TPicBase.AssignPic(SourcePic: TPicBase);
begin
  FPicPen.Assign(SourcePic.PicPen);
  FPicBrush.Assign(SourcePic.PicBrush);
  FPicFont.Assign(SourcePic.PicFont);
  FPicRect:=SourcePic.PicRect;
  FChoosed:=SourcePic.Choosed;
  FFocusPen.Assign(SourcePic.FocusPen);
  fFocusBrush.Assign(SourcePic.FocusBrush);
  FPicId:=SourcePic.PicId;
  fPicIndex:=SourcePic.PicIndex;
end;

function  TPicBase.GetPicPosition: TRect;
begin
  Result:=FPicRect;
end;

procedure TPicBase.GetClassDataFromChar(var Len:Integer; var Buf:Array of Char);
var
  OldP:Pointer;
  P:Pointer;
  mRect:TRect;
  fn:String;
  fl:Integer;
  i1:Integer;
begin
  P:=Pointer(@Buf);
  OldP:=P;
  PicPen.Color:=PInteger(P)^;
  Inc(PInteger(P));      //4字节
  PicPen.Width:=PInteger(P)^;
  Inc(PInteger(P));      //4字节
  PicPen.Style:=TPenStyle(PByte(P)^);
  Inc(PByte(P));        //1字节
  PicBrush.Color:=PInteger(P)^;
  Inc(PInteger(P));      //4字节
  PicBrush.Style:=TBrushStyle(PByte(P)^);
  Inc(PByte(P));      //4字节
  With mRect do begin
    Left:=PInteger(P)^;
    Inc(PInteger(P));      //4字节
    Top:=PInteger(P)^;
    Inc(PInteger(P));      //4字节
    Right:=PInteger(P)^;
    Inc(PInteger(P));      //4字节
    Bottom:=PInteger(P)^;
    Inc(PInteger(P));      //4字节
  end;
  PicRect:=mRect;
  fl:=PInteger(P)^;      //4字节
  Inc(PInteger(P));
  fn:='';
  For i1:=1 to fl do begin
    fn:=fn+Chr(PByte(P)^);
    Inc(PByte(P));
  end;
  PicFont.Name:=fn;   //fl字节
  PicFont.Charset:=PByte(P)^;
  Inc(PByte(P));      //1字节
  PicFont.Size:=PInteger(P)^;
  Inc(PInteger(P));   //4字节
  PicFont.Style:=TFontStyles(Byte(PByte(P)^));
  Inc(PByte(P));      //1字节
  PicFont.Color:=PInteger(P)^;
  Inc(PInteger(P));      //4字节
  fChoosed:=Boolean(PByte(P)^);
  Inc(PByte(P));      //1字节
  fPicId:=TPicType(PByte(P)^);
  Inc(PByte(P));      //1字节
  fPicindex:=PInteger(P)^;
  Inc(PInteger(P));      //4字节
  //Len:=AddrOffSet(OldP,P);
  Len:=LongInt(P)-LongInt(oldp);
end;

procedure TPicBase.SaveClassDataToChar(var Len:Integer; var Buf:Array of Char);
var
  OldP:Pointer;
  P:Pointer;
  fl:Integer;
  fn:String;
  i1:Integer;
begin
  P:=Pointer(@Buf);
  OldP:=P;
  PInteger(P)^:=PicPen.Color;
  Inc(PInteger(P));      //4字节
  PInteger(P)^:=PicPen.Width;
  Inc(PInteger(P));      //4字节
  PByte(P)^:=Ord(PicPen.Style);
  Inc(PByte(P));        //1字节
  PInteger(P)^:=PicBrush.Color;
  Inc(PInteger(P));      //4字节
  PByte(P)^:=Ord(PicBrush.Style);
  Inc(PByte(P));      //4字节
  PInteger(P)^:=PicRect.Left;
  Inc(PInteger(P));      //4字节
  PInteger(P)^:=PicRect.Top;
  Inc(PInteger(P));      //4字节
  PInteger(P)^:=PicRect.Right;
  Inc(PInteger(P));      //4字节
  PInteger(P)^:=PicRect.Bottom;
  Inc(PInteger(P));      //4字节
  fn:=PicFont.Name;
  fl:=Length(fn);
  PInteger(P)^:=fl;     //4字节
  Inc(PInteger(P));
  For i1:=1 to fl do  begin //fl字节
    PByte(P)^:=Ord(fn[i1]);
    Inc(PByte(P));
  end;
  PByte(P)^:=PicFont.Charset;
  Inc(PByte(P));      //1字节
  PInteger(P)^:=PicFont.Size;
  Inc(PInteger(P));      //4字节
  PByte(P)^:=Byte(PicFont.Style);
  Inc(PByte(P));        //1字节
  PInteger(P)^:=PicFont.Color;
  Inc(PInteger(P));      //4字节
  PByte(P)^:=Byte(fChoosed);
  Inc(PByte(P));        //1字节
  PByte(P)^:=Ord(FPicId);
  Inc(PByte(P));        //1字节
  PInteger(P)^:=fPicIndex;
  Inc(PInteger(P));      //4字节
  //Len:=AddrOffSet(OldP,P);
  Len:=LongInt(P)-LongInt(Oldp);
end;


end.