RichEdit, 字會閃得很利害 |
缺席
|
max5020
資深會員 發表:30 回覆:277 積分:321 註冊:2003-06-04 發送簡訊給我 |
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打字時, 會閃得很利害, 有沒有辦法可以改善!!! |
本站聲明 |
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。 2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。 3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇! |