?? unitpaintpanel.pas
字號:
AStream.WriteBuffer(Count,Sizeof(Int64));
AStream.CopyFrom(DestStream,0);
AStream.SaveToFile(FileName);
finally
DestStream.Free;
end;
finally
AStream.Destroy;
end;
end;
procedure TCustomPaintPanel.SaveToStream(Stream: TStream);
var
i :integer;
Count :integer;
AColor :TColor;
AGraphObject :TGraphObject;
AGraphClass :TGraphClass;
begin
for i := 0 to FGraphList.Count - 1 do //載入曲線數據
begin
AGraphObject := FGraphList[i];
Count := High(AGraphObject.PointList) + 1;
AColor := AGraphObject.Color;
AGraphClass := AGraphObject.GraphClass;
Stream.WriteBuffer(Count,Sizeof(integer));
Stream.WriteBuffer(AColor ,Sizeof(TColor));
Stream.WriteBuffer(AGraphClass,Sizeof(TGraphClass));
Stream.WriteBuffer(AGraphObject.PointList[0],Sizeof(TPoint) * Count);
end;
end;
procedure TCustomPaintPanel.SaveToBitmap(const FileName: string);
var
ABitmap :TBitmap;
begin
ABitmap := TBitmap.Create;
try
ABitmap.PixelFormat := pf24bit;
ABitmap.Width := Width;
ABitmap.Height := Height;
ABitmap.Canvas.CopyRect(Rect(0,0,Width,Height),Canvas,Rect(0,0,Width,Height));
ABitmap.SaveToFile(FileName);
finally
ABitmap.Free;
end;
end;
procedure TCustomPaintPanel.Paint;
begin
Canvas.Brush.Color := clWhite;
Canvas.FillRect(Rect(0,0,Width,Height));
Canvas.CopyMode := cmSrcAnd;
PaintFill;
PaintGraph; //繪制圖形對象
PaintNotice; //繪制注釋對象
Canvas.Pen.Color := Color;
end;
procedure TCustomPaintPanel.PaintFill;
var
i :integer;
FillObject :TFillObject;
begin
for i := 0 to FFillList.Count - 1 do
begin
FillObject := FFillList[i];
FillRgn(Canvas.Handle,FillObject.Rgn,CreateSolidBrush(FillObject.FillColor));
end;
end;
procedure TCustomPaintPanel.PaintNotice;
var
i :integer;
NoticeObject :TNoticeObject;
begin
for i := 0 to FNoticeList.Count - 1 do
begin
NoticeObject := FNoticeList[i];
Canvas.Brush.Color := NoticeObject.FillColor;
Canvas.Pen.Color := NoticeObject.FillColor;
Canvas.Font.Color := clBlack;
Canvas.Polyline(NoticeObject.PointList);
FillPoly(Canvas.Handle,NoticeObject.PointList,NoticeObject.FillColor);
DrawNoticeText(NoticeObject);
if NoticeObject.Selected then
PaintSelected(NoticeObject);
end;
end;
procedure TCustomPaintPanel.DrawNoticeText(ANoticeObject :TNoticeObject);
var
i :integer;
X,Y :integer;
AHeight,AWidth :integer;
PercentY :Double;
begin
AHeight := ANoticeObject.ClientRect.Bottom - ANoticeObject.ClientRect.Top;
AWidth := ANoticeObject.ClientRect.Right - ANoticeObject.ClientRect.Left;
PercentY := AHeight / ANoticeObject.Lines.Count ;
if PercentY < Canvas.TextHeight('hg') then PercentY := Canvas.TextHeight('hg');
for i := 0 to ANoticeObject.Lines.Count - 1 do
begin
X := ANoticeObject.ClientRect.Left + Round((AWidth - Canvas.TextWidth(ANoticeObject.Lines[i])) / 2 );
Y := ANoticeObject.ClientRect.Top + Round(PercentY * i + (PercentY -
Canvas.TextHeight(ANoticeObject.Lines[i])) / 2);
Canvas.TextOut(X,Y,ANoticeObject.Lines[i]);
end;
end;
procedure TCustomPaintPanel.PaintGraph;
var
i,j :integer;
GraphObject :TGraphObject;
begin
for i := 0 to FGraphList.Count - 1 do
begin
GraphObject := FGraphList[i];
Canvas.Pen.Color := GraphObject.Color;
case GraphObject.GraphClass of
gcLine :begin
DrawPolyLine(Canvas.Handle,GraphObject.PointList);
end;
gcCurve:begin
end;
gcArc :begin
DrawArc(Canvas.Handle,GraphObject.PointList);
if GraphObject.Fill then
FillARc(Canvas.Handle,GraphObject.PointList,GraphObject.Color);
end;
gcRect :begin
DrawRect(Canvas.Handle,GraphObject.PointList,GraphObject.Fill,
GraphObject.Color);
end;
end;
if GraphObject.Selected then
PaintSelected(GraphObject);
end;
end;
procedure TCustomPaintPanel.PaintSelected(AObject :TObject);
var
P,P1,P2 :TPoint;
i :integer;
AGraphObject : TGraphObject;
ANoticeObject : TNoticeObject;
begin
if AObject is TGraphObject then
begin
AGraphObject := TGraphObject(AObject);
Canvas.Brush.Color := AGraphObject.Color ;
case AGraphObject.GraphClass of
gcLine :begin
P := AGraphObject.PointList[0];
Canvas.FillRect(Rect(P.X -2,P.Y - 2,P.X + 2,P.Y + 2));
P := AGraphObject.PointList[High(AGraphObject.PointList)];
Canvas.FillRect(Rect(P.X -2,P.Y - 2,P.X + 2,P.Y + 2));
end;
gcRect :begin
P1 := AGraphObject.PointList[0];
Canvas.FillRect(Rect(P1.X -2,P1.Y - 2,P1.X + 2,P1.Y + 2));
P2 := AGraphObject.PointList[High(AGraphObject.PointList)];
Canvas.FillRect(Rect(P2.X -2,P2.Y - 2,P2.X + 2,P2.Y + 2));
P := Point(P1.X,P2.Y);
Canvas.FillRect(Rect(P.X -2,P.Y - 2,P.X + 2,P.Y + 2));
P := Point(P2.X,P1.Y);
Canvas.FillRect(Rect(P.X -2,P.Y - 2,P.X + 2,P.Y + 2));
end;
gcArc :begin
end;
end;
end else if AObject is TNoticeObject then
begin
ANoticeObject := TNoticeObject(AObject);
Canvas.Brush.Color := clRed;
for i := 0 to High(ANoticeObject.PointList) do
begin
P := ANoticeObject.PointList[i];
Canvas.FillRect(Rect(P.X -2,P.Y - 2,P.X + 2,P.Y + 2));
end;
end;
end;
procedure TCustomPaintPanel.SetGraphClass(const Value: TGraphClass);
begin
FGraphClass := Value;
end;
procedure TCustomPaintPanel.WMLButtonDown(var Msg: TWMLButtonDown);
var
i :integer;
GraphObject :TGraphObject;
FillObject :TFillObject;
NoticeObject :TNoticeObject;
begin
inherited;
SetFocus;
ClearObjectSelected;
FMouseDownSPo := Point(Msg.XPos,Msg.YPos);
if IsFill then
begin
FillObject := TFillObject.Create;
FillObject.Rgn := GetFillRgn(Canvas.Handle,Point(Msg.XPos,Msg.YPos));
FillObject.FillColor := FillColor;
FillRgn(Canvas.Handle,FillObject.Rgn,CreateSolidBrush(FillObject.FillColor));
FFillList.Add(FillObject);
IsFill := False;
end;
//檢測圖形對象是否被選中
for i := 0 to FGraphList.Count-1 do
begin
GraphObject := FGraphList[i];
if PTInObject(Point(Msg.XPos,Msg.YPos),GraphObject) then
begin
GraphObject.Selected:= True;
SelObject := GraphObject;
break;
end;
end;
//檢測注釋對象是否被選中
for i := 0 to FNoticeList.Count - 1 do
begin
NoticeObject := FNoticeList[i];
if PTInObject(Point(Msg.XPos,Msg.YPos),NoticeObject) then
begin
NoticeObject.Selected := True;
SelObject := NoticeObject;
break;
end;
end;
if SelObject <> nil then
begin
if IsFill then
begin
if SelObject is TGraphObject then
TGraphObject(SelObject).Fill := True;
end;
if SelObject is TGraphObject then
begin
if PointInEdge(Point(Msg.XPos,Msg.YPos),TGraphObject(SelObject)) then
begin
FAction := paModiGraph;
FPointList := Copy(TGraphObject(SelObject).PointList,0,
High(TGraphObject(SelObject).PointList) +1);
FPointCount := High(FPointList) + 1;
PointListChangToScreen(FPointList,FAbsPointList);
end else FAction := paMove;
end else if SelObject is TNoticeObject then FAction := paMove;
Invalidate;
end else if DrawClass = dcGraph then
begin
FAction := paDrawGraph;
SetLength(FPointList,0);
SetLength(FAbsPointList,0);
end else if DrawClass = dcNotice then
begin
FAction := paDrawNotice;
end;
end;
function TCustomPaintPanel.PointInEdge(Po :TPoint;AGraphObject :TGraphObject) :Boolean;
var
P :TPoint;
begin
Result := False;
if AGraphObject.GraphClass = gcLine then
begin
P := AGraphObject.PointList[0];
if PTInRect(Po,Rect(P.X - 2,P.Y - 2,P.X + 2,P.Y + 2)) then
begin
Result := True;
end;
P := AGraphObject.PointList[High(AGraphObject.PointList)];
if PTInRect(Po,Rect(P.X - 2,P.Y -2 ,P.X + 2,P.Y +2)) then
Result := True;
end;
end;
procedure TCustomPaintPanel.WMLButtonUp(var Msg: TWMLButtonUp);
var
DeltaX,DeltaY :integer;
ARect :TRect;
Lines :TStringList;
Po :TPoint;
begin
inherited;
if FAction = paDrawGraph then
begin
AddGraphObject;
end else if FAction = paMove then
begin
DeltaX := Msg.XPos - FMouseDownSPo.X;
DeltaY := Msg.YPos - FMouseDownSPo.Y;
if (Abs(DeltaX) > 2) or (Abs(DeltaY) > 2) then
begin
MoveObject(SelObject,DeltaX,DeltaY);
Invalidate;
end;
end else if FAction = paDrawNotice then
begin
Lines := TStringList.Create;
try
ARect := Rect(FMouseDownSPo,Point(Msg.XPos,Msg.YPos));
Po := Point(ARect.Left + Round((ARect.Right - ARect.Left) * 0.3),ARect.Top - 50);
Lines.Add('NoticeText');
if Assigned(FOnMouseDrag) then
FOnMouseDrag(Self,ARect,Po,Lines);
AddNotice(ARect,Po,Lines);
finally
Lines.Free;
end;
Invalidate;
end else if FAction = paModiGraph then
begin
if SelObject is TGraphObject then
begin
TGraphObject(SelObject).PointList := FPointList;
Invalidate;
end;
end;
FPointCount := 0;
FAction := paNone;
end;
procedure TCustomPaintPanel.AddGraphObject;
var
GraphObject :TGraphObject;
APointList :TPointList;
begin
if High(FPointList) > 0 then
begin
GraphObject := TGraphObject.Create;
GraphObject.GraphClass := GraphClass;
GraphObject.Color := Color;
case GraphClass of
gcLine : GraphObject.PointList := Copy(FPointList,0,High(FPointList));
gcRect :begin
SetLength(APointList,2);
APointList[0].X := FPointList[0].X;
APointList[0].Y := FPointList[0].Y;
APointList[1].X := FPointList[FPointCount - 1].X;
APointList[1].Y := FPointList[FPointCount - 1].Y;
GraphObject.PointList := APointList;
end;
gcArc :begin
SetLength(APointList,2);
APointList[0].X := FPointList[0].X;
APointList[0].Y := FPointList[0].Y;
APointList[1].X := FPointList[FPointCount - 1].X;
APointList[1].Y := FPointList[FPointCount - 1].Y;
GraphObject.PointList := APointList;
end;
end;
GraphObject.Selected := True;
SelObject := GraphObject;
FGraphList.Add(GraphObject);
RePaint;
end;
end;
procedure TCustomPaintPanel.MoveObject(AObject :TObject;DeltaX ,DeltaY :integer);
var
i :integer;
AGraphObject :TGraphObject;
ANoticeObject :TNoticeObject;
ARect :TRect;
begin
if AObject is TGraphObject then
begin
AGraphObject := TGraphObject(AObject);
for i := 0 to High(AGraphObject.PointList) do
begin
AGraphObject.PointList[i].X := AGraphObject.PointList[i].X + DeltaX;
AGraphObject.PointList[i].Y := AGraphObject.PointList[i].Y + DeltaY;
end;
end else if AObject is TNoticeObject then
begin
ANoticeObject := TNoticeObject(AObject);
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -