版块 › CorelDRAW专区 › 相同颜色填充、轮廓曲线结合

ggcupp 发表于 2016-11-16 22:25:07

相同颜色填充、轮廓曲线结合

学习的第一个cpg插件，delphi 编写的是在delphi框架的基础上实现的一个实例。


补充内容 (2016-11-17 18:19):
begin
FApp.ActiveDocument.Unit_ := cdrMillimeter;
if FApp.ActiveLayer.Shapes.Count = 0 then
begin
    MessageBox(0, '图层为空', '提示', MB_OK);
    exit;
end;
FApp.ActiveWindow.Refresh;
...

补充内容 (2016-11-17 18:21):
var
st: string;
st1: string;
sh: Shape;
sr1: ShapeRange;
js: Integer;
t: Integer;
n: Integer;
i: Integer;
label
n1, n2;

补充内容 (2016-11-17 18:39):
同颜色曲线合并的源码7楼！

taoha008 发表于 2016-11-16 23:35:19

跟增强选择一样吧:lol

huayingshenqu00 发表于 2016-11-17 09:27:14

先整个下看用用，通用的不分版本么

w19238103 发表于 2016-11-17 10:50:52

先下载用用看，楼主这么做肯定有他独到的地方

魔星星 发表于 2016-11-17 12:53:23

试试看能不能提高效率。

no543216789 发表于 2016-11-17 15:26:54

又是delphi编写的，牛啊，代码能不能看一下呢

ggcupp 发表于 2016-11-17 18:19:50

本帖最后由 ggcupp 于 2016-11-17 18:37 编辑

添加到cpg框架里的窗体，增加一个按钮，复制到按钮单击就可以了，实现同颜色曲线合并的功能！
实现了基本的vba转成cpg插件的功能。
procedure TForm1.btn1Click(Sender: TObject);
var
st: string;
st1: string;
sh: Shape;
sr1: ShapeRange;
js: Integer;
t: Integer;
n: Integer;
i: Integer;
label
n1, n2;
begin
FApp.ActiveDocument.Unit_ := cdrMillimeter;
if FApp.ActiveLayer.Shapes.Count = 0 then
begin
    MessageBox(0, '图层为空', '提示', MB_OK);
    exit;
end;
FApp.ActiveWindow.Refresh;
FApp.ActiveDocument.BeginCommandGroup('rename');
FApp.Optimization := True;
js := 1;
i := FApp.ActiveLayer.Shapes.Count;
n1:
sr1 := FApp.CreateShapeRange;
if FApp.ActiveLayer.Shapes.type_ = cdrCurveShape then
begin
    st := FApp.ActiveLayer.Shapes.Outline.Color.Name;
    if (st = 'R: 0 G: 0 B: 0') or (st = '') or (st = 'R: 255 G: 0 B: 0') or (st = 'C: 0 M: 0 Y: 0 K: 100') or (st = 'C: 0 M: 100 Y: 100 K: 0') then
    begin
      if js < FApp.ActiveLayer.Shapes.Count then
      begin
      js := js + 1;
      goto n1;
      end;
    end;
    n := FApp.ActiveLayer.Shapes.Count;
    if js = n then
    begin
      MessageBox(0, '绘制完成！', '提示', MB_OK);
      goto n2;
    end;

for t := js to n do
    begin
      st1 := FApp.ActiveLayer.Shapes.Outline.Color.Name;
      if st1 = st then
      sr1.Add(FApp.ActiveLayer.Shapes);
      if t = n then
      begin
      if sr1.Count >= 2 then
          sh := sr1.Combine;
      sr1 := nil;
      js := js + 1;
      if js > FApp.ActiveLayer.Shapes.Count then
      begin
          MessageBox(0, '绘制完成！', '提示', MB_OK);
          goto n2;
      end;
      goto n1;
      end;
    end;
end
else
begin
    if js < FApp.ActiveLayer.Shapes.Count then
    begin
      js := js + 1;
      goto n1;
    end;
end;
if sr1.Count >1 then
begin
    sr1.Combine;
    MessageBox(0, '绘制完成！', '提示', MB_OK);
end;
n2:
if i = FApp.ActiveLayer.Shapes.Count then
    MessageBox(0, '激活层无满足条件的对象！', '提示', MB_OK);
FApp.Optimization := False;
FApp.ActiveDocument.EndCommandGroup;
FApp.ActiveWindow.Refresh;
FApp.Application.Refresh;


end;

ggcupp 发表于 2016-11-17 18:39:01

同颜色曲线合并的源码7楼！

存心 发表于 2016-11-18 18:38:32

CPG格式的插件，值得欢呼！

存心 发表于 2016-11-18 18:39:17

希望下次写CPG时向你请教一下

查看完整版本: 相同颜色填充、轮廓曲线结合