unit UnitPaintPanel;
{
  Create Date :2003.09.21;
  Create Authoer :WXZH
  E_Mail :lanya99@hotmail.com

  本源代碼代開，希望哪位同仁加以改進后能給本人發一份源代碼,謝謝
  功能介紹：
  　　本組件繼承于TCustomControl,功能包括：
  　　1、圖形的繪制，包括線條，多邊型，多點曲線，圓形，橢圓形
  　　2、注釋的繪制，包括帶指向點的繪制和不帶指向點的繪制
  　　3、圖形的存取：從自已定義的文件格式中讀入文件，
  　　　　寫入的文件格式有自己定義的文件格式或位圖格式。也可以從流數據中
  　　　　進行存取。
      4、F5可以進行刷新圖面，DELETE鍵可以刪除當前選擇的圖形，F6可以刪除填充的地方。
      5、在進行編譯時要進行堆棧的改動，這是由于查找多邊形的算法不好，希望哪位能改進
}
interface
uses
   Classes,Windows,Messages,ExtCtrls,Graphics,SysUtils,
   Controls,Dialogs,Menus,StdCtrls,Math,UnitGlobal,ZLib;
type
   TGraphClass =(gcLine,gcCurve,gcArc,gcRect,gcNotice);


   TGraphObject = class(TObject)
   private
     FSelected: Boolean;
     FGraphClass: TGraphClass;
     FPointList: TPointList;
     FColor: TColor;
     FFill: Boolean;
     procedure SetPointList(const Value: TPointList);
     procedure SetGraphClass(const Value: TGraphClass);
     procedure SetSelected(const Value: Boolean);
     procedure SetColor(const Value: TColor);
     procedure SetFill(const Value: Boolean);
   public
     property  Fill :Boolean read FFill write SetFill;
     property  PointList :TPointList read FPointList write SetPointList;
     property  Color :TColor read FColor write SetColor;
     property  Selected :Boolean read FSelected write SetSelected;
     property  GraphClass :TGraphClass read FGraphClass write SetGraphClass;
   end;

   TPositionDirection = (pdLeft,pdRight,pdTop,pdBottom);  //點位于矩形框的方位，左邊，右邊，上邊，下邊
   TNoticeClass   =(ncRect,ncNotice);

   TNoticeObject     = class(TObject)
   private
     FFillColor: TColor;
     FClientRect: TRect;
     FLines: TStringList;
     FPoint: TPoint;
     FSelected: Boolean;
     FNoticeClass: TNoticeClass;

     procedure SetClientRect(const Value: TRect);
     procedure SetFillColor(const Value: TColor);
     procedure SetLines(const Value: TStringList);
     function  GetPointList :TPointList;
     procedure SetPoint(const Value: TPoint);
     function PoInRectPosition(Po: TPoint;
          ARect: TRect): TPositionDirection;
     procedure SetSelected(const Value: Boolean);
     procedure SetNoticeClass(const Value: TNoticeClass);
   public
     constructor Create;
     destructor  Destroy;override;

     property NoticeClass :TNoticeClass read FNoticeClass write SetNoticeClass;
     property ClientRect :TRect read FClientRect write SetClientRect;
     property Lines :TStringList read FLines write SetLines;
     property PointList :TPointList read GetPointList;
     property FillColor :TColor read FFillColor write SetFillColor;
     property ToPoint :TPoint read FPoint write SetPoint;
     property Selected :Boolean read FSelected write SetSelected;
   end;

   TDrawClass  =(dcGraph,dcNotice) ;//所畫的類別，圖形，注釋.....
   TPaintMouseDragEvent = procedure(Sender :TObject;var ARect :TRect;
                 var Po :TPoint;Lines :TStringList) of Object;
   TNoticeDragPoint =(npBorder,npHeader);

   TFillObject = class
     Rgn :HRgn;
     FillColor :TColor;
   end;

   TCustomPaintPanel = class(TCustomControl)
   private
     FGraphList :TList;
     FNoticeList :TList;
     FFillList :TList;
     FGraphClass: TGraphClass;
     FPointList :TPointList;
     FAbsPointList :TPointList;
     FPointCount :integer;
     FAction :TOperateAction;
     FColor: TColor;
     FSelObject: TObject;
     FMouseDownSPo :TPoint;
     FDrawClass: TDrawClass;
     FOnMouseDrag: TPaintMouseDragEvent;
     FIsFill: Boolean;
     FFillColor: TColor;
     FNoticeDragPoint: TNoticeDragPoint;
     FNoticeClass: TNoticeClass;

     procedure WMLButtonDown(var Msg :TWMLButtonDown);message WM_LButtonDown;
     procedure WMLButtonUp(var Msg :TWMLButtonUp);message WM_LButtonUp;
     procedure WMMouseMove(var Msg :TWMMouseMove);message WM_MouseMove;
     procedure WMKeyDown(var Msg :TWMKeyDown);message WM_KEYDOWN;
     procedure SetGraphClass(const Value: TGraphClass);

     procedure PaintSelected(AObject: TObject);
     procedure SetColor(const Value: TColor);
     procedure RunTimeDraw(AGraphClass :TGraphClass;APointList :TPointList);
     procedure ClearObjectSelected;
     function  PTInObject(Po: TPoint; AGraphObject: TGraphObject): Boolean;overload;
     function  PTInObject(Po :TPoint; ANoticeObject: TNoticeObject): Boolean;overload;
     procedure SetSelObject(const Value: TObject);
     procedure MoveObject(AObject: TObject; DeltaX,DeltaY: integer);
     procedure ShowMoveObject(AObject: TObject; DeltaX,DeltaY: integer);
     procedure ClearNoticeObject;
     procedure PaintGraph;
     procedure PaintNotice;
     procedure DrawNoticeText(ANoticeObject: TNoticeObject);
     procedure AddGraphObject;
     procedure SetDrawClass(const Value: TDrawClass);
     procedure SetOnMouseDrag(const Value: TPaintMouseDragEvent);
     procedure SetFillColor(const Value: TColor);
     procedure SetIsFill(const Value: Boolean);
     procedure PaintFill;
     procedure SetNoticeDragPoint(const Value: TNoticeDragPoint);
     function  PointInEdge(Po: TPoint; AGraphObject: TGraphObject): Boolean;
     procedure PointListChangToScreen(ClientPointList,
                ScreenPointList: TPointList);
     procedure ClearGraphObject;
     procedure DeleteGraph(AGraphObject: TGraphObject);
     procedure DeleteNotice(ANoticeObject: TNoticeObject);
     procedure ClearFillObject;
     procedure SetNoticeClass(const Value: TNoticeClass);
   protected
     procedure Paint;override;

     procedure DeleteObject(AObject :TObject);
     property  OnMouseDrag :TPaintMouseDragEvent read FOnMouseDrag write SetOnMouseDrag;
     property  NoticeDragPoint :TNoticeDragPoint read FNoticeDragPoint write SetNoticeDragPoint;
   public
     constructor Create(AOwner :TComponent);override;
     destructor  Destroy;override;

     procedure Delete;
     procedure Clear;

     procedure AddNotice(ARect :TRect;Po :TPoint;Lines :TStringList);
     procedure SaveToFile(const FileName :string);    //保存當前數據到文件
     procedure SaveToStream(Stream :TStream);         //保存當前數據到流數據
     procedure SaveToBitmap(const FileName :string);  //保存當前數據為位圖文件
     procedure LoadFromStream(Stream :TStream);       //從流數據中載入數據
     procedure LoadFromFile(const FileName :string);  //從文件中載入數據

     property DrawClass :TDrawClass read FDrawClass write SetDrawClass;
     property NoticeClass :TNoticeClass read FNoticeClass write SetNoticeClass;
     property SelObject :TObject read FSelObject write SetSelObject;
     property Color :TColor read FColor write SetColor;
     property FillColor :TColor read FFillColor write SetFillColor;
     property IsFill :Boolean read FIsFill write SetIsFill;
     property GraphClass :TGraphClass read FGraphClass write SetGraphClass;
   end;

   TPaintPanel = class(TCustomPaintPanel)
   published
     property Align;
     property FillColor;
     property DrawClass;
     property Color;
     property GraphClass;
     property Visible;
     property OnMouseDrag;
   end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Lanya Soft',[TPaintPanel]);
end;

const
  FileIdentify = 'WXZHP1.1';    //保存文件時采用的字符串標志名稱

{ TGrapthObject }

procedure TGraphObject.SetPointList(const Value: TPointList);
begin
  FPointList := Value;
end;

procedure TGraphObject.SetGraphClass(const Value: TGraphClass);
begin
  FGraphClass := Value;
end;

procedure TGraphObject.SetSelected(const Value: Boolean);
begin
  FSelected := Value;
end;

procedure TGraphObject.SetColor(const Value: TColor);
begin
  FColor := Value;
end;

procedure TGraphObject.SetFill(const Value: Boolean);
begin
  FFill := Value;
end;


{ TPaintPanel }

constructor TCustomPaintPanel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FGraphList := TList.Create;
  FNoticeList := TList.Create;
  FFillList := TList.Create;
  GraphClass := gcLine;
  DrawClass := dcGraph;
  SetLength(FPointList,0);
end;

destructor TCustomPaintPanel.Destroy;
begin
  ClearGraphObject;
  ClearNoticeObject;
  FGraphList.Free;
  FNoticeList.Free;
  FFillList.Free;
  inherited;
end;

procedure TCustomPaintPanel.ClearNoticeObject;
var
  i :integer;
  NoticeObject :TNoticeObject;
