editmodule.pas

大家是不是为不知道如何在VB学到绝地程序

Begin
  // do not localize any of the below items
  Result := '';
  StVar := UpperCase(StVar);
  {if StVar = '%PROJECTDIR%' then
    Result := GetProjectDir
  else
  if StVar = '%PROJECTNAME%' then
    Result := GetProjectName
  else}
  If StVar = '%FILENAME%' Then
    Result := GetFileName
  Else
    If StVar = '%FILEPATH%' Then
    Result := ExtractFilePath(GetFileName)
  Else
    If StVar = '%DATETIME%' Then
    Result := DateTimeToStr(Date + Time)
  Else
    If StVar = '%HOUR%' Then
    Result := FormatDateTime('hh', Time)
  Else
    If StVar = '%MINUTE%' Then
    Result := FormatDateTime('nn', Time)
  Else
    If StVar = '%SECOND%' Then
    Result := FormatDateTime('ss', Time)
  Else
    If StVar = '%DATE%' Then
    Result := DateToStr(Date)
  Else
    If StVar = '%YEAR%' Then
    Result := FormatDateTime('yyyy', Date) //! Y2K lesson <g>
  Else
    If StVar = '%MONTH%' Then
    Result := FormatDateTime('mm', Date)
  Else
    If StVar = '%MONTHSHORTNAME%' Then
    Result := FormatDateTime('mmm', Date)
  Else
    If StVar = '%MONTHLONGNAME%' Then
    Result := FormatDateTime('mmmm', Date)
  Else
    If StVar = '%DAY%' Then
    Result := FormatDateTime('dd', Date)
  Else
    If StVar = '%DAYSHORTNAME%' Then
    Result := FormatDateTime('ddd', Date)
  Else
    If StVar = '%DAYLONGNAME%' Then
    Result := FormatDateTime('dddd', Date)
      {else
if StVar = '%UNIT%' then
begin
if DoParseSource then
Result := GetUnitName
else
Result := SUnknownNameResult;
end
else
if StVar = '%PROCNAME%' then
begin
if DoParseSource then
Result := GetProcName
else
Result := SUnknownNameResult;
end}
End;

Resourcestring
  sReplaceError = 'Replace Error';

Function ReplaceStrings(Const RawString: String): String;
Var
  i: Integer;
  t: Integer;
Begin
  i := 1;
  While i <= Length(RawString) Do Begin
    If RawString[i] <> '%' Then
      Result := Result + RawString[i]
    Else Begin
      If i < Length(RawString) Then
        If RawString[i + 1] = '%' Then Begin
          Result := Result + '%';
          Inc(i, 2);
          Continue;
        End;
      t := i + 1;
      While (t <= Length(RawString)) And (RawString[t] <> '%') Do
        Inc(t);
      If t <= Length(RawString) Then
        Result := Result + GetReplaceString(Copy(RawString, i, t - i + 1))
      Else
        Result := Result + sReplaceError;
      i := t;
    End;
    Inc(i);
  End;
End;

Procedure TEditorDataModule.DataModuleCreate(Sender: TObject);
Begin
  tran := TvgTranslator.Create(Self);
  LoadRegistedExts(RegistedExtsList);
End;

Procedure TEditorDataModule.LoadSupportedExts(Const Items: TStrings);
Var
  i, j, k: Integer;
  FilterList: TFilterList;
  s, Ext: String;
Begin
  FilterList := TFilterList.Create;
  Items.Clear;
  Try
    For i := 0 To ComponentCount - 1 Do
      If Components[i] Is TSynCustomHighlighter Then Begin
        FilterList.Filters := (Components[i] As TSynCustomHighlighter).DefaultFilter;
        For j := 0 To FilterList.Count - 1 Do Begin
          s := FilterList.Extension[j]; //this maybe include many extensions, so must parse it
          Repeat
            K := AnsiPos(';', s);
            If K = 0 Then Begin
              Ext := s;
              s := '';
            End Else Begin
              Ext := Copy(s, 1, k - 1);
              Delete(s, 1, k);
            End;
            If AnsiPos(UpperCase(Ext), UpperCase(Items.Text)) = 0 Then Begin
              Delete(Ext, 1, 1); //del '*' char, reserve .xxx
              Items.Add(Ext);
            End;
          Until s = '';
        End;
      End;
  Finally
    FilterList.Free;
  End; //try
End;

Procedure TEditorDataModule.LoadRegistedExts(Const Items: TStrings);
Var
  i: Integer;
  Ext: String;
Begin
  GetRegSubTree(LongInt(HKEY_CLASSES_ROOT), '', sJeditRegKey, Items);
  For I := 0 To Items.Count - 1 Do Begin
    UpdateAssociationPath(Items[I], Application.ExeName);
    Ext := Copy(Items[I], Length(sJeditRegKey) + 1, 4);
    Items[I] := Ext + '<' + ExtDescription(Ext) + '>';
  End;
End;

{ TIniStrings }
function TIniStrings.ReadString(const Section, Ident, Default: string): string;
var
  i : integer;
  S : string;
  P : integer;
begin
  Result := Default;
  i := IndexOf('['+Section+']');
  if i = -1 then exit;
  inc(i);
  while i < Count do begin
    S := Strings[i];
    inc(i);
    if Length(S) = 0 then continue;
    if S[1] = '[' then exit;
    if ANSIStrLIComp(PChar(Ident), PChar(S), Length(Ident)) = 0 then begin
      P := Pos('=', S);
      if P <> 0 then
        Result := Copy(S, P+1, Length(S));
      exit;
    end;
  end;
end;

procedure TIniStrings.WriteString(const Section, Ident, Value: string);
var
  F: integer;
  S: string;
begin
  BeginUpdate;
  F := IndexOf('[' + Section + ']');
  if F > -1 then
  begin
    Inc(F);
    while F < Count do
    begin
      S := Trim(Strings[F]);
      if ((Length(S) > 0) and (Trim(S[1]) = '[')) or (Trim(S) = '') then
      begin
        Insert(F, Ident + '=' + Value);
        Break;
      end
      else
        if UpperCase(Copy(S, 1, Pos('=', S) - 1)) = UpperCase(Ident) then
        begin
          Strings[F] := Ident + '=' + Value;
          Break;
        end;
      Inc(F);
    end;
    if F >= Count then Add(Ident + '=' + Value);
  end
  else
  begin
    Add('');
    Add('[' + Section + ']');
    Add(Ident + '=' + Value);
  end;
  EndUpdate;
end;

function TIniStrings.ReadInteger(const Section, Ident: string;
  Default: Longint): Longint;
begin
  try
    Result := StrToInt(ReadString(Section, Ident, IntToStr(Default)));
  except
    Result := Default;
  end;
end;

procedure TIniStrings.WriteInteger(const Section, Ident: string; Value: Longint);
begin
  WriteString(Section, Ident, IntToStr(Value));
end;

function TIniStrings.ReadBool(const Section, Ident: string;
  Default: Boolean): Boolean;
var
  S : string;
begin
  S := Trim(ReadString(Section, Ident, IntToStr(integer(Default))));
  Result := (S = '1') or (ANSICompareText(S, 'on') = 0)  or (ANSICompareText(S, 'yes') = 0);
end;

procedure TIniStrings.WriteBool(const Section, Ident: string; Value: Boolean);
begin
  WriteString(Section, Ident, IntToStr(integer(Value)));
end;

function TIniStrings.ReadFloat(const Section, Ident: string; Default: Double): Double;
begin
  try
    Result := StrToFloat(ReadString(Section, Ident, FloatToStr(Default)));
  except
    Result := Default;
  end;
end;

procedure TIniStrings.WriteFloat(const Section, Ident: string; Value: Double);
begin
  WriteString(Section, Ident, FloatToStr(Value));
end;

function TIniStrings.ReadSection(const Section : string; Ss : TStrings) : boolean;
var
  F : integer;
  S : string;

  procedure ReadSection1;
  begin
		inc(F);
		while F < Count do begin
			S := Strings[F];
			if (Length(S) > 0) and (Trim(S[1])= '[') then break;
      if Trim(S) <> '' then
  			Ss.Add(S);
			inc(F);
		end;
  end;    { ReadSection1 }

begin
  Ss.BeginUpdate;
  try
    Ss.Clear;
    F := IndexOf('['+Section+']');
    Result := F > -1;
    if Result then
    begin
      ReadSection1;
      while F < Count do
      begin
        S := Trim(Strings[F]);
        if S = '['+Section+']' then
          ReadSection1
        else
          inc(F);
      end;    { while }
    end;
	finally
		Ss.EndUpdate;
	end;
end;

procedure TIniStrings.ReadSections(Ss : TStrings);
var
  i : integer;
  S : string;
begin
  Ss.Clear;
  for i := 0 to Count - 1 do
  begin
    S := Trim(Strings[i]);
    if (Length(S) > 0) and (S[1]= '[') and (S[Length(S)]= ']') then
      Ss.Add(Copy(S, 2, Length(S) - 2));
  end;
end;

procedure TIniStrings.ReadSectionValues(const Section: string; Ss: TStrings);
var
  F: integer;
  S: string;

  procedure ReadSection1;
  begin
    inc(F);
    while F < Count do
    begin
      S := Strings[F];
      if (Length(S) > 0) and (Trim(S[1]) = '[') then break;
      if Trim(S) <> '' then
        Ss.Add(S);
      inc(F);
    end;
  end; { ReadSection1 }

begin
  Ss.BeginUpdate;
  try
    Ss.Clear;
    F := IndexOf('[' + Section + ']');
    if F > -1 then
    begin
      ReadSection1;
      while F < Count do
      begin
        S := Trim(Strings[F]);
        if S = '[' + Section + ']' then
          ReadSection1
        else
          inc(F);
      end; { while }
    end;
  finally
    Ss.EndUpdate;
  end;
end;

procedure TIniStrings.ReadWholeSection(const Section : string; Ss : TStrings);
var
  F : integer;
  S : string;
begin
  	F := IndexOf('['+Section+']');
  	if F > -1 then begin
  		Ss.BeginUpdate;
  		try
  			Ss.Clear;
  			inc(F);
  			while F < Count do begin
  				S := Strings[F];
  				if (Length(S) > 0) and (Trim(S[1])= '[') then break;
  				Ss.Add(S);
  				inc(F);
  			end;
  		finally
  			Ss.EndUpdate;
  		end;
  	end;
end;

Initialization
  ToolsList := TStringList.Create;
  InternalToolsList := TStringList.Create;
  RegistedExtsList := TStringList.Create;
  ToolsListFileName := ExtractFilePath(Application.ExeName) + ToolsListFileName;
  If FileExists(ToolsListFileName) Then Begin
    ToolsList.LoadFromFile(ToolsListFileName);
  End;

  With TRegistry.Create Do Try
    RootKey := HKEY_LOCAL_MACHINE;
    If OpenKey(DelphiRegistryKey + '5.0', False) Then Begin
      VclPath := ReadString('RootDir');
      //HelpD5Path := VclPath + '\Help\delphi5.hlp';
      If FileExists(VclPath + '\Help\delphi5.hlp') Then
        InternalToolsList.Insert(0, 'Delphi 5 Help=' + VclPath + '\Help\delphi5.hlp');
    End;
    If OpenKey(DelphiRegistryKey + '4.0', False) Then Begin
      VclPath := ReadString('RootDir');
      //HelpD4Path := VclPath + '\Help\delphi4.hlp';
      If FileExists(VclPath + '\Help\delphi4.hlp') Then
        InternalToolsList.Insert(0, 'Delphi 4 Help=' + VclPath + '\Help\delphi4.hlp');
    End;
    If OpenKey(DelphiRegistryKey + '3.0', False) Then Begin
      VclPath := ReadString('RootDir');
      //HelpD3Path := VclPath + '\Help\delphi3.hlp';
      If FileExists(VclPath + '\Help\delphi3.hlp') Then
        InternalToolsList.Insert(0, 'Delphi 3 Help=' + VclPath + '\Help\delphi3.hlp');
    End;
    If OpenKey(CBRegistryKey + '5.0', False) Then Begin
      VclPath := ReadString('RootDir');
      //HelpC4Path := VclPath + '\Help\cb4.hlp';
      If FileExists(VclPath + '\Help\cb5.hlp') Then
        InternalToolsList.Insert(0, 'C++ Builder 5 Help=' + VclPath + '\Help\cb5.hlp');
    End;
    If OpenKey(CBRegistryKey + '4.0', False) Then Begin
      VclPath := ReadString('RootDir');
      //HelpC4Path := VclPath + '\Help\cb4.hlp';
      If FileExists(VclPath + '\Help\cb4.hlp') Then
        InternalToolsList.Insert(0, 'C++ Builder 4 Help=' + VclPath + '\Help\cb4.hlp');
    End;
    If OpenKey(CBRegistryKey + '3.0', False) Then Begin
      VclPath := ReadString('RootDir');
      //HelpC3Path := VclPath + '\Help\cb3.hlp';
      If FileExists(VclPath + '\Help\cb3.hlp') Then
        InternalToolsList.Insert(0, 'C++ Builder 3 Help=' + VclPath + '\Help\cb3.hlp');
    End;

    VclPath := VclPath + '\Source\VCL\';
  Finally
    Free;
  End;

Finalization
  InternalToolsList.Free;
  ToolsList.Free;
  RegistedExtsList.Free;
End.