全國最多中醫師線上諮詢網站-台灣中醫網
發文 回覆 瀏覽次數:1864
推到 Plurk!
推到 Facebook!

RichEdit, 字會閃得很利害

缺席
max5020
資深會員


發表:30
回覆:277
積分:321
註冊:2003-06-04

發送簡訊給我
#1 引用回覆 回覆 發表時間:2007-12-03 19:24:00 IP:116.25.xxx.xxx 訂閱

procedure Show_ReverseWord(re: TRichEdit);
const r_Color = clBlue;
f_Color = clFuchsia;
c_Color = clRed;
m_Color = clSilver;
var aWord: Array[1..1000] of String;
aPos: Array[1..1000] of Integer;
i, k, aMax: Integer;
isQuoted, isMarked: Boolean;
s, sText: String;
function isReversed(const sw, nc: String): TColor;
var rWord, fWord: String;
rs: String;
begin
Result:= clDefault;
if copy(sw,1,1)='''' then
begin
Result:= c_Color;
exit;
end;
if (copy(sw,1,1)='-') or (copy(sw,1,2)='//') then
begin
Result:= m_Color;
exit;
end;
rWord:= ';';
rWord:= rWord 'ADD;ALL;ALTER;AND;ANY;AS;ASC;AUTHORIZATION;';
rWord:= rWord 'BACKUP;BEGIN;BETWEEN;BREAK;BROWSE;BULK;BY;';
rWord:= rWord 'CASCADE;CASE;CHECK;CHECKPOINT;CLOSE;CLUSTERED;COALESCE;COLLATE;COLUMN;COMMIT;COMPUTE;CONSTRAINT;CONTAINS;';
rWord:= rWord 'CONTAINSTABLE;CONTINUE;CONVERT;CREATE;CROSS;CURRENT;CURRENT_DATE;CURRENT_TIME;CURRENT_TIMESTAMP;CURRENT_USER;CURSOR;';
rWord:= rWord 'DATABASE;DBCC;DEALLOCATE;DECLARE;DEFAULT;DELETE;DENY;DESC;DISK;DISTINCT;DISTRIBUTED;DOUBLE;DROP;DUMMY;DUMP;';
rWord:= rWord 'ELSE;END;ERRLVL;ESCAPE;EXCEPT;EXEC;EXECUTE;EXISTS;EXIT;';
rWord:= rWord 'FETCH;FILE;FILLFACTOR;FOR;FOREIGN;FREETEXT;FREETEXTTABLE;FROM;FULL;FUNCTION;';
rWord:= rWord 'GOTO;GRANT;GROUP;HAVING;HOLDLOCK;';
rWord:= rWord 'IDENTITY;IDENTITY_INSERT;IDENTITYCOL;IF;IN;INDEX;INNER;INSERT;INTERSECT;INTO;IS;';
rWord:= rWord 'JOIN;KEY;KILL;LEFT;LIKE;LINENO;LOAD;NATIONAL;NOCHECK;NONCLUSTERED;NOT;NULL;NULLIF;';
rWord:= rWord 'OF;OFF;OFFSETS;ON;OPEN;OPENDATASOURCE;OPENQUERY;OPENROWSET;OPENXML;OPTION;OR;ORDER;OUTER;OVER;';
rWord:= rWord 'PERCENT;PLAN;PRECISION;PRIMARY;PRINT;PROC;PROCEDURE;PUBLIC;';
rWord:= rWord 'RAISERROR;READ;READTEXT;RECONFIGURE;REFERENCES;REPLICATION;RESTORE;RESTRICT;RETURN;REVOKE;RIGHT;ROLLBACK;ROWCOUNT;ROWGUIDCOL;RULE;';
rWord:= rWord 'SAVE;SCHEMA;SELECT;SESSION_USER;SET;SETUSER;SHUTDOWN;SOME;STATISTICS;SYSTEM_USER;';
rWord:= rWord 'TABLE;TEXTSIZE;THEN;TO;TOP;TRAN;TRANSACTION;TRIGGER;TRUNCATE;TSEQUAL;';
rWord:= rWord 'UNION;UNIQUE;UPDATE;UPDATETEXT;USE;USER;VALUES;VARYING;VIEW;';
rWord:= rWord 'WAITFOR;WHEN;WHERE;WHILE;WITH;WRITETEXT;';
fWord:= ';';
fWord:= fWord 'ABS;ACOS;ASIN;ATAN;ATN2;COS;SIN;COT;TAN;CEILING;DEGREES;EXP;';
fWord:= fWord 'FLOOR;LOG;LOG10;PI;POWER;RANDIANS;RAND;ROUND;SIGN;SQUARE;SQRT;';
fWord:= fWord 'ASCII;CHAR;CHARINDEX;DIFFERENCE;LEFT;LOWER;LTRIM;NCHAR;PATINDEX;QUOTENAME;REPLACE;';
fWord:= fWord 'REPLICATE;REVERSE;RIGHT;RTRIM;SOUNDEX;SPACE;STR;STUFF;SUBSTRING;UNICODE;UPPER;';
fWord:= fWord 'DATEADD;DATEDIFF;DATENAME;DATEPART;DAY;GETDATE;MONTH;YEAR;';
fWord:= fWord 'COALESCE;COL_NAME;COL_LENGTH;DB_ID;DB_NAME;GETANSINULL;HOST_ID;HOST_NAME;INDEX_COL;';
fWord:= fWord 'IDENT_INCR;INDET_SEED;INDEX_COL;ISDATE;ISNULL;ISNUMERIC;NULLIF;';
fWord:= fWord 'OBJECT_ID;OBJECT_NAME;STATS_DATE;SUSER_ID;SUSER_NAME;USER_ID;USER_NAME;';
fWord:= fWord 'CONVERT;CAST;AVG;COUNT;MAX;MIN;STDEV;STDEVP;SUM;VAR;VARP;';
rs:= ';' uppercase(sw) ';';
if pos(rs, rWord)>0 then Result:= r_Color;
if (pos(rs, fWord)>0) and (nc='(') then Result:= f_Color;
end;
begin
sText:= re.Lines.Text;
aMax:= 0;
s:= '';
isQuoted:= false;
isMarked:= false;
k:= Length(sText);
for i:= 0 to k-1 do
begin
if (sText[i]='-') and (not isQuoted) and (not isMarked) then
if sText[i 1]='-' then
begin
isMarked:= true;
s:= '';
end;
if (sText[i]='/') and (not isQuoted) and (not isMarked) then
if sText[i 1]='/' then
begin
isMarked:= true;
s:= '';
end;
if (sText[i]='''') and (not isQuoted) and (not isMarked) then
begin
isQuoted:= true;
s:= '';
end
else if (sText[i]='''') and isQuoted then
begin
isQuoted:= false;
aMax:= aMax 1;
aWord[aMax]:= QuotedStr(s);
aPos[aMax]:= i- Length(s)- 2;
s:= '';
end
else if (ord(sText[i])=10) and isMarked then
begin
isMarked:= false;
aMax:= aMax 1;
aWord[aMax]:= s;
aPos[aMax]:= i- Length(s)- 1;
s:= '';
end
else if (ord(sText[i])<48) and (not isQuoted) and (not isMarked) then
begin
if s<>'' then
begin
aMax:= aMax 1;
aWord[aMax]:= s;
aPos[aMax]:= i- Length(s)- 1;
s:= '';
end;
end
else
begin
s:= s sText[i];
end;
end;
re.Invalidate
k:= re.SelStart;
re.SelectAll;
re.SelAttributes.Name:= re.Font.Name;
re.SelAttributes.Size:= re.Font.Size;
re.SelAttributes.Color:= re.Font.Color;
re.SelLength:= 0;
for i:= 1 to aMax do
begin
re.SelStart:= aPos[i];
re.SelLength:= Length(aWord[i]);
re.SelAttributes.Color:= isReversed(aWord[i], sText[aPos[i] Length(aWord[i]) 1]);
re.SelLength:= 0;
end;
re.SelStart:= k;
re.Update;
end;


procedure Tform.RichEdit1Change(Sender: TObject);
begin
Show_ReverseWord(RichEdit1);
end;

小弟如上附程式,
在RichEdit內容,
onChange,
Show_ReverseWord,
針對SQL保留字,
顯示不同的顏色,
可是RichEdit打字時,
會閃得很利害,
有沒有辦法可以改善!!!
系統時間:2024-05-07 11:54:49
聯絡我們 | Delphi K.Top討論版
本站聲明
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。
2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。
3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇!