editmodule.pas

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

{
 * Unit Name   : EditModule
 * Version     :
 * Date        : 99-12-15 11:56:21
 * Purpose     :
 * Author      : riceball ([e-mail])
 * Copyright(C): 1999, 2000 by riceball
}

Unit EditModule;

Interface

Uses
  {$IFDEF debug}
  dbugintf,
  {$ENDIF}
  Windows,
  Messages,
  SysUtils,
  Classes,
  Graphics,
  Controls,
  Forms,
  Dialogs,
  ImgList,
  Registry,
  vgNLS,
  Menus,
  IniFiles,
  JediLocalStr,
  MainEdit,
  SynEditAutoComplete,
  SynEditKeyCmds,
  SynEditHighlighter,
  SynHighlighterPython,
  SynHighlighterHC11,
  SynHighlighterKix,
  SynHighlighterCache,
  SynHighlighterJScript,
  SynHighlighterCss,
  SynHighlighterADSP21xx,
  SynHighlighterSML,
  SynHighlighterIni,
  SynHighlighterBaan,
  SynHighlighterFoxpro,
  SynHighlighterFortran,
  SynHighlighterProgress,
  SynEditPythonBehaviour,
  SynExportHTML,
  SynEditExport,
  SynExportRTF,
  SynHighlighterGeneral,
  SynHighlighterSQL,
  SynHighlighterVBScript,
  SynHighlighterVB,
  SynHighlighterBat,
  SynHighlighterPHP,
  SynHighlighterAWK,
  SynHighlighterCAC,
  SynHighlighterPerl,
  SynHighlighterJava,
  SynHighlighterHTML,
  SynHighlighterGalaxy,
  SynHighlighterTclTk,
  SynHighlighterHP48,
  SynHighlighterCpp,
  SynHighlighterDfm,
  SynHighlighterPas,
  SynHighlighterDml,
  SynHighlighterASM;

Type
  TEditorDataModule = Class(TDataModule)
    ilBookmarks: TImageList;
    CppSyn1: TSynCppSyn;
    PasSyn1: TSynPasSyn;
    HP48Syn1: TSynHP48Syn;
    TCLTKSyn1: TSynTclTkSyn;
    PythonSyn1: TSynPythonSyn;
    AsmSyn1: TSynAsmSyn;
    DmlSyn1: TSynDmlSyn;
    GalaxySyn1: TSynGalaxySyn;
    HTMLSyn1: TSynHTMLSyn;
    JavaSyn1: TSynJavaSyn;
    PerlSyn1: TSynPerlSyn;
    CACSyn1: TSynCACSyn;
    AWKSyn1: TSynAWKSyn;
    DfmSyn1: TSynDfmSyn;
    PHPSyn1: TSynPHPSyn;
    BatSyn1: TSynBatSyn;
    VBScriptSyn1: TSynVBScriptSyn;
    SQLSyn1: TSynSQLSyn;
    GeneralSyn1: TSynGeneralSyn;
    ExporterRTF1: TSynExporterRTF;
    ExporterHTML1: TSynExporterHTML;
    PythonBehaviour1: TSynEditPythonBehaviour;
    AutoComplete1: TSynAutoComplete;
    ProgressSQLSyn1: TSynProgressSyn;
    VBSyn1: TSynVBSyn;
    FortranSyn1: TSynFortranSyn;
    FoxproSyn1: TSynFoxproSyn;
    BaanSyn1: TSynBaanSyn;
    IniSyn1: TSynIniSyn;
    SMLSyn1: TSynSMLSyn;
    ADSP21xxSyn1: TSynADSP21xxSyn;
    ResourceSyn1: TSynGeneralSyn;
    CSSSyn1: TSynCssSyn;
    JScriptSyn1: TSynJScriptSyn;
    CacheSyn1: TSynCacheSyn;
    KixSyn1: TSynKixSyn;
    HC11Syn1: TSynHC11Syn;
    ilGutterGlyphs: TImageList;
    Procedure DataModuleCreate(Sender: TObject);
  Private
    { Private declarations }
  Public
    { Public declarations }
    tran: TvgTranslator;
    Procedure EnumerateExporters(Const Items: TStrings; Var Filter: String);
    Procedure EnumerateHighlighters(Const Items: TStrings; Var Filter: String);
    Procedure StoreSettings(Const FileName: TFileName);
    Procedure LoadSettings(Const FileName: TFileName);
    Procedure LoadSupportedExts(Const Items: TStrings);
    //Load All JediEdit Supported extensions to Items
    Procedure LoadRegistedExts(Const Items: TStrings);
    //Load already registed extensions to Items
  End;

  TIniStrings = class(TStringList)
  public
    function ReadString(const Section, Ident, Default: string): string;
    procedure WriteString(const Section, Ident, Value: String);
    function ReadInteger(const Section, Ident: string; Default: Longint): Longint;
    procedure WriteInteger(const Section, Ident: string; Value: Longint);
    function ReadBool(const Section, Ident: string; Default: Boolean): Boolean;
    procedure WriteBool(const Section, Ident: string; Value: Boolean);
    function ReadFloat(const Section, Ident: string; Default: Double): Double;
    procedure WriteFloat(const Section, Ident: string; Value: Double);
    function ReadSection(const Section : string; Ss : TStrings) : boolean;
    procedure ReadSectionValues(const Section: string; Ss: TStrings);
    procedure ReadWholeSection(const Section : string; Ss : TStrings);
    procedure ReadSections(Ss : TStrings);
  end;

  //Filters:'Text File|*.txt|document File|*.doc'
  //there are two filter in it above
  //the 1st filter is 'Text File|*.txt' which
  //'Text File' is Filter description
  //'*.txt' is filter file extension
  TFilterList = Class
  Private
    { Private declarations }
    Function GetFilter(Index: Integer): String;
    Procedure SetFilter(Index: Integer; Value: String);

    Function GetFilterDescript(Index: Integer): String;
    Procedure SetFilterDescript(Index: Integer; Value: String);

    Function GetFilterExt(Index: Integer): String;
    Procedure SetFilterExt(Index: Integer; Value: String);

    Function GetFilterPos(Const AIndex: Integer; Var StartPos, Endpos: Integer): Boolean;
  Public
    Filters: String;
    Procedure Add(Const aDescript, aExt: String);
    Procedure AddFilter(Const aFilter: String);
    Procedure Delete(Const AIndex: Integer);
    Function Count: Integer;

    Property Filter[Index: Integer]: String Read GetFilter Write SetFilter;
    Property Description[Index: Integer]: String Read GetFilterDescript Write SetFilterDescript;
    Property Extension[Index: Integer]: String Read GetFilterExt Write SetFilterExt;
  End; //TFilterList

  //Custom Tool Properties
  {PToolRec = ^ToolRec;
  ToolRec = record
    Title,
    Prog,
    WorkDir,
    Params: string[255];
  end; //ToolRec}

Var
  EditorDataModule: TEditorDataModule;
  RegistedExtsList, InternalToolsList, ToolsList: TStringList;

  scAutoCompletion,
  {Navigate Keys Commands Shortcut:}
  nkcJumpUpPro,
  nkcJumpDnPro,
  nkcProcMakePro,
  nkcCollaspeNext,
  nkcCollaspePrev: TShortCut;

Const
  {Navigate Keys Commands:}
  ecJumpUpPro = ecUserFirst + 1;
  ecJumpDnPro = ecUserFirst + 2;
  ecProcMakePro = ecUserFirst + 3;
  ecCollaspeNext = ecUserFirst + 4;
  ecCollaspePrev = ecUserFirst + 5;

  VCLPath: String = '';
  //HelpD3Path: string = '';
  //HelpD4Path: string = '';
  //HelpD5Path: string = '';
  //HelpC3Path: string = '';
  //HelpC4Path: string = '';

  sJeditRegKey = 'JediEdit';

Const
  ToolsListFileName: String = 'Tools.cfg';

  idCollaspePic = 15;
  idExpandPic = 14; //10

  secEditor = 'Editor';
  secGutter = 'Gutter';
  secCodeInsight = 'CodeInsight';
  secLastOpen = 'LastOpenFiles';
  secNavKeys = 'NavigateKeys';

  DelphiRegistryKey = '\Software\Borland\Delphi\';
  CBRegistryKey = '\Software\Borland\C++Builder\';

Function MatchesExtension(Ext: String; Light: TSynCustomHighlighter): Boolean;
Function GetExtHighLighter(Const Ext: String): TSynCustomHighlighter;
Function ShortToLongFileName(Const ShortName: String): String;
Function ShortToLongPath(Const ShortName: String): String;
Procedure GetLanguages(strLanguages: TStringList);
Function GetLocaleData(ID: LCID; Flag: DWORD): String;
Function GetMatcheDefaultLanguage: String;
Function GetDefaultLanguage: String;
// Get JediEdit Default Language File Name

Function ExtractFileBaseName(Const FileName: String): String;
Function ReplaceStrings(Const RawString: String): String;

Procedure AddExt(Var Source: String; Exts: String);
//trim Duplicates Extension and add Extensions to Source

Implementation

Uses
  RegFiles,
  AppUtils,
  OptionsDialog;

{$R *.DFM}

Function ExtractFileBaseName(Const FileName: String): String;
Var
  i: Integer;
Begin
  i := Pos('.', FileName);
  Result := Copy(FileName, 1, i - 1);
End;

Procedure GetLanguages(strLanguages: TStringList);
Var
  sr: TSearchRec;
Begin
  If FindFirst(ExtractFilePath(Application.ExeName) + '*.lng', FaSysFile - FaDirectory, sr) = 0 Then Try
    strLanguages.Add(sr.Name);
    While FindNext(sr) = 0 Do Begin
      strLanguages.Add(sr.Name);
    End; //while
  Finally
    FindClose(sr);
  End; //try
End;

Function GetLocaleData(ID: LCID; Flag: DWORD): String;
Var
  BufSize: Integer;
Begin
  BufSize := GetLocaleInfo(ID, Flag, Nil, 0);
  SetLength(Result, BufSize);
  GetLocaleInfo(ID, Flag, PChar(Result), BufSize);
  SetLength(Result, BufSize - 1);
End;

Function GetMatcheDefaultLanguage: String;
Var
  xLanguage: Integer;
Begin
  xLanguage := GetUserDefaultLangID;
  xLanguage := (LoWord(xLanguage) And $3FF);
  Result := GetLocaleData(xLanguage, LOCALE_SLANGUAGE);
End;

Function GetDefaultLanguage: String;
Var
  I: Integer;
  strLanguages: TStringList;
  s: String;
  MachineDefaultLanguage: String;
Begin
  With TIniFile.Create(ExtractFilePath(Application.ExeName) + GetDefaultIniName) Do Begin
    Try
      Result := ReadString('TfrmJediEdit', 'DefaultLanguage', '');
    Finally
      Free;
    End; //try
  End;
  If Result = '' Then Begin
    strLanguages := TStringList.Create;
    Try
      GetLanguages(strLanguages);
      MachineDefaultLanguage := GetMatcheDefaultLanguage;
      For I := 0 To strLanguages.Count - 1 Do Begin
        s := ExtractFileBaseName(strLanguages[I]);
        If Pos(UpperCase(s), UpperCase(MachineDefaultLanguage)) > 0 Then Begin
          Result := strLanguages[I];
          Break;
        End;
      End;
    Finally
      StrLanguages.Free;
    End; //try
    s := ExtractFilePath(Application.ExeName);
    If Result <> '' Then
      Result := s + Result
    Else Begin
      Result := s + 'English.lng';
    End;
  End; //if
End;

Function ShortToLongFileName(Const ShortName: String): String;
Var
  Temp: TWin32FindData;
  SearchHandle: THandle;
Begin
  SearchHandle := Windows.FindFirstFile(PChar(ShortName), Temp);
  If SearchHandle <> INVALID_HANDLE_VALUE Then Begin
    Result := String(Temp.CFileName);
    If Result = '' Then Result := String(Temp.CAlternateFileName);
  End
  Else Result := '';
  Windows.FindClose(SearchHandle);
End;

Function ShortToLongPath(Const ShortName: String): String;
Var
  LastSlash: PChar;
  TempPathPtr: PChar;
Begin
  Result := '';
  TempPathPtr := PChar(ShortName);
  LastSlash := AnsiStrRScan(TempPathPtr, '\');
  While LastSlash <> Nil Do Begin
    Result := '\' + ShortToLongFileName(TempPathPtr) + Result;
    If LastSlash <> Nil Then Begin
      LastSlash^ := Char(0);
      LastSlash := AnsiStrRScan(TempPathPtr, '\');
    End;
  End;
  Result := TempPathPtr + Result;
End;

Function GetExtHighLighter(Const Ext: String): TSynCustomHighlighter;
Var
  i: Integer;
Begin
  Result := Nil;
  With EditorDataModule Do For i := 0 To ComponentCount - 1 Do
      If Components[i] Is TSynCustomHighlighter Then Begin
        If MatchesExtension(Ext, Components[i] As TSynCustomHighlighter) Then Begin
          Result := Components[i] As TSynCustomHighlighter;
          Break;
        End; //if
      End; //if
End;

Function MatchesExtension(Ext: String; Light: TSynCustomHighlighter): Boolean;
Var
  FExt: String;
  //idx   : integer;
  ucext: String;
  Filter: String;
  p: Integer;
Begin
  Result := False;
  ucext := UpperCase(Ext);
  p := Pos('.', ucext);
  If p > 0 Then ucext := Copy(ucext, p + 1, Length(ucext) - p);
  p := Pos('|', Light.DefaultFilter);
  If p > 0 Then Begin
    Filter := Copy(Light.DefaultFilter, p + 1, Length(Light.DefaultFilter) - p);
    While Filter <> '' Do Begin
      p := Pos(';', Filter);
      If p = 0 Then p := Length(Filter) + 1;
      FExt := Copy(Filter, 1, p - 1);
      Filter := Copy(Filter, p + 1, Length(Filter) - p);
      p := Pos('.', FExt);
      If p > 0 Then FExt := Copy(FExt, p + 1, Length(FExt) - p);
      If UpperCase(FExt) = ucext Then Begin
        Result := True;
      End; //if
    End; //while
  End; //if
End; { MatchesExtension }

{TFilterList}
{StrFunc}

Function SeperatorCount(Const s: String; Const Seperator: Char): Integer;
Var
  P: PChar;
  t: String;
Begin
  Result := 0;
  t := S + #0; // double null terminators
  P := AnsiStrScan(PChar(t), Seperator);
  While P <> Nil Do Begin
    Inc(Result);
    //    P^ := #0;
    Inc(P);
    P := AnsiStrScan(P, Seperator);
  End;
End;

Function SeperatorPosition(Const Index: Integer; Const s: String; Const Seperator: Char): Integer;
Var
  P: PChar;
  t: String;
Begin
  Result := 0;
  t := S + #0; // double null terminators
  P := AnsiStrScan(PChar(t), Seperator);
  While P <> Nil Do Begin
    Inc(Result);
    If Result >= Index Then Begin