From: <mar...@us...> - 2006-05-16 09:39:42
|
Revision: 10602 Author: marquardt Date: 2006-05-16 02:39:10 -0700 (Tue, 16 May 2006) ViewCVS: http://svn.sourceforge.net/jvcl/?rev=10602&view=rev Log Message: ----------- files moved to archive Added Paths: ----------- trunk/jvcl/archive/JvgProcess.pas trunk/jvcl/archive/JvgRichEditUtils.pas trunk/jvcl/archive/TJVGPROCESS.BMP Removed Paths: ------------- trunk/jvcl/images/TJVGPROCESS.BMP trunk/jvcl/run/JvgProcess.pas trunk/jvcl/run/JvgRichEditUtils.pas Copied: trunk/jvcl/archive/JvgProcess.pas (from rev 10599, trunk/jvcl/run/JvgProcess.pas) =================================================================== --- trunk/jvcl/archive/JvgProcess.pas (rev 0) +++ trunk/jvcl/archive/JvgProcess.pas 2006-05-16 09:39:10 UTC (rev 10602) @@ -0,0 +1,159 @@ +{----------------------------------------------------------------------------- +The contents of this file are subject to the Mozilla Public License +Version 1.1 (the "License"); you may not use this file except in compliance +with the License. You may obtain a copy of the License at +http://www.mozilla.org/MPL/MPL-1.1.html + +Software distributed under the License is distributed on an "AS IS" basis, +WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for +the specific language governing rights and limitations under the License. + +The Original Code is: JvgProcess.PAS, released on 2003-01-15. + +The Initial Developer of the Original Code is Andrey V. Chudin, [chudin att yandex dott ru] +Portions created by Andrey V. Chudin are Copyright (C) 2003 Andrey V. Chudin. +All Rights Reserved. + +Contributor(s): +Michael Beck [mbeck att bigfoot dott com]. + +You may retrieve the latest version of this file at the Project JEDI's JVCL home page, +located at http://jvcl.sourceforge.net + +Known Issues: +-----------------------------------------------------------------------------} +// $Id$ + +unit JvgProcess; + +{$I jvcl.inc} + +interface + +//...simple process managment + +uses + {$IFDEF USEJVCL} + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + Windows, SysUtils, Messages, Classes, Forms, + JvComponentBase; + {$ELSE} + Windows, SysUtils, Messages, Classes, Forms; + {$ENDIF USEJVCL} + +type + {$IFDEF USEJVCL} + TJvgProcess = class(TJvComponent) + {$ELSE} + TJvgProcess = class(TComponent) + {$ENDIF USEJVCL} + private + FInfo: TProcessInformation; + FRunning: Boolean; + FFileName: TFileName; + FOnTerminated: TNotifyEvent; + public + destructor Destroy; override; + function Run: Boolean; + function Kill: Boolean; + public + property Info: TProcessInformation read FInfo; + property Running: Boolean read FRunning; + published + property FileName: TFileName read FFileName write FFileName; + property OnTerminated: TNotifyEvent read FOnTerminated write FOnTerminated; + end; + +{$IFDEF USEJVCL} +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$RCSfile$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JVCL\run' + ); +{$ENDIF UNITVERSIONING} +{$ENDIF USEJVCL} + +implementation + +type + TJvgProcessMonitorThread = class(TThread) + public + Process: THandle; + Owner: TJvgProcess; + procedure Execute; override; + procedure DoTerminated; + end; + +var + ProcessMonitorThread: TJvgProcessMonitorThread; + +procedure TJvgProcessMonitorThread.DoTerminated; +begin + Owner.FRunning := False; + if not (csDestroying in Owner.ComponentState) then + if Assigned(Owner.FOnTerminated) then + Owner.FOnTerminated(Owner); +end; + +procedure TJvgProcessMonitorThread.Execute; +begin + while not Terminated do + if WaitForSingleObject(Process, 100) <> WAIT_TIMEOUT then + Break; + Synchronize(DoTerminated); +end; + +destructor TJvgProcess.Destroy; +begin + Kill; + inherited Destroy; +end; + +function TJvgProcess.Run: Boolean; +var + Si: TStartupInfo; +begin + Result := False; + if Running then + Exit; + FillChar(Si, SizeOf(Si), #0); + Si.cb := SizeOf(Si); + GetStartupInfo(Si); + Si.wShowWindow := SW_NORMAL; + FRunning := CreateProcess(PChar(FFileName), nil, nil, nil, False, + NORMAL_PRIORITY_CLASS, nil, nil, Si, FInfo); + Result := FRunning; + if FRunning then + begin + ProcessMonitorThread := TJvgProcessMonitorThread.Create(True); + ProcessMonitorThread.FreeOnTerminate := True; + ProcessMonitorThread.Process := Info.hProcess; + ProcessMonitorThread.Resume; + end; +end; + +function TJvgProcess.Kill: Boolean; +begin + if FRunning then + Result := TerminateProcess(Info.hProcess, 0) + else + Result := False; +end; + +{$IFDEF USEJVCL} +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} +{$ENDIF USEJVCL} + +end. + Copied: trunk/jvcl/archive/JvgRichEditUtils.pas (from rev 10599, trunk/jvcl/run/JvgRichEditUtils.pas) =================================================================== --- trunk/jvcl/archive/JvgRichEditUtils.pas (rev 0) +++ trunk/jvcl/archive/JvgRichEditUtils.pas 2006-05-16 09:39:10 UTC (rev 10602) @@ -0,0 +1,256 @@ +{----------------------------------------------------------------------------- +The contents of this file are subject to the Mozilla Public License +Version 1.1 (the "License"); you may not use this file except in compliance +with the License. You may obtain a copy of the License at +http://www.mozilla.org/MPL/MPL-1.1.html + +Software distributed under the License is distributed on an "AS IS" basis, +WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for +the specific language governing rights and limitations under the License. + +The Original Code is: JvgRichEditUtils.PAS, released on 2003-01-15. + +The Initial Developer of the Original Code is Andrey V. Chudin, [chudin att yandex dott ru] +Portions created by Andrey V. Chudin are Copyright (C) 2003 Andrey V. Chudin. +All Rights Reserved. + +Contributor(s): +Michael Beck [mbeck att bigfoot dott com]. + +You may retrieve the latest version of this file at the Project JEDI's JVCL home page, +located at http://jvcl.sourceforge.net + +Description: + TRichEdit Wrapping functions + +Known Issues: +-----------------------------------------------------------------------------} +// $Id$ + +unit JvgRichEditUtils; + +{$I jvcl.inc} + +interface + +uses + {$IFDEF USEJVCL} + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$ENDIF USEJVCL} + Windows, Messages, Graphics, ComCtrls, Classes; + +procedure AddNl(RE: TRichEdit); +procedure AddText(RE: TRichEdit; const Str: string; TxtSize: Integer; + TxtStyle: TFontStyles; TxtColor: TColor); +procedure AddTextNl(RE: TRichEdit; const Str: string; TxtSize: Integer; + TxtStyle: TFontStyles; TxtColor: TColor); +procedure DoSyntaxHighlight(Memo: TRichEdit); + +{$IFDEF USEJVCL} +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$RCSfile$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JVCL\run' + ); +{$ENDIF UNITVERSIONING} +{$ENDIF USEJVCL} + +implementation + +procedure AddNl(RE: TRichEdit); +begin + RE.Lines.Add(''); +end; + +procedure AddText(RE: TRichEdit; const Str: string; TxtSize: Integer; + TxtStyle: TFontStyles; TxtColor: TColor); +var + Pos1, Pos2: Integer; +begin + with RE, RE.Lines do + begin + Pos1 := Length(Text); + if Pos1 = 0 then + Text := Str + else + Lines[Lines.Count - 1] := Lines[Lines.Count - 1] + Str; + Pos2 := Length(Text); + SelStart := Pos1 - 2; + SelLength := Pos2 - Pos1 + 1; + + SelAttributes.Size := TxtSize; + SelAttributes.Style := TxtStyle; + SelAttributes.Color := TxtColor; + end; +end; + +procedure AddTextNl(RE: TRichEdit; const Str: string; TxtSize: Integer; + TxtStyle: TFontStyles; TxtColor: TColor); +begin + RE.Lines.Add(''); + AddText(RE, Str, TxtSize, TxtStyle, TxtColor); +end; + +procedure DoSyntaxHighlight(Memo: TRichEdit); +type + THData = record + Word: string; + Color: TColor; + Bold: Boolean; + end; + + TLexemKind = (ltTag, ltComma); + + PLexem = ^TLexem; + TLexem = record + StartPos, EndPos: Integer; + Kind: TLexemKind; + end; + + TLastLexem = record + Tag, Comma: TLexem; + end; + +{ (rom) disabled not used +const + cWordsCount = 6; + cWord: array [1..cWordsCount] of PChar = + ('<html>', '<body>', 'function', 'var', 'script', '<Table'); + cColor: array [1..cWordsCount] of TColor = + ($500000, $500000, $500000, $500000, $000060, $606000); + cBold: array [1..cWordsCount] of Boolean = + (False, False, True, True, False, False); +} +var + Pos1: Integer; + i: Integer; + doBold: Boolean; + MemoText: string; + Lexems: TList; + LastLexem: TLastLexem; + PL: PLexem; + + function GetNextLexem(var Pos1, Pos2: Integer; Trimleft: Boolean): string; + var + Pos: Integer; + begin + Pos := Pos1; + if MemoText[Pos] = ' ' then + repeat + Inc(Pos); + until (Pos > Length(MemoText)) or (MemoText[Pos] <> ' '); + Pos2 := Pos; + if Trimleft then + Pos1 := Pos; + repeat + Inc(Pos2); + until (Pos2 > Length(MemoText)) or (MemoText[Pos2] = ' ') or + (MemoText[Pos2] = '''') or (MemoText[Pos2] = '"') or + (MemoText[Pos2] = Chr($0D)); + + Result := Copy(MemoText, Pos1, Pos2 - Pos1); + end; + +begin + doBold := False; + Lexems := TList.Create; + try + MemoText := Memo.Text; + + Memo.Lines.BeginUpdate; + SendMessage(Memo.Handle, WM_SETREDRAW, 0, 0); + Pos1 := 1; + + Memo.SelStart := 0; + Memo.SelLength := Length(MemoText); + Memo.SelAttributes.Color := clBlack; + Memo.SelAttributes.Style := []; + + LastLexem.Tag.StartPos := -1; + LastLexem.Comma.StartPos := -1; + + while Pos1 < Length(MemoText) do + begin + if (MemoText[Pos1] = '>') and (LastLexem.Tag.StartPos <> -1) then + begin + New(PL); + Lexems.Add(PL); + PL^.Kind := ltTag; + PL^.StartPos := LastLexem.Tag.StartPos; + PL^.EndPos := Pos1; + LastLexem.Tag.StartPos := -1; + end + else + if ((MemoText[Pos1] = '''') or (MemoText[Pos1] = '"')) and + (LastLexem.Comma.StartPos <> -1) then + begin + New(PL); + Lexems.Add(PL); + PL^.Kind := ltComma; + PL^.StartPos := LastLexem.Comma.StartPos; + PL^.EndPos := Pos1; + LastLexem.Comma.StartPos := -1; + end + else + if MemoText[Pos1] = '<' then + LastLexem.Tag.StartPos := Pos1 - 1 + else + if (MemoText[Pos1] = '''') or (MemoText[Pos1] = '"') then + LastLexem.Comma.StartPos := Pos1 - 1; + Inc(Pos1); + if (MemoText[Pos1 - 1] = '<') and (MemoText[Pos1] = '#') then + doBold := True; + end; + + for i := 0 to Lexems.Count - 1 do + with PLexem(Lexems[i])^ do + if Kind = ltTag then + begin + Memo.SelStart := StartPos; + Memo.SelLength := EndPos - StartPos; + Memo.SelAttributes.Color := clBlue; + if doBold then + Memo.SelAttributes.Style := [fsBold] + else + Memo.SelAttributes.Style := []; + end; + + for i := 0 to Lexems.Count - 1 do + with PLexem(Lexems[i])^ do + if Kind = ltComma then + begin + Memo.SelStart := StartPos; + Memo.SelLength := EndPos - StartPos; + Memo.SelAttributes.Color := clTeal; + end; + + Memo.Lines.EndUpdate; + SendMessage(Memo.Handle, WM_SETREDRAW, 1, 0); + RedrawWindow(Memo.Handle, nil, 0, RDW_INVALIDATE or RDW_ALLCHILDREN); + Memo.SelStart := 0; + Memo.SelLength := 0; + + finally + for i := 0 to Lexems.Count - 1 do + Dispose(Lexems[i]); + Lexems.Free; + end; +end; + +{$IFDEF USEJVCL} +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} +{$ENDIF USEJVCL} + +end. + Copied: trunk/jvcl/archive/TJVGPROCESS.BMP (from rev 10599, trunk/jvcl/images/TJVGPROCESS.BMP) =================================================================== (Binary files differ) Deleted: trunk/jvcl/images/TJVGPROCESS.BMP =================================================================== (Binary files differ) Deleted: trunk/jvcl/run/JvgProcess.pas =================================================================== --- trunk/jvcl/run/JvgProcess.pas 2006-05-16 09:34:26 UTC (rev 10601) +++ trunk/jvcl/run/JvgProcess.pas 2006-05-16 09:39:10 UTC (rev 10602) @@ -1,159 +0,0 @@ -{----------------------------------------------------------------------------- -The contents of this file are subject to the Mozilla Public License -Version 1.1 (the "License"); you may not use this file except in compliance -with the License. You may obtain a copy of the License at -http://www.mozilla.org/MPL/MPL-1.1.html - -Software distributed under the License is distributed on an "AS IS" basis, -WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for -the specific language governing rights and limitations under the License. - -The Original Code is: JvgProcess.PAS, released on 2003-01-15. - -The Initial Developer of the Original Code is Andrey V. Chudin, [chudin att yandex dott ru] -Portions created by Andrey V. Chudin are Copyright (C) 2003 Andrey V. Chudin. -All Rights Reserved. - -Contributor(s): -Michael Beck [mbeck att bigfoot dott com]. - -You may retrieve the latest version of this file at the Project JEDI's JVCL home page, -located at http://jvcl.sourceforge.net - -Known Issues: ------------------------------------------------------------------------------} -// $Id$ - -unit JvgProcess; - -{$I jvcl.inc} - -interface - -//...simple process managment - -uses - {$IFDEF USEJVCL} - {$IFDEF UNITVERSIONING} - JclUnitVersioning, - {$ENDIF UNITVERSIONING} - Windows, SysUtils, Messages, Classes, Forms, - JvComponentBase; - {$ELSE} - Windows, SysUtils, Messages, Classes, Forms; - {$ENDIF USEJVCL} - -type - {$IFDEF USEJVCL} - TJvgProcess = class(TJvComponent) - {$ELSE} - TJvgProcess = class(TComponent) - {$ENDIF USEJVCL} - private - FInfo: TProcessInformation; - FRunning: Boolean; - FFileName: TFileName; - FOnTerminated: TNotifyEvent; - public - destructor Destroy; override; - function Run: Boolean; - function Kill: Boolean; - public - property Info: TProcessInformation read FInfo; - property Running: Boolean read FRunning; - published - property FileName: TFileName read FFileName write FFileName; - property OnTerminated: TNotifyEvent read FOnTerminated write FOnTerminated; - end; - -{$IFDEF USEJVCL} -{$IFDEF UNITVERSIONING} -const - UnitVersioning: TUnitVersionInfo = ( - RCSfile: '$RCSfile$'; - Revision: '$Revision$'; - Date: '$Date$'; - LogPath: 'JVCL\run' - ); -{$ENDIF UNITVERSIONING} -{$ENDIF USEJVCL} - -implementation - -type - TJvgProcessMonitorThread = class(TThread) - public - Process: THandle; - Owner: TJvgProcess; - procedure Execute; override; - procedure DoTerminated; - end; - -var - ProcessMonitorThread: TJvgProcessMonitorThread; - -procedure TJvgProcessMonitorThread.DoTerminated; -begin - Owner.FRunning := False; - if not (csDestroying in Owner.ComponentState) then - if Assigned(Owner.FOnTerminated) then - Owner.FOnTerminated(Owner); -end; - -procedure TJvgProcessMonitorThread.Execute; -begin - while not Terminated do - if WaitForSingleObject(Process, 100) <> WAIT_TIMEOUT then - Break; - Synchronize(DoTerminated); -end; - -destructor TJvgProcess.Destroy; -begin - Kill; - inherited Destroy; -end; - -function TJvgProcess.Run: Boolean; -var - Si: TStartupInfo; -begin - Result := False; - if Running then - Exit; - FillChar(Si, SizeOf(Si), #0); - Si.cb := SizeOf(Si); - GetStartupInfo(Si); - Si.wShowWindow := SW_NORMAL; - FRunning := CreateProcess(PChar(FFileName), nil, nil, nil, False, - NORMAL_PRIORITY_CLASS, nil, nil, Si, FInfo); - Result := FRunning; - if FRunning then - begin - ProcessMonitorThread := TJvgProcessMonitorThread.Create(True); - ProcessMonitorThread.FreeOnTerminate := True; - ProcessMonitorThread.Process := Info.hProcess; - ProcessMonitorThread.Resume; - end; -end; - -function TJvgProcess.Kill: Boolean; -begin - if FRunning then - Result := TerminateProcess(Info.hProcess, 0) - else - Result := False; -end; - -{$IFDEF USEJVCL} -{$IFDEF UNITVERSIONING} -initialization - RegisterUnitVersion(HInstance, UnitVersioning); - -finalization - UnregisterUnitVersion(HInstance); -{$ENDIF UNITVERSIONING} -{$ENDIF USEJVCL} - -end. - Deleted: trunk/jvcl/run/JvgRichEditUtils.pas =================================================================== --- trunk/jvcl/run/JvgRichEditUtils.pas 2006-05-16 09:34:26 UTC (rev 10601) +++ trunk/jvcl/run/JvgRichEditUtils.pas 2006-05-16 09:39:10 UTC (rev 10602) @@ -1,256 +0,0 @@ -{----------------------------------------------------------------------------- -The contents of this file are subject to the Mozilla Public License -Version 1.1 (the "License"); you may not use this file except in compliance -with the License. You may obtain a copy of the License at -http://www.mozilla.org/MPL/MPL-1.1.html - -Software distributed under the License is distributed on an "AS IS" basis, -WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for -the specific language governing rights and limitations under the License. - -The Original Code is: JvgRichEditUtils.PAS, released on 2003-01-15. - -The Initial Developer of the Original Code is Andrey V. Chudin, [chudin att yandex dott ru] -Portions created by Andrey V. Chudin are Copyright (C) 2003 Andrey V. Chudin. -All Rights Reserved. - -Contributor(s): -Michael Beck [mbeck att bigfoot dott com]. - -You may retrieve the latest version of this file at the Project JEDI's JVCL home page, -located at http://jvcl.sourceforge.net - -Description: - TRichEdit Wrapping functions - -Known Issues: ------------------------------------------------------------------------------} -// $Id$ - -unit JvgRichEditUtils; - -{$I jvcl.inc} - -interface - -uses - {$IFDEF USEJVCL} - {$IFDEF UNITVERSIONING} - JclUnitVersioning, - {$ENDIF UNITVERSIONING} - {$ENDIF USEJVCL} - Windows, Messages, Graphics, ComCtrls, Classes; - -procedure AddNl(RE: TRichEdit); -procedure AddText(RE: TRichEdit; const Str: string; TxtSize: Integer; - TxtStyle: TFontStyles; TxtColor: TColor); -procedure AddTextNl(RE: TRichEdit; const Str: string; TxtSize: Integer; - TxtStyle: TFontStyles; TxtColor: TColor); -procedure DoSyntaxHighlight(Memo: TRichEdit); - -{$IFDEF USEJVCL} -{$IFDEF UNITVERSIONING} -const - UnitVersioning: TUnitVersionInfo = ( - RCSfile: '$RCSfile$'; - Revision: '$Revision$'; - Date: '$Date$'; - LogPath: 'JVCL\run' - ); -{$ENDIF UNITVERSIONING} -{$ENDIF USEJVCL} - -implementation - -procedure AddNl(RE: TRichEdit); -begin - RE.Lines.Add(''); -end; - -procedure AddText(RE: TRichEdit; const Str: string; TxtSize: Integer; - TxtStyle: TFontStyles; TxtColor: TColor); -var - Pos1, Pos2: Integer; -begin - with RE, RE.Lines do - begin - Pos1 := Length(Text); - if Pos1 = 0 then - Text := Str - else - Lines[Lines.Count - 1] := Lines[Lines.Count - 1] + Str; - Pos2 := Length(Text); - SelStart := Pos1 - 2; - SelLength := Pos2 - Pos1 + 1; - - SelAttributes.Size := TxtSize; - SelAttributes.Style := TxtStyle; - SelAttributes.Color := TxtColor; - end; -end; - -procedure AddTextNl(RE: TRichEdit; const Str: string; TxtSize: Integer; - TxtStyle: TFontStyles; TxtColor: TColor); -begin - RE.Lines.Add(''); - AddText(RE, Str, TxtSize, TxtStyle, TxtColor); -end; - -procedure DoSyntaxHighlight(Memo: TRichEdit); -type - THData = record - Word: string; - Color: TColor; - Bold: Boolean; - end; - - TLexemKind = (ltTag, ltComma); - - PLexem = ^TLexem; - TLexem = record - StartPos, EndPos: Integer; - Kind: TLexemKind; - end; - - TLastLexem = record - Tag, Comma: TLexem; - end; - -{ (rom) disabled not used -const - cWordsCount = 6; - cWord: array [1..cWordsCount] of PChar = - ('<html>', '<body>', 'function', 'var', 'script', '<Table'); - cColor: array [1..cWordsCount] of TColor = - ($500000, $500000, $500000, $500000, $000060, $606000); - cBold: array [1..cWordsCount] of Boolean = - (False, False, True, True, False, False); -} -var - Pos1: Integer; - i: Integer; - doBold: Boolean; - MemoText: string; - Lexems: TList; - LastLexem: TLastLexem; - PL: PLexem; - - function GetNextLexem(var Pos1, Pos2: Integer; Trimleft: Boolean): string; - var - Pos: Integer; - begin - Pos := Pos1; - if MemoText[Pos] = ' ' then - repeat - Inc(Pos); - until (Pos > Length(MemoText)) or (MemoText[Pos] <> ' '); - Pos2 := Pos; - if Trimleft then - Pos1 := Pos; - repeat - Inc(Pos2); - until (Pos2 > Length(MemoText)) or (MemoText[Pos2] = ' ') or - (MemoText[Pos2] = '''') or (MemoText[Pos2] = '"') or - (MemoText[Pos2] = Chr($0D)); - - Result := Copy(MemoText, Pos1, Pos2 - Pos1); - end; - -begin - doBold := False; - Lexems := TList.Create; - try - MemoText := Memo.Text; - - Memo.Lines.BeginUpdate; - SendMessage(Memo.Handle, WM_SETREDRAW, 0, 0); - Pos1 := 1; - - Memo.SelStart := 0; - Memo.SelLength := Length(MemoText); - Memo.SelAttributes.Color := clBlack; - Memo.SelAttributes.Style := []; - - LastLexem.Tag.StartPos := -1; - LastLexem.Comma.StartPos := -1; - - while Pos1 < Length(MemoText) do - begin - if (MemoText[Pos1] = '>') and (LastLexem.Tag.StartPos <> -1) then - begin - New(PL); - Lexems.Add(PL); - PL^.Kind := ltTag; - PL^.StartPos := LastLexem.Tag.StartPos; - PL^.EndPos := Pos1; - LastLexem.Tag.StartPos := -1; - end - else - if ((MemoText[Pos1] = '''') or (MemoText[Pos1] = '"')) and - (LastLexem.Comma.StartPos <> -1) then - begin - New(PL); - Lexems.Add(PL); - PL^.Kind := ltComma; - PL^.StartPos := LastLexem.Comma.StartPos; - PL^.EndPos := Pos1; - LastLexem.Comma.StartPos := -1; - end - else - if MemoText[Pos1] = '<' then - LastLexem.Tag.StartPos := Pos1 - 1 - else - if (MemoText[Pos1] = '''') or (MemoText[Pos1] = '"') then - LastLexem.Comma.StartPos := Pos1 - 1; - Inc(Pos1); - if (MemoText[Pos1 - 1] = '<') and (MemoText[Pos1] = '#') then - doBold := True; - end; - - for i := 0 to Lexems.Count - 1 do - with PLexem(Lexems[i])^ do - if Kind = ltTag then - begin - Memo.SelStart := StartPos; - Memo.SelLength := EndPos - StartPos; - Memo.SelAttributes.Color := clBlue; - if doBold then - Memo.SelAttributes.Style := [fsBold] - else - Memo.SelAttributes.Style := []; - end; - - for i := 0 to Lexems.Count - 1 do - with PLexem(Lexems[i])^ do - if Kind = ltComma then - begin - Memo.SelStart := StartPos; - Memo.SelLength := EndPos - StartPos; - Memo.SelAttributes.Color := clTeal; - end; - - Memo.Lines.EndUpdate; - SendMessage(Memo.Handle, WM_SETREDRAW, 1, 0); - RedrawWindow(Memo.Handle, nil, 0, RDW_INVALIDATE or RDW_ALLCHILDREN); - Memo.SelStart := 0; - Memo.SelLength := 0; - - finally - for i := 0 to Lexems.Count - 1 do - Dispose(Lexems[i]); - Lexems.Free; - end; -end; - -{$IFDEF USEJVCL} -{$IFDEF UNITVERSIONING} -initialization - RegisterUnitVersion(HInstance, UnitVersioning); - -finalization - UnregisterUnitVersion(HInstance); -{$ENDIF UNITVERSIONING} -{$ENDIF USEJVCL} - -end. - This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |