ich habe aktuell ein kleine Problemchen, ich schreibe grade einen SyntaxHighlighter für eine Programmiersprache, und bei der Hash Tabelle habe ich allerdings ein kleines Problemchen, ich nutze diese Funktion zum Hashen:
Code: Alles auswählen
function TAALSynHighlight.HashToken(toHash: PChar; out Len: integer): byte;
begin
Result := 0;
Len := 0;
while ToHash^ in ['_', '0'..'9', 'a'..'z', 'A'..'Z'] do
begin
if CaseInsensitive And (toHash^ in ['A'..'Z']) then
Result := (Result + Ord(toHash^)-ord('A')+ord('a')) mod 256
else
Result := (Result + Ord(toHash^)) mod 256;
Inc(ToHash);
Inc(Len);
end;
end; Code: Alles auswählen
procedure TForm1.Button3Click(Sender: TObject);
function GetHash(toHash: PChar; out Len: integer): byte;
begin
Result := 0;
Len := 0;
while ToHash^ in ['_', '0'..'9', 'a'..'z', 'A'..'Z'] do
begin
if CaseInsensitive And (toHash^ in ['A'..'Z']) then
Result := (Result + Ord(toHash^)-ord('A')+ord('a')) mod 256
else
Result := (Result + Ord(toHash^)) mod 256;
Inc(ToHash);
Inc(Len);
end;
end;
var
x: Byte;
Dummy: Integer;
tmp: PHashInfo;
begin
x := GetHash(PChar(Edit1.Text), Dummy);
new(tmp);
tmp^.Key := Edit1.Text;
tmp^.Kind := TTokenType(ComboBox1.ItemIndex);
FHashList[x].Add(tmp);
ListBox1.Items.Add(Edit1.Text);
end; Code: Alles auswählen
unit AALHighlighter;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Graphics, SynEditTypes, SynEditHighlighter, Dialogs;
type
TTokenType = (tkComment, tkIdentifier, tkFunction, tkSymbol, tkNumber, tkSpace,
tkString, tkUnknown, tkVar, tkUndefined);
PHashInfo = ^THashInfo;
THashInfo = record
Key: ansistring;
Kind: TTokenType;
end;
{ TAALSynHighlight }
TAALSynHighlight = class(TSynCustomHighlighter)
private
FStrAttr, FCommentAttr, FIdentifierAttr, FKeyAttr,
FFunctionAttr, FNumberAttr, FSpaceAttr, FTextAttr,
FVarAttr: TSynHighlighterAttributes;
// AttributeField & setter
protected
FTokenPos, FTokenEnd, FLineNum: integer;
FToken: string;
FTok: TTokenType;
FTokLen: integer;
FTokenHash: byte;
FLineText: string;
FHashList: array[0..255] of TList;
function GetAttr(a: TTokenType): TSynHighlighterAttributes;
public
function HashToken(toHash: PChar; out Len: integer): byte;
procedure CheckHash;
procedure SetLine(const NewValue: string; LineNumber: integer); override;
procedure Next; override;
function GetEol: boolean; override;
procedure GetTokenEx(out TokenStart: PChar; out TokenLength: integer); override;
function GetTokenAttribute: TSynHighlighterAttributes; override;
public
function GetToken: string; override;
function GetTokenPos: integer; override;
function GetTokenKind: integer; override;
function GetDefaultAttribute(Index: integer): TSynHighlighterAttributes; override;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
// Attribute Properties
end;
const
CaseInsensitive = false;
SingleToken = ['!', '+', '-', '*', '=', '<', '>', '/', '(', ')',
'[', ']', '{', '}', '?', '#', ':', '.'];
implementation
procedure TAALSynHighlight.CheckHash;
function KeyComp(aKey: String): Boolean;
var i: Integer;
t: String;
begin
if CaseInsensitive then
begin
t:=LowerCase(FToken);
aKey:=LowerCase(aKey);
end
else
t:=FToken;
if Length(aKey)<>FTokLen then
begin
Result:=False;
Exit;
end;
Result:=True;
for i:=1 to FTokLen do
if t[i]<>aKey[i] then
begin
Result:=False;
Break;
end;
end;
var i: Integer;
begin
FTok:=tkUnknown;
for i:=0 to FHashList[FTokenHash].Count-1 do
if KeyComp(PHashInfo(FHashList[FTokenHash])^.Key) then
begin
FTok:=PHashInfo(FHashList[FTokenHash])^.Kind;
Break;
end;
end;
function TAALSynHighlight.GetAttr(a: TTokenType): TSynHighlighterAttributes;
begin
Result := nil;
case a of
tkComment: Result := FCommentAttr;
tkIdentifier: Result := FIdentifierAttr;
tkFunction: Result := FFunctionAttr;
tkSymbol: Result := FKeyAttr;
tkNumber: Result := FNumberAttr;
tkSpace: Result := FSpaceAttr;
tkString: Result := FStrAttr;
tkVar: Result := FVarAttr;
else
Result := FTextAttr;
end;
end;
constructor TAALSynHighlight.Create(AOwner: TComponent);
procedure LoadHLTable;
var
fs: TFileStream;
tmp: PHashInfo;
i, x, n, a: integer;
begin
fs := TFileStream.Create(IncludeLeadingPathDelimiter(ExtractFilePath(ParamStr(0))) +
'HL/HL.lst', fmOpenRead);
try
for x := 0 to 255 do
begin
fs.Read(n, SizeOf(n));
for i := 0 to n - 1 do
begin
new(tmp);
fs.Read(tmp^.Kind, SizeOf(tmp^.Kind));
fs.Read(a, SizeOf(a));
SetLength(tmp^.Key, a);
fs.Read(tmp^.Key[1], a);
FHashList[x].Add(tmp);
end;
end;
finally
fs.Free;
end;
end;
var
i: integer;
begin
inherited Create(AOwner);
FStrAttr:= TSynHighlighterAttributes.Create('String', 'String');
FStrAttr.Foreground:=$000000CC;
FCommentAttr:= TSynHighlighterAttributes.Create('Comment', 'Comment');
FCommentAttr.Foreground:=$000099FF;
FIdentifierAttr:= TSynHighlighterAttributes.Create('Indentifier', 'Identifier');
FIdentifierAttr.Foreground:=$00FF6600;
FKeyAttr:= TSynHighlighterAttributes.Create('Symbol', 'Symbol');
FKeyAttr.Foreground:=$00333333;
FFunctionAttr:= TSynHighlighterAttributes.Create('Function', 'Function');
FFunctionAttr.Foreground:=$00FF9100;
FNumberAttr:= TSynHighlighterAttributes.Create('Number', 'Number');
FNumberAttr.Foreground:=$00FF0000;
FSpaceAttr:= TSynHighlighterAttributes.Create('Space', 'Space');
FTextAttr:= TSynHighlighterAttributes.Create('Text', 'Text');
FTextAttr.Foreground:=$00333333;
FVarAttr:= TSynHighlighterAttributes.Create('Variable', 'Variable');
FVarAttr.Foreground:=$00000099;
for i := 0 to 255 do
FHashList[i] := TList.Create;
LoadHLTable;
end;
procedure TAALSynHighlight.SetLine(const NewValue: string; LineNumber: integer);
begin
inherited;
FLineText := NewValue;
// Next will start at "FTokenEnd", so set this to 1
FTokenEnd := 1;
Next;
end;
function TAALSynHighlight.HashToken(toHash: PChar; out Len: integer): byte;
begin
Result := 0;
Len := 0;
while ToHash^ in ['_', '0'..'9', 'a'..'z', 'A'..'Z'] do
begin
if CaseInsensitive And (toHash^ in ['A'..'Z']) then
Result := (Result + Ord(toHash^)-ord('A')+ord('a')) mod 256
else
Result := (Result + Ord(toHash^)) mod 256;
Inc(ToHash);
Inc(Len);
end;
end;
procedure TAALSynHighlight.Next;
var
l: integer;
begin
// FTokenEnd should be at the start of the next Token (which is the Token we want)
FTokenPos := FTokenEnd;
// assume empty, will only happen for EOL
FTokenEnd := FTokenPos;
// Scan forward
// FTokenEnd will be set 1 after the last char. That is:
// - The first char of the next token
// - or past the end of line (which allows GetEOL to work)
l := length(FLineText);
if FTokenPos > l then
exit
else
if FLineText[FTokenEnd] in [#9, ' '] then
begin
while (FTokenEnd <= l) and (FLineText[FTokenEnd] in [#0..#32]) do
Inc(FTokenEnd);
FTokLen := FTokenEnd - FTokenPos;
FToken := copy(FLineText, FTokenPos, FTokLen);
FTok := tkSpace;
end
else if FLineText[FTokenEnd] in SingleToken then
begin
Inc(FTokenEnd);
FToken := FLineText[FTokenPos];
FTokLen := 1;
FTok := tkSymbol;
end
else if FLineText[FTokenEnd] = '$' then
begin
Inc(FTokenEnd);
FTokenHash := HashToken(@FLineText[FTokenEnd], FTokLen);
Inc(FTokLen);
Inc(FTokenEnd, FTokLen);
FToken := copy(FLineText, FTokenPos, FTokLen);
FTok := tkVar;
end
else if FLineText[FTokenEnd] = '"' then
begin
inc(FTokenEnd);
FTok:=tkString;
while (FTokenEnd<=l) And (FLineText[FTokenEnd] <> '"') do
Inc(FTokenEnd);
inc(FTokenEnd);
FTokLen:=FTokenEnd-FTokenPos;
FToken := copy(FLineText, FTokenPos, FTokLen);
end
else if FLineText[FTokenEnd] in ['0'..'9'] then
begin
FTok:=tkNumber;
while (FTokenEnd<=l) And (FLineText[FTokenEnd] in ['0'..'9', '.']) do
Inc(FTokenEnd);
FTokLen:=FTokenEnd-FTokenPos;
FToken := copy(FLineText, FTokenPos, FTokLen);
end
else
begin
FTokenHash := HashToken(@FLineText[FTokenEnd], FTokLen);
Inc(FTokenEnd, FTokLen);
FToken := copy(FLineText, FTokenPos, FTokLen);
FTok := tkUndefined;
end;
end;
function TAALSynHighlight.GetEol: boolean;
begin
Result := FTokenPos > length(FLineText);
end;
procedure TAALSynHighlight.GetTokenEx(out TokenStart: PChar; out TokenLength: integer);
begin
TokenStart := @FLineText[FTokenPos];
TokenLength := FTokLen;
end;
function TAALSynHighlight.GetTokenAttribute: TSynHighlighterAttributes;
begin
if FTok=tkUndefined then
CheckHash;
Result := GetAttr(FTok);
end;
function TAALSynHighlight.GetToken: string;
begin
Result := FToken;
end;
function TAALSynHighlight.GetTokenPos: integer;
begin
Result := FTokenPos - 1;
end;
function TAALSynHighlight.GetDefaultAttribute(Index: integer): TSynHighlighterAttributes;
begin
case Index of
SYN_ATTR_COMMENT: Result := FCommentAttr;
SYN_ATTR_IDENTIFIER: Result := FIdentifierAttr;
SYN_ATTR_KEYWORD: Result := FKeyAttr;
SYN_ATTR_STRING: Result := FStrAttr;
SYN_ATTR_WHITESPACE: Result := FSpaceAttr;
SYN_ATTR_SYMBOL: Result := FKeyAttr;
else
Result := nil;
end;
end;
function TAALSynHighlight.GetTokenKind: integer;
begin
Result := Ord(FTok);
end;
destructor TAALSynHighlight.Destroy;
procedure FreeLst(l: TList);
var
i: integer;
begin
for i := 0 to l.Count - 1 do
Dispose(PHashInfo(l[i]));
l.Free;
end;
var
i: integer;
begin
for i := 0 to 255 do
FreeLst(FHashList[i]);
inherited;
end;
end.Code: Alles auswählen
procedure TForm1.SaveHlTable(Path: string);
var
fs: TFileStream;
tmp: THashInfo;
i, x, a: integer;
begin
fs := TFileStream.Create(Path, fmCreate);
try
for x := 0 to 255 do
begin
fs.Write(FHashList[x].Count, SizeOf(integer));
for i := 0 to FHashList[x].Count - 1 do
begin
tmp := PHashInfo(FHashList[x][i])^;
fs.Write(tmp.Kind, SizeOf(tmp.Kind));
a := Length(tmp.Key);
fs.Write(a, SizeOf(a));
fs.Write(tmp.Key[1], a);
end;
end;
finally
fs.Free;
end;
end; 
Verein
Links
Suche