janshapecontroller.pas

更好用的 shape 控件 delphi 3.0, 4.0, 5.0, 6.0, 7.0 適用

  Ashape:=Tjanshape(popupcomponent);
  AStyle:=Tmenuitem(sender).caption;
  setEnumprop(Ashape.Pen,'Style',AStyle);
end;

procedure TjanShapeController.initBrushStyleMenu;
var
 m,item:Tmenuitem;
 cap:string;
   PropInfo: PPropInfo;
   ptd: PtypeData;
   I,j:integer;
   PropValue:integer;
begin
 m:=Tmenuitem.Create (self);
 items.Add(m);
 m.caption:='Brush Style';
 PropInfo:=Getpropinfo(TBrush.classinfo,'Style');
 ptd:=GetTypeData(PropInfo.proptype^);
 j:=0;
 for i:=ptd.MinValue to ptd.MaxValue do
 begin
   item:=tmenuitem.Create(self);
   item.caption:=getenumName(propinfo.proptype^,i);
   item.onclick:=brushstyleclick;
   item.RadioItem :=true;
   item.groupindex:=4;
   FMenuCaptions.AddObject (item.caption,item);
   inc(j);
   m.add(item);
 end;
end;

procedure TjanShapeController.initPenStyleMenu;
var
 m,item,subm:Tmenuitem;
 cap:string;
   PropInfo: PPropInfo;
   ptd: PtypeData;
   I,j:integer;
   PropValue:integer;
begin
 m:=Tmenuitem.Create (self);
 m.caption:='Pen';
 items.Add(m);
 subm:=Tmenuitem.Create (self);
 subm.caption:='Style';
 m.Add (subm);
 PropInfo:=Getpropinfo(TPen.classinfo,'Style');
 ptd:=GetTypeData(PropInfo.proptype^);
 j:=0;
 for i:=ptd.MinValue to ptd.MaxValue do
 begin
   item:=tmenuitem.Create(self);
   item.caption:=getenumName(propinfo.proptype^,i);
   item.onclick:=penstyleclick;
   item.RadioItem :=true;
   item.groupindex:=5;
   FMenuCaptions.AddObject (item.caption,item);
   inc(j);
   subm.add(item);
 end;
 subm:=Tmenuitem.Create (self);
 subm.caption:='Color...';
 subm.onclick:=pencolorclick;
 m.Add(subm);

 subm:=Tmenuitem.Create (self);
 subm.caption:='Size...';
 subm.onclick:=pensizeclick;
 m.Add(subm);


end;


procedure TjanShapeController.BrushColorClick(sender: Tobject);
var Ashape:Tjanshape;
    dlg:TColorDialog;
begin
  Ashape:=Tjanshape(popupcomponent);
  dlg:=Tcolordialog.create(self);
  dlg.color:=Ashape.brush.color;
  if dlg.Execute then
    Ashape.Brush.color:=dlg.color;
  dlg.free;
end;

procedure TjanShapeController.FontClick(sender: Tobject);
var Ashape:Tjanshape;
    dlg:TFontDialog;
begin
  Ashape:=Tjanshape(popupcomponent);
  dlg:=TFontdialog.create(self);
  dlg.font.assign(ashape.font);
  if dlg.execute then
    Ashape.Font.Assign (dlg.font);
  dlg.free;
end;

procedure TjanShapeController.GradientColorClick(sender: Tobject);
var Ashape:Tjanshape;
    dlg:TColorDialog;
begin
  Ashape:=Tjanshape(popupcomponent);
  dlg:=Tcolordialog.create(self);
  dlg.Color :=ashape.GradientColor ;
  if dlg.Execute then
    Ashape.GradientColor:=dlg.color;
  dlg.free;
end;

procedure TjanShapeController.PenColorClick(sender: Tobject);
var Ashape:Tjanshape;
    dlg:TColorDialog;
begin
  Ashape:=Tjanshape(popupcomponent);
  dlg:=Tcolordialog.create(self);
  dlg.color:=ashape.pen.color;

  if dlg.Execute then
    Ashape.Pen.color:=dlg.color;
  dlg.free;
end;

procedure TjanShapeController.initBrushColorMenu;
var
  m:Tmenuitem;
begin
  m:=Tmenuitem.Create (self);
  m.caption:='Brush Color...';
  m.onclick:=brushcolorclick;
  items.Add(m);
end;

procedure TjanShapeController.initGradientColorMenu;
var
  m:Tmenuitem;