begin
  for i := 0 to FNoticeList.Count - 1 do
  begin
    NoticeObject := FNoticeList[i];
    NoticeObject.Free;
  end;
  FNoticeList.Clear;
  Invalidate;
end;

procedure TCustomPaintPanel.ClearGraphObject;
var
  i :integer;
  GraphObject :TGraphObject;
begin
  for i := 0 to FGraphList.Count - 1 do
  begin
    GraphObject := FGraphList[i];
    GraphObject.Free;
  end;
  FGraphList.Clear;
  Invalidate;
end;


procedure TCustomPaintPanel.AddNotice(ARect: TRect; Po: TPoint;
  Lines: TStringList);
var
  NoticeObject : TNoticeObject;
begin
  NoticeObject := TNoticeObject.Create;
  NoticeObject.ClientRect := ARect;
  NoticeObject.ToPoint := Po;
  NoticeObject.Lines := Lines;
  NoticeObject.Selected := True;
  SelObject := NoticeObject;
  FNoticeList.Add(NoticeObject);
end;


procedure TCustomPaintPanel.LoadFromFile(const FileName: string);
var
  Stream :TMemoryStream;
  DestStream :TMemoryStream;
  DeCompressionStream :TDeCompressionStream;
  Count :Int64;
  Buff :Pchar;
  Identify :array of Char;
begin
  Stream := TMemoryStream.Create;
  try
    Stream.LoadFromFile(FileName);

    //辨別文件的格式,是否為能識別的格式
    Stream.Position := 0;
    SetLength(Identify,Length(FileIdentify));
    Stream.ReadBuffer(Identify[0],Sizeof(Char) * Length(FileIdentify));
    if Identify[0] = FileIdentify then              //辨別文件數據格式
       raise Exception.Create('無法識別的文件格式');

    Stream.ReadBuffer(Count,Sizeof(Int64));

    //解壓縮數據
    DestStream := TMemoryStream.Create;
    try
      DeCompressionStream := TDeCompressionStream.Create(Stream);
      GetMem(Buff,Count + 1);
      try
        DeCompressionStream.ReadBuffer(Buff^,Count);
        DestStream.WriteBuffer(Buff^,Count);
      finally
        FreeMem(Buff);
      end;
      LoadFromStream(DestStream); //根據數據流繪制圖形
    finally
      DestStream.Free;
    end;
  finally
    Stream.Free;
  end;
end;

procedure TCustomPaintPanel.LoadFromStream(Stream: TStream);
var
  Count :integer;
  AColor :TColor;
  APointList :TPointList;
  AGraphObject :TGraphObject;
  AGraphClass :TGraphClass;
  Identify :array of Char;
begin
  Stream.Position := 0;
  while Stream.Position < Stream.Size do
  begin
    Stream.ReadBuffer(Count,Sizeof(Count));
    Stream.ReadBuffer(AColor,Sizeof(TColor));
    Stream.ReadBuffer(AGraphClass,Sizeof(TGraphClass));
    SetLength(APointList,Count);
    Stream.ReadBuffer(APointList[0],Sizeof(TPoint) * Count);
    AGraphObject := TGraphObject.Create;
    AGraphObject.PointList := Copy(APointList,0,High(APointList) + 1);
    AGraphObject.Color := AColor;
    AGraphObject.GraphClass := AGraphClass;
    FGraphList.Add(AGraphObject);
  end;
  Invalidate;
end;

procedure TCustomPaintPanel.SaveToFile(const FileName: string);
var
  AStream :TMemoryStream;
  CompressionStream :TCompressionStream;
  DestStream :TMemoryStream;
  AIdentify :PChar;
  Count :Int64;
begin
  AStream := TMemoryStream.Create;
  try
    SaveToStream(AStream);
    Count := AStream.Size;
    DestStream := TMemoryStream.Create;
    try     //Start DestStream
      CompressionStream := TCompressionStream.Create(clMax,DestStream);
      try
        AStream.SaveToStream(CompressionStream);       //壓縮數據
      finally
        CompressionStream.Free;
      end;
      AStream.Clear;

      //寫入標志字符串
      AStream.WriteBuffer(FileIdentify,Sizeof(Char) * Length(FileIdentify));