图像控件绘制文本字符的工具

xianaihua 发表于 2009-11-28 14:26:00

给大家介绍一个在对话框图像控件上绘制矢量文本的工具用法：首先加载vector_text.VLX（或vector_text.fas）；然后在你的程序中调用函数：vector_text;------------------------------------------------------------------------------- ; vector_text - 在对话框图像控件中绘制文本 ; 参数数量: 6 ;   Justify$ = 文本对齐方式："L" "ML" "TL" "C" "M" "TC" "R" "MR"  "TR" ;   X# =起点的X;   Y# = 起点的 Y;   Rotation# =旋转角度0或90（只有这两种） ;   Color# = 颜色号0到255 ;   TextStr$ = 要绘制的文本字符（不支持中文） ; 返回值:对话框图像控件中绘制文本; ; 例如: (vector_text "M" 110 25 0 5 "Hello World") ;-------------------------------------------------------------------------------

xianaihua 发表于 2009-11-28 14:34:00

实例
(defun c:vector_text (/ Dcl_Id% Show_Image:)
(defun Show_vector_text (str)
(start_image "Image1")
(fill_image 30 23 156 178 -2)
(vector_text "M" 107 154 0 2 str)
(end_image)
)
(setq Dcl_Id% (load_dialog "vector_text.dcl"))
(new_dialog "vector_text" Dcl_Id%)
; Set Dialog Initial Settings
(set_tile "Title" "文本矢量")
(set_tile "Edit1" "12.5")
(set_tile "Text1" "按回车改变显示")
(start_image "Image1")
(fill_image 30 23 156 178 -2)
(vector_text "M" 107 154 0 2 "12.5")
(end_image)

; Dialog Actions
(action_tile "Edit1" "(Show_vector_text $value)")
(start_dialog)
; Unload Dialog
(unload_dialog Dcl_Id%)
(princ)
)dcl代码
//---------------------------------------------------------------------------------------------------------
// vector_text
//---------------------------------------------------------------------------------------------------------
vector_text : dialog {
key = "Title";
label = "";//Title$ from lsp file
spacer;
: image_button {
key = "Image1";
width = 35.92;
height = 16.59;
fixed_width = true;
fixed_height = true;
aspect_ratio = 1;
color = -2;
}
: edit_box {
   label = "输入字符串";
   key = "Edit1";
   edit_width = 20;
   fixed_width = true;
}
: text {
key = "Text1";
label = "";
width = 23.42;
fixed_width = true;
alignment = centered;
}
ok_only;
}//

xianaihua 发表于 2009-11-28 14:42:00

wangqin 发表于 2009-11-30 10:33:00

楼主,做一个支持中文的吧

客人发表于 2009-12-16 11:02:00

为什么我运行时出错？

; 错误: no function definition: VECTOR_TEXT

egos 发表于 2011-5-23 09:47:52

; vector_text - Draws text in a dialog image tile
; Arguments: 6
; Justify$ = Justification option of "L" "ML" "TL" "C" "M" "TC" "R" "MR" or "TR"
; X# = Starting X location
; Y# = Starting Y location
; Rotation# = Rotation angle of 0 or 90
; Color# = Color number of text ranging from 0 to 255
; TextStr$ = Text string to draw
; Returns: Draws text string in a dialog image tile
; Note: Use this function between a start_image and an end_image command.
; Example: (vector_text "M" 110 25 0 5 "Hello World")
;-------------------------------------------------------------------------------
(defun vector_text (Justify$ X# Y# Rotation# Color# TextStr$ / ChrList@ FontList@
Item Num# Width# XY# X1# X2# Y1# Y2#)
(setq Justify$ (strcase Justify$))
(if (not (member Justify$ (list "L" "ML" "TL" "C" "M" "TC" "R" "MR" "TR")))
(progn (princ "\nvector_text syntax error:\nJustification options are L, ML, TL, C, M, TC, R, MR, and TR.")(exit))
);if
(if (and (< Color# 0)(> Color# 255))
(progn (princ "\nvector_text syntax error:\nColor value ranges between 0 and 255.")(exit))
);if
(if (or (< X# 0)(< Y# 0))
(progn (princ "\nvector_text syntax error:\nValues for X and Y must be a positive number.")(exit))
);if
(if (not (or (= Rotation# 0)(= Rotation# 90)))
(progn (princ "\nvector_text syntax error:\nRotation angle can only be 0 or 90 degrees.")(exit))
);if
(setq FontList@ (GetFontList TextStr$))
(setq Width# 0)
(if (= Rotation# 0)
(progn
 (if (member Justify$ (list "TL" "TC" "TR"))
 (setq Y# (1- Y#))
 );if
 (if (member Justify$ (list "ML" "M" "MR"))
 (setq Y# (- Y# 5))
 );if
 (if (member Justify$ (list "L" "C" "R"))
 (setq Y# (- Y# 9))
 );if
 (foreach Item FontList@
 (setq Width# (+ Width# (nth 0 Item)))
 );foreach
 (if (member Justify$ (list "C" "M" "TC"))
 (setq X# (- X# (fix (+ (/ Width# 2.0) 0.5))))
 );if
 (if (member Justify$ (list "R" "MR" "TR"))
 (setq X# (- X# Width#))
 );if
 (foreach ChrList@ FontList@
 (setq Num# 1)
 (while (< Num# (length ChrList@))
 (setq XY# (nth Num# ChrList@)
 X1# (+ X# (nth Num# ChrList@))
 Y1# (+ Y# (nth (1+ Num#) ChrList@))
 X2# (+ X# (nth (+ Num# 2) ChrList@))
 Y2# (+ Y# (nth (+ Num# 3) ChrList@))
 );setq
 (if (and (/= XY# -1)(> X1# -1)(> Y1# -1)(> X2# -1)(> Y2# -1))
 (vector_image X1# Y1# X2# Y2# Color#)
 );if
 (setq Num# (+ Num# 4))
 );while
 (setq X# (+ X# (nth 0 ChrList@)))
 );foreach
);progn
(progn
 (if (member Justify$ (list "TL" "TC" "TR"))
 (setq X# (1- X#))
 );if
 (if (member Justify$ (list "ML" "M" "MR"))
 (setq X# (- X# 5))
 );if
 (if (member Justify$ (list "L" "C" "R"))
 (setq X# (- X# 9))
 );if
 (foreach Item FontList@
 (setq Width# (+ Width# (nth 0 Item)))
 );foreach
 (if (member Justify$ (list "C" "M" "TC"))
 (setq Y# (+ Y# (fix (+ (/ Width# 2.0) 0.5))))
 );if
 (if (member Justify$ (list "R" "MR" "TR"))
 (setq Y# (+ Y# Width#))
 );if
 (foreach ChrList@ FontList@
 (setq Num# 1)
 (while (< Num# (length ChrList@))
 (setq XY# (nth Num# ChrList@)
 X1# (+ X# (nth (1+ Num#) ChrList@))
 Y1# (- Y# (nth Num# ChrList@))
 X2# (+ X# (nth (+ Num# 3) ChrList@))
 Y2# (- Y# (nth (+ Num# 2) ChrList@))
 );setq
 (if (and (/= XY# -1)(> X1# -1)(> Y1# -1)(> X2# -1)(> Y2# -1))
 (vector_image X1# Y1# X2# Y2# Color#)
 );if
 (setq Num# (+ Num# 4))
 );while
 (setq Y# (- Y# (nth 0 ChrList@)))
 );foreach
);progn
);if
);defun vector_text

sachindkini 发表于 2011-5-24 14:39:29

DEAR SIR,; error: no function definition: GETFONTLIST

dxj958 发表于 2011-5-25 19:55:33

GetFontList

xyp1964 发表于 2011-5-25 20:14:52

不错，受启发完善了一下函数库！

egos 发表于 2011-5-26 11:21:59

发给需要的朋友

页: [1] 2

明经CAD社区's Archiver

图像控件绘制文本字符的工具

为什么我运行时出错？