begin
  m:=Tmenuitem.Create (self);
  m.caption:='Gradient Color...';
  m.onclick:=gradientcolorclick;
  items.Add(m);
end;



procedure TjanShapeController.initGradientmenu;
var
  m:Tmenuitem;
begin
  m:=Tmenuitem.Create (self);
  m.caption:='Gradient';
  m.onclick:=gradientclick;
  FMenuCaptions.AddObject (m.caption,m);
  items.Add(m);
end;

procedure TjanShapeController.GradientClick(sender: Tobject);
var Ashape:Tjanshape;
begin
  Ashape:=Tjanshape(popupcomponent);
  TMenuItem(sender).checked:= not TMenuItem(sender).checked;
  ashape.Gradient :=TMenuItem(sender).checked;
end;

procedure TjanShapeController.initCaptionMenu;
var
  m,subm:Tmenuitem;
begin
  m:=Tmenuitem.Create (self);
  m.caption:='Caption';
  items.Add(m);
  subm:=Tmenuitem.Create (self);
  subm.Caption :='Caption...';
  subm.onclick:=captionclick;
  m.Add (subm);
  subm:=Tmenuitem.Create (self);
  subm.caption:='Font...';
  subm.onclick:=fontclick;
  m.Add (subm);
  subm:=Tmenuitem.Create (self);
  subm.caption:='Centered';
  subm.onclick:=centeredclick;
  FMenuCaptions.AddObject (subm.caption,subm);
  m.Add (subm);
  subm:=Tmenuitem.Create (self);
  subm.caption:='Angle';
  subm.onclick:=angleclick;
  m.Add (subm);

end;


procedure TjanShapeController.initAlignMenu;
var
  m,subm:Tmenuitem;
begin
  m:=Tmenuitem.Create (self);
  m.caption:='Align/Size';
  items.Add(m);
  subm:=Tmenuitem.Create (self);
  subm.Caption :='Top';
  subm.onclick:=alTopclick;
  m.Add (subm);
  subm:=Tmenuitem.Create (self);
  subm.caption:='Left';
  subm.onclick:=alLeftclick;
  m.Add (subm);
  subm:=Tmenuitem.Create (self);
  subm.caption:='Right';
  subm.onclick:=alRightclick;
  m.Add (subm);
  subm:=Tmenuitem.Create (self);
  subm.caption:='Bottom';
  subm.onclick:=alBottomclick;
  m.Add (subm);
  subm:=Tmenuitem.Create (self);
  subm.caption:='-';
  m.Add (subm);
  subm:=Tmenuitem.Create (self);
  subm.caption:='Equal Height';
  subm.onclick:=eqHeightclick;
  m.Add (subm);
  subm:=Tmenuitem.Create (self);
  subm.caption:='Equal Width';
  subm.onclick:=eqWidthclick;
  m.Add (subm);

end;



procedure TjanShapeController.CaptionClick(sender: Tobject);
var Ashape:Tjanshape;
    Acap:string;
begin
  Ashape:=Tjanshape(popupcomponent);
  Acap:=ashape.Caption ;
  if inputquery('Shape Controller','Enter Caption',acap) then
    ashape.caption:=acap;
end;

procedure TjanShapeController.CenteredClick(sender: Tobject);
var Ashape:Tjanshape;
begin
  Ashape:=Tjanshape(popupcomponent);
  ashape.CaptionCentered  :=not ashape.CaptionCentered;
end;

procedure TjanShapeController.AngleClick(sender: Tobject);
var Ashape:Tjanshape;
    Acap:string;
    A:integer;
begin
  Ashape:=Tjanshape(popupcomponent);
  Acap:=inttostr(ashape.CaptionAngle);
  if inputquery('Shape Controller','Enter Caption Angle (-180..0..180)',acap) then
  begin
    a:=strtointdef(acap,0);
    if ((a>=-180) and (a<=180)) then
      ashape.CaptionAngle:=a;
  end;
end;

procedure TjanShapeController.PenSizeClick(sender: Tobject);
var Ashape:Tjanshape;
    Acap:string;
    A:integer;
begin
  Ashape:=Tjanshape(popupcomponent);
  Acap:=inttostr(ashape.pen.Width );
  if inputquery('Shape Controller','Enter Pen Size (1..20)',acap) then
  begin
    a:=strtointdef(acap,1);
    if ((a>=1) and (a<=25)) then
      ashape.pen.width:=a;
  end;
end;

procedure TjanShapeController.initMouseMenu;
var
 m,item:Tmenuitem;
 cap:string;
   PropInfo: PPropInfo;
   ptd: PtypeData;
   I,j:integer;
   PropValue:integer;
begin
 m:=Tmenuitem.Create (self);
 m.caption:='Mouse Mode';
 items.Add(m);
 PropInfo:=Getpropinfo(TjanShape.classinfo,'MouseMode');
 ptd:=GetTypeData(PropInfo.proptype^);
 j:=0;
 for i:=ptd.MinValue to ptd.MaxValue do
 begin
   item:=tmenuitem.Create(self);
   item.caption:=getenumName(propinfo.proptype^,i);
   item.onclick:=mousemodeclick;
   item.RadioItem :=true;
   item.GroupIndex :=3;
   FMenuCaptions.AddObject (item.caption,item);
   inc(j);
   m.add(item);
 end;
 m:=Tmenuitem.Create (self);
 m.caption:='ActiveMouse';
 m.onclick:=ActiveMouseClick;
 FMenuCaptions.AddObject (m.caption,m);
 items.Add(m);

end;


procedure TjanShapeController.MouseModeClick(sender: TObject);
var Ashape:Tjanshape;
    AStyle:string;
    AMouseMode:TShapeMouseMode;
begin
  Ashape:=Tjanshape(popupcomponent);
  AStyle:=Tmenuitem(sender).caption;
  setEnumprop(Ashape,'MouseMode',AStyle);
  if assigned(onmousemodechanged) then
    onMouseModeChanged(self,Ashape.mousemode);

end;

procedure TjanShapeController.ActiveMouseClick(sender: Tobject);
var Ashape:Tjanshape;
begin
  Ashape:=Tjanshape(popupcomponent);
  TmenuItem(sender).checked:= not TmenuItem(sender).checked;
  ashape.ActiveMouse :=TmenuItem(sender).checked;
end;

procedure TjanShapeController.popping(sender: TObject);
var g:TjanShape;
    m:TMenuItem;
    objmm:TShapeMouseMode;
    cap:string;

    function f(Aname:String):TmenuItem;
    var index:integer;
    begin
       result:=nil;
       index:=FMenuCaptions.indexof(Aname);
       if index=-1 then exit;
       result:=TMenuItem(FMenuCaptions.objects[index]);
    end;
begin
  g:=TjanShape(popupcomponent);
  m:=F('PolyLineMode');
  if m<>nil then m.checked:= g.PolylineMode;
  m:=F('Gradient');
  if m<>nil then m.Checked := g.Gradient;
  m:=F('ActiveMouse');
  if m<>nil then m.Checked := g.ActiveMouse ;
  objmm:=g.MouseMode ;
  cap:=getenumprop(g,'MouseMode');
  m:=F(cap);
  if m<>nil then m.checked:=true;
  cap:=getenumprop(g.brush,'Style');
  m:=F(cap);
  if m<>nil then m.checked:=true;
  cap:=getenumprop(g.pen,'Style');
  m:=F(cap);
  if m<>nil then m.checked:=true;
end;

procedure TjanShapeController.SmoothResize(var Src, Dst: TBitmap);
var
x,y,xP,yP,
yP2,xP2:     Integer;
Read,Read2:  PByteArray;
t,z,z2,iz2:  Integer;
pc:PBytearray;
w1,w2,w3,w4: Integer;
Col1r,col1g,col1b,Col2r,col2g,col2b:   byte;
begin
  xP2:=((src.Width-1)shl 15)div Dst.Width;
  yP2:=((src.Height-1)shl 15)div Dst.Height;
  yP:=0;
  for y:=0 to Dst.Height-1 do
  begin
    xP:=0;
    Read:=src.ScanLine[yP shr 15];
    if yP shr 16<src.Height-1 then
      Read2:=src.ScanLine [yP shr 15+1]
    else
      Read2:=src.ScanLine [yP shr 15];
    pc:=Dst.scanline[y];
    z2:=yP and $7FFF;
    iz2:=$8000-z2;
    for x:=0 to Dst.Width-1 do
    begin
      t:=xP shr 15;
      Col1r:=Read[t*3];
      Col1g:=Read[t*3+1];
      Col1b:=Read[t*3+2];
      Col2r:=Read2[t*3];
      Col2g:=Read2[t*3+1];
      Col2b:=Read2[t*3+2];
      z:=xP and $7FFF;
      w2:=(z*iz2)shr 15;
      w1:=iz2-w2;
      w4:=(z*z2)shr 15;
      w3:=z2-w4;
      pc[x*3+2]:=
        (Col1b*w1+Read[(t+1)*3+2]*w2+
         Col2b*w3+Read2[(t+1)*3+2]*w4)shr 15;
      pc[x*3+1]:=
        (Col1g*w1+Read[(t+1)*3+1]*w2+
         Col2g*w3+Read2[(t+1)*3+1]*w4)shr 15;
      pc[x*3]:=
        (Col1r*w1+Read2[(t+1)*3]*w2+
         Col2r*w3+Read2[(t+1)*3]*w4)shr 15;
      Inc(xP,xP2);
    end;
    Inc(yP,yP2);
  end;
end;

function TjanShapeController.ScaleX(I:Integer): Integer;
begin
  Result :=round( I * (GetDeviceCaps(Printer.Handle, LOGPIXELSX) / Screen.PixelsPerInch));
end;

function TjanShapeController.ScaleY(I:Integer): Integer;
begin
  Result := round(I * (GetDeviceCaps(Printer.Handle, LOGPIXELSY) / Screen.PixelsPerInch));
end;

procedure TjanShapeController.PrintShapes(var Alist: Tlist;scale:extended);
var i,c,x,y:integer;
    w,h:integer;
    obj:TjanShape;
    R:Trect;
    Ax0,Ay0:integer;
    AScaleX,ascaleY:extended;
begin
  c:=alist.Count ;
  if c=0 then exit;
  AScaleX:=scale*GetDeviceCaps(Printer.Handle, LOGPIXELSX) / Screen.PixelsPerInch;
  AScaleY:=scale*GetDeviceCaps(Printer.Handle, LOGPIXELSY) / Screen.PixelsPerInch;
  printer.BeginDoc;
  for i:=0 to c-1 do
  begin
    obj:=TjanShape(alist[i]);
    Ax0:=round(AscaleX*obj.Left) ;
    Ay0:=round(AscaleY*obj.top);
    obj.PaintToCanvas (printer.canvas,Ax0,ay0,AScaleX,AscaleY);
  end;
  printer.EndDoc ;
end;

procedure TjanShapeController.SetMouseMode(const Value: TShapeMouseMode);
begin
  FMouseMode := Value;
end;

procedure TjanShapeController.SetMouseModeController(const Value: boolean);
begin
  FMouseModeController := Value;
end;

procedure TjanShapeController.SetMouseGrid(const Value: boolean);
begin
  FMouseGrid := Value;
end;

procedure TjanShapeController.SetMouseGridSize(const Value: integer);
begin
  FMouseGridSize := Value;
end;

procedure TjanShapeController.initOtherMenu;
var
  m:Tmenuitem;
begin
  m:=Tmenuitem.Create (self);
  m.caption:='GroupName';
  m.onclick:=GroupNameClick;
  items.Add(m);
  m:=Tmenuitem.Create (self);
  m.caption:='ConnectorN';
  m.onclick:=ConnectorNClick;
  items.Add(m);
  m:=Tmenuitem.Create (self);
  m.caption:='ConnectorE';
  m.onclick:=ConnectorEClick;
  items.Add(m);
  m:=Tmenuitem.Create (self);
  m.caption:='ConnectorS';
  m.onclick:=ConnectorSclick;
  items.Add(m);
  m:=Tmenuitem.Create (self);
  m.caption:='ConnectorW';
  m.onclick:=ConnectorWClick;
  items.Add(m);
  m:=Tmenuitem.Create (self);
  m.caption:='PolyLineMode';
  m.onclick:=PolyLineModeClick;
  items.Add(m);
  FMenuCaptions.AddObject (m.caption,m);
  m:=Tmenuitem.Create (self);
  m.caption:='-';
  items.Add(m);
  m:=Tmenuitem.Create (self);
  m.caption:='BringToFront';
  m.onclick:=BringToFrontClick;
  items.Add(m);
  m:=Tmenuitem.Create (self);
  m.caption:='SendToBack';
  m.onclick:=SendToBackClick;
  items.Add(m);
  m:=Tmenuitem.Create (self);
  m.caption:='Delete Object';
  m.onclick:=DeleteObjectClick;
  items.Add(m);
end;
procedure TjanShapeController.SendToBackClick(sender:TObject);
var Ashape:Tjanshape;
    index:integer;
begin
  Ashape:=Tjanshape(popupcomponent);