Quellcode-Bibliothek

^© Kompilation durch diese Firma

[Weder Korrektheit noch Funktionsfähigkeit der Software werden zugesichert.]

Datei: OptionClass.pas Sprache: Delphi

//----------------------------------------------------------------------------
//
//1. test deaktivieren?
//
//----------------------------------------------------------------------------
unit OptionClass;
//----------------------------------------------------------------------------
//
//----------------------------------------------------------------------------
interface
uses
  //----------------------------------------------------------------------------
  //local
  //----------------------------------------------------------------------------
  GenDefs,OwnUtils,OptionClassGen,Utilities,Language,Splash,
  //----------------------------------------------------------------------------
  //global
  //----------------------------------------------------------------------------
  ComCtrls,StdCtrls,Buttons,Dialogs,Forms,Controls,Classes,Grids,ValEdit,
  ExtCtrls,Math;
//----------------------------------------------------------------------------
//
//----------------------------------------------------------------------------
type
  TOptionDialog= class(TOptionDialogGen)
    Button1:TButton;
    Label3:TLabel;
    Label4:TLabel;
    Label5:TLabel;
    SpeedButton1:TSpeedButton;
    SpeedButton2:TSpeedButton;
    SpeedButton3:TSpeedButton;
    Edit1:TEdit;
    Edit2:TEdit;
    Edit3:TEdit;
    OpenDialog1:TOpenDialog;
    Label7:TLabel;
    Label10:TLabel;
    Label11:TLabel;
    Label12:TLabel;
    ComboBox3:TComboBox;
    ComboBox4:TComboBox;
    ComboBox5:TComboBox;
    Label13:TLabel;
    ComboBox6:TComboBox;
    ComboBox7:TComboBox;
    Button2:TButton;
    Edit4:TEdit;
    Label1:TLabel;
    SpeedButton4:TSpeedButton;
    Label2:TLabel;
    Label8:TLabel;
    ComboBox2:TComboBox;
    ComboBox8:TComboBox;
    ComboBox9:TComboBox;
    Label9:TLabel;
    Label6:TLabel;
    ComboBox1:TComboBox;
    PageControl1:TPageControl;
    Grundoptionen:TTabSheet;
    Extlist:TListView;
    Edit5:TEdit;
    Label14:TLabel;
    Dateiverbindung:TTabSheet;
    ValueList:TValueListEditor;
    TabSheet1:TTabSheet;
    Panel1:TPanel;
    ComboBox10:TComboBox;
    Label15:TLabel;
    Label16:TLabel;
    ComboBox11:TComboBox;
    Label17: TLabel;
    Indentchars: TEdit;
    Label18: TLabel;
    ComboBox12: TComboBox;
    procedure ListBox1Click(Sender:TObject);
    procedure SpeedButton3Click(Sender:TObject);
    procedure SpeedButton2Click(Sender:TObject);
    procedure SpeedButton1Click(Sender:TObject);
    procedure FormShow(Sender:TObject);
    procedure FormClose(Sender:TObject;var Action:TCloseAction);
    Procedure DefaultOptions();
    procedure PostCheck();
    procedure SpeedButton4Click(Sender:TObject);
    procedure Button1Click(Sender:TObject);
    procedure getfileassociations();
    procedure getValueList();
    procedure putValueList();
    procedure valueset(Nam,Exts:JString);
    procedure Statusline(PC:TPageControl;var SB:TStatusBar;Tip:JString);
    procedure FormCreate(Sender:TObject);
  private
    //
  public
    //----------------------------------------------------------------------------
    //
    //----------------------------------------------------------------------------
    okpressed:boolean;
    Extname:JString;
  end;
  //----------------------------------------------------------------------------
  //
  //----------------------------------------------------------------------------
var
  Opt:TOptionDialog;
  //----------------------------------------------------------------------------
  //
  //----------------------------------------------------------------------------
implementation
{$R *.dfm}
uses
  //----------------------------------------------------------------------------
  //specific
  //----------------------------------------------------------------------------
  Messages,SysUtils,Variants,Graphics,ShellApi,ShlObj,
  DateUtils,StrUtils,ToolWin,Windows;
//-----------------------------------------------------------------
//Default input                                               -
//-----------------------------------------------------------------
function getdefaultfile(lang:Naturallanguages):JString;
var
  f,d:JString;
begin
  if lang=german then begin
    d:='Beispiele';
    f:=getcurrentdir+'\'+d+'\hallo.bat'
  end
  else begin
    d:='Samples';
    f:=getcurrentdir+'\'+d+'\hello.bat';
  end;
  getdefaultfile:=f;
end;
//-----------------------------------------------------------------
//Tabsheet visible?                                            -
//-----------------------------------------------------------------
procedure TOptionDialog.Statusline(PC:TPageControl;var SB:TStatusBar;
  Tip:JString);
var
  vissheet:TTabSheet;
  Fr:Frames;
  st,m,SN,TD,S,SI:JString;
begin
  SN:='';
  S:='';
  SI:='';
  Fr:=F1;
  vissheet:=PC.ActivePage;
  if vissheet=R.Navigator.Sheet then
    SN:=trans(lang,177,'Navigator')
  else if vissheet=R.Semantik.Sheet then
    SN:=trans(lang,178,'Semantik')
  else if vissheet=R.Explorer.Sheet then
    SN:=trans(lang,179,'Explorer')
  else if vissheet=R.Source.Sheet then
    SN:=trans(lang,180,'Quelle')
  else if vissheet=R.Cfa.Sheet then
    SN:=trans(lang,181,'Cfa')
  else if vissheet=R.Dfa.Sheet then
    SN:=trans(lang,182,'Dfa')
  else if vissheet=R.Measures.Sheet then
    SN:=trans(lang,183,'Maße')
  else if vissheet=R.Funktion.Sheet then
    SN:=trans(lang,184,'Funktion')
  else if vissheet=R.Miniatur.Sheet then
    SN:=trans(lang,185,'Miniatur')
  else if vissheet=R.Druckvorschau.Sheet then
    SN:=trans(lang,186,'Druckvorschau');
  if vissheet=R.Navigator.Sheet then
    Fr:=R.Navigator.Frame
  else if vissheet=R.Semantik.Sheet then
    Fr:=R.Semantik.Frame
  else if vissheet=R.Explorer.Sheet then
    Fr:=R.Explorer.Frame
  else if vissheet=R.Source.Sheet then
    Fr:=R.Source.Frame
  else if vissheet=R.Cfa.Sheet then
    Fr:=R.Cfa.Frame
  else if vissheet=R.Dfa.Sheet then
    Fr:=R.Dfa.Frame
  else if vissheet=R.Measures.Sheet then
    Fr:=R.Measures.Frame
  else if vissheet=R.Funktion.Sheet then
    Fr:=R.Funktion.Frame
  else if vissheet=R.Miniatur.Sheet then
    Fr:=R.Miniatur.Frame
  else if vissheet=R.Druckvorschau.Sheet then
    Fr:=R.Druckvorschau.Frame;
  if R.InspectorVisible and(Fr=F1) then
    SN:=SN+'+ '+trans(lang,187,'Inspektor');
  if R.Source.Sheet=vissheet then begin
    S:=SN;
    if st>'' then begin
      m:='['+st+']';
      S:=S+' '+m;
    end;
    SI:=SourceInfo;
  end
  else begin
    if InSight(R.Source) then
      S:=S+m+TD
    else
      S:=S+TD;
    S:=SN;
  end;
  if SI>'' then
    S:=S+SI;
  if Tip>'' then
    SB.SimpleText:=S+' '+Tip
  else
    SB.SimpleText:=S
end;
//-----------------------------------------------------------------
//-
//set Options                                                     -
//-
//-----------------------------------------------------------------
Procedure TOptionDialog.DefaultOptions();
var
  i:integer;
  FC:JString;
begin
  for i:=0 to maxoptsize do begin
    R.cc[i]:=chr(0);
  end;
  setl(R.HomeDir,ExtractFilePath(optionsfilename(Application.Title)));
  setl(R.ProgramDir,ExtractFilePath(ParamStr(0)));
  setl(R.RemoteDir,R.ProgramDir+RemoteDirectory);
  setl(R.ExecDir,R.ProgramDir+ExecDir);
  R.NextCheck:=incday(Now,LicenseCheckInterval);
  FC:=R.ProgramDir+'compilebatch.bat';
  if not FileExists(FC) then
    FC:='';
  setl(R.CommandFile,FC);
  setl(R.ExportDir,getcurrentdir);
  R.ExportEnabled:=false;
  R.casesensitive:=false;
  R.wordwrap:=false;
  R.regularexp:=false;
  //-----------------------------------------------------------------------------
  //Licensing  //
  //-----------------------------------------------------------------------------
  R.Activated:=false;
  R.FirstUse:=DateOf(Now);
  R.LastUse:=DateOf(Now);
  R.DaysEffectivlyUsed:=0;
  R.DaysUsed:=0;
  if DiskType<>DRIVE_REMOVABLE then
    setl(R.SecretKey,SetSecretRegistryValue(Installkey,0,Productnumber));
  if (Application.Title=Title_Columbo) then
    R.Edition:=Shareware
  else if (Application.Title=Title_Elbe) then
    R.Edition:=Shareware;
  //
  R.Language:=german;
  if FileExists(R.ProgramDir+'english.txt') then
    R.Language:=english;
  //
  R.inited:=' ';
  R.privileged:=' ';
  R.BackgroundColor:=clWhite;
  R.ButtonSize:=5;
  R.FontName:='Courier New';
  R.FontSize:=9;
  R.Drawgrid:=false;
  R.Openindex:=-1;
  R.indentchars:=2;
  R.artificiallines:=false;
  if screen.Width>(3*screen.Height)div 2 then begin
    R.Width:=11*screen.Width div 32;
    R.Height:=3*screen.Height div 4;
  end
  else begin
    R.Width:=21*screen.Width div 32;
    R.Height:=3*screen.Height div 4;
  end;
  R.Top:=(screen.Height)div 8;
  R.Left:=(screen.Width div 2)-(R.Width div 2);
  R.ismax:=false;
  //DefaultFrames;
  R.Frame1Page1Max:=false;
  R.Frame1Page2Max:=false;
  R.Frame2Page1Max:=false;
  R.Frame3Page1Max:=false;
  //source options
  R.SyntaxHighlight:=true;
  R.SyntaxBold:=false;
  R.ShowSpaces:=false;
  R.ShowURL:=true;
  R.Columnumbers:=false;
  R.Linenumbers:=false;
  R.Blocknumbers:=false;
  R.Sourceformat:=FixedFormat;
  //
  R.Highlites[H_keyword]:=clblue;
  R.Highlites[H_String]:=clred;
  R.Highlites[H_Numeric]:=clMaroon;
  R.Highlites[H_Identifier]:=clblack;
  R.Highlites[H_Foreignkeyword]:=clNavy;
  R.Highlites[H_Comment]:=clgreen;
  R.Highlites[H_Foreignidentifier]:=clgray;
  R.Highlites[H_Label]:=clPurple;
  R.Highlites[H_Lexelem]:=clFuchsia;
  //
  R.Coldefine:=false;
  R.InternetAllowed:=false;
  //search
  for i:=1 to length(R.SearchString) do begin
    R.SearchString[i].S:='';
    R.SearchString[i].Regular:=false;
    R.ReplaceString[i].S:='';
    R.ReplaceString[i].Regular:=false;
  end;
  //input files
  R.LastFilter:='.cob';
  if R.Language=english then
    setl(R.Libraries[1],R.ProgramDir+'Samples\'+CopyLib)
  else
    setl(R.Libraries[1],R.ProgramDir+'Beispiele\'+CopyLib);
  for i:=2 to 3 do
    R.Libraries[i]:='';
  for i:=1 to histmax do
    with R.History[i] do begin
      FileName:='';
      Count:=0;
      DateTime:=Now;
      Per[F1].ActiveView:=ViewNav;
      Per[F2].ActiveView:=ViewSource;
      Per[F3].ActiveView:=NoView;
    end;
  for i:=1 to length(R.FillUp) do
    R.FillUp[i]:=Random;
  setl(R.Infile,getdefaultfile(R.Language));
  setl(R.WindowsProductId,GetWinProductId);
  R.FuncHelp:=Key_F1;
  R.FuncSearch:=Key_F3;
  R.FuncReplace:=Key_F4;
  R.FuncContReplace:=Key_F5;
  R.FuncHelp:=Key_F1;
  R.Frame1Width:=R.Width div 4;
  R.ThumbnailWidth:=R.Width div 4;
  R.Frame3Height:=R.Height div 3;
  R.Inspectorheight:=(R.Height-Borderwidth)div 3;
  R.InspectorVisible:=true;
  R.LineThickness:=1;
  R.endofopts:=true;
  R.Navigator.Frame:=F1;
  R.Semantik.Frame:=F1;
  R.Explorer.Frame:=F1;
  R.Source.Frame:=F2;
  R.Cfa.Frame:=F2;
  R.Dfa.Frame:=F2;
  R.Measures.Frame:=F2;
  R.Funktion.Frame:=F2;
  R.Miniatur.Frame:=F3;
  R.Druckvorschau.Frame:=F3;
  R.Createbackup:=false;
  R.Timeout:=10;
  R.Timeper1000forProcessing:=0;
  R.Timeper1000forFrame1:=0;
  R.Timeper1000forFrame2:=0;
  R.Timeper10forSearch:=0;
  R.Timeper10forReplace:=0;
  //now generate check sums
  if length(Extensions)>0 then begin
    SplashForm1.init(12);
    R.CobolDllLen:=getFileLength(Extensions[1].dllname+dlle);
    R.CobolDllSum:=getFileSum(Extensions[1].dllname+dlle);
    SplashForm1.Progress(4);
    R.ColumboLen:=getFileLength(ColumboFileName);
    R.ColumboSum:=getFileSum(ColumboFileName);
    SplashForm1.Progress(8);
    R.ColumboDate:=getFileAge(ColumboFileName);
  end;
end;
//------------------------------------------------------------------------------
//externalcode from delphi.about.com    -- Windows Code !!
//------------------------------------------------------------------------------
function BrowseDialogCallBack(Wnd:HWND;uMsg:UINT;
  lParam,lpData:lParam):integer stdcall;
var
  wa,rect:TRect;
  dialogPT:TPoint;
begin
  //center in work area
  if uMsg=BFFM_INITIALIZED then begin
    wa:=screen.WorkAreaRect;
    GetWindowRect(Wnd,rect);
    dialogPT.x:=((wa.Right-wa.Left)div 2)-((rect.Right-rect.Left)div 2);
    dialogPT.y:=((wa.Bottom-wa.Top)div 2)-((rect.Bottom-rect.Top)div 2);
    MoveWindow(Wnd,dialogPT.x,dialogPT.y,rect.Right-rect.Left,
      rect.Bottom-rect.Top,true);
    if StartFolder<>'' then
      SendMessage(Wnd,BFFM_SETSELECTION,1,integer(@StartFolder[1]));
  end;
  Result:=0;
end;
//------------------------------------------------------------------------------
//externalcode from delphi.about.com   -- Windows Code !!
//------------------------------------------------------------------------------
function BrowseDialog(const Title:JString;const Flag:integer):JString;
var
  lpItemID:PItemIDList;
  BrowseInfo:TBrowseInfo;
  DisplayName: array [0..MAX_PATH] of char;
  TempPath: array [0..MAX_PATH] of char;
begin
  Result:='';
  FillChar(BrowseInfo,sizeof(TBrowseInfo),#0);
  with BrowseInfo do begin
    hwndOwner:=Application.Handle;
    pszDisplayName:=@DisplayName;
    lpszTitle:=PChar(Title);
    ulFlags:=Flag;
    lpfn:=BrowseDialogCallBack;
  end;
  lpItemID:=SHBrowseForFolder(BrowseInfo);
  if lpItemID<>nil then begin
    SHGetPathFromIDList(lpItemID,TempPath);
    Result:=TempPath;
    GlobalFreePtr(lpItemID);
  end;
end;
//----------------------------------------------------------------------------
//
//----------------------------------------------------------------------------
procedure TOptionDialog.Button1Click(Sender:TObject);
begin
  okpressed:=true;
end;
//----------------------------------------------------------------------------
//
//----------------------------------------------------------------------------
procedure TOptionDialog.FormClose(Sender:TObject;var Action:TCloseAction);
begin
  if okpressed then begin
    if ComboBox3.ItemIndex>=0 then
      R.FuncHelp:=Key_F1+ComboBox3.ItemIndex;
    if ComboBox4.ItemIndex>=0 then
      R.FuncSearch:=Key_F1+ComboBox4.ItemIndex;
    if ComboBox5.ItemIndex>=0 then
      R.FuncReplace:=Key_F1+ComboBox5.ItemIndex;
    if ComboBox6.ItemIndex>=0 then
      R.FuncContReplace:=Key_F1+ComboBox6.ItemIndex;
    if (Edit1.Text<>'')and(Edit1.Text[length(Edit1.Text)]<>'\') then
      Edit1.Text:=Edit1.Text+'\';
    if (Edit2.Text<>'')and(Edit2.Text[length(Edit2.Text)]<>'\') then
      Edit2.Text:=Edit2.Text+'\';
    if (Edit3.Text<>'')and(Edit3.Text[length(Edit3.Text)]<>'\') then
      Edit3.Text:=Edit3.Text+'\';
    R.Createbackup:=ComboBox1.ItemIndex=0;
    TryStrToInt(Edit5.Text,R.Timeout);
    TryStrToInt(Indentchars.Text,R.indentchars);
    setl(R.Libraries[1],Edit1.Text);
    setl(R.Libraries[2],Edit2.Text);
    setl(R.Libraries[3],Edit3.Text);
    setl(R.CommandFile,Edit4.Text);
    R.Sourceformat:=SourceFormats(ComboBox2.ItemIndex);
    R.LineThickness:=ComboBox7.ItemIndex+1;
    R.Drawgrid:=ComboBox8.ItemIndex=1;
    if ComboBox9.ItemIndex=0 then
      R.SyntaxHighlight:=false
    else
      R.SyntaxHighlight:=true;
    if ComboBox9.ItemIndex=2 then
      R.SyntaxBold:=true
    else
      R.SyntaxBold:=false;
  end;
  R.ShowURL:=ComboBox10.ItemIndex=1;
  R.wordwrap:=ComboBox11.ItemIndex=1;
  R.artificiallines:=ComboBox12.ItemIndex=1;
  putValueList();
end;
//----------------------------------------------------------------------------
//
//----------------------------------------------------------------------------
procedure TOptionDialog.FormCreate(Sender:TObject);
var
  optfilename:JString;
  function m(n:real):JString;
  begin
    m:=midstr(inttostr(round(n)),2,10);
  end;
begin
  inherited;
  optfilename:=PChar(optionsfilename(Application.Title));
  screen.Cursor:=crHourGlass;
  dostop:=false;
  dogetlicense:=false;
  if not FileExists(optfilename) then begin
    if FileExists(ExtractFilePath(ParamStr(0))+'english.txt') then
      lang:=english
    else
      lang:=german;
    SplashForm1.setInfo(trans(lang,138,'erster Start'));
    //first start
    CreateDir(ExtractFilePath(optfilename));
    //errorn(56,'Setze Default');
    screen.Cursor:=crHourGlass;
    DefaultOptions();
    SetSecrets(Installkey,0,Productnumber);
    R.inited:='J';
    DeleteFile(PChar(optfilename));
    PutOptions(PChar(optfilename));
  end;
  if OptLen>maxoptsize then begin
    errorn(57,'Lizenz abgelaufen');
    dogetlicense:=true;
  end;
  GetOptions(PChar(optfilename));
end;
//----------------------------------------------------------------------------
//
//----------------------------------------------------------------------------
procedure TOptionDialog.PostCheck();
var
  DT:Cardinal;
  CD:JString;
  DI:JString;
begin
  //--------------------------------------------------
  //now update registry entry from Tarma
  //--------------------------------------------------
  if (not R.Activated) then
    if not setDaysUsed(Installkey,R.SecretKey,Productnumber) then
      dogetlicense:=true;
  setl(R.ProgramDir,ExtractFilePath(ParamStr(0)));
  //--------------------------------------------------
  //some checks
  //--------------------------------------------------
  CD:=getcurrentdir();
  DT:=getDiskType(CD);
  DI:=GetWinProductId;
  if (DT=DRIVE_REMOVABLE)and(R.WindowsProductId<>DI) then begin
    errorn(58,'Lizenz abgelaufen');//changed by Installation?
    dogetlicense:=true;
  end;
end;
//----------------------------------------------------------------------------
//
//----------------------------------------------------------------------------
procedure TOptionDialog.FormShow(Sender:TObject);
var
  f:integer;
begin
  //COBOL dialects
  ComboBox2.Items.Clear;
  ComboBox2.Items.add(trans(lang,193,'IBM zOS Freiformat'));
  ComboBox2.Items.add(trans(lang,194,'IBM zOS Fixformat'));
  ComboBox2.Items.add(trans(lang,195,'Fujitsu Freiformat'));
  ComboBox2.Items.add(trans(lang,196,'Fujitsu Fixformat'));
  //hilite types
  ComboBox8.Items.Clear;
  ComboBox8.Items.add(trans(lang,240,'kein Gitternetz'));
  ComboBox8.Items.add(trans(lang,241,'zeige Gitternetz'));
  //hilite types
  ComboBox9.Items.Clear;
  ComboBox9.Items.add(trans(lang,197,'keine'));
  ComboBox9.Items.add(trans(lang,198,'farbig'));
  ComboBox9.Items.add(trans(lang,199,'schwarzweiß'));
  //
  f:=R.FuncHelp-Key_F1;
  ComboBox3.Text:=ComboBox3.Items[f];
  f:=R.FuncSearch-Key_F1;
  ComboBox4.Text:=ComboBox4.Items[f];
  f:=R.FuncReplace-Key_F1;
  ComboBox5.Text:=ComboBox5.Items[f];
  f:=R.FuncContReplace-Key_F1;
  ComboBox6.Text:=ComboBox6.Items[f];
  Edit1.Text:=R.Libraries[1];
  Edit2.Text:=R.Libraries[2];
  Edit3.Text:=R.Libraries[3];
  Edit4.Text:=R.CommandFile;
  Edit5.Text:=inttostr(R.Timeout);
  ComboBox2.ItemIndex:=ord(R.Sourceformat);
  if R.LineThickness=1 then
    ComboBox7.ItemIndex:=0
  else
    ComboBox7.ItemIndex:=1;
  if R.Drawgrid then
    ComboBox8.ItemIndex:=1
  else
    ComboBox8.ItemIndex:=0;
  if not R.SyntaxHighlight then
    ComboBox9.ItemIndex:=0
  else if not R.SyntaxBold then
    ComboBox9.ItemIndex:=1
  else
    ComboBox9.ItemIndex:=2;
  ComboBox2.Text:=ComboBox2.Items[ComboBox2.ItemIndex];
  ComboBox7.Text:=ComboBox7.Items[ComboBox7.ItemIndex];
  ComboBox8.Text:=ComboBox8.Items[ComboBox8.ItemIndex];
  ComboBox9.Text:=ComboBox9.Items[ComboBox9.ItemIndex];
  ComboBox1.ItemIndex:=0;
  if not R.Createbackup then
    ComboBox1.ItemIndex:=1;
  OpenDialog1.Options:=[ofReadOnly,ofPathMustExist];
  okpressed:=false;
  //show+hide URLS
  Label15.Caption:=trans(lang,228,'URLs');
  with ComboBox10 do begin
    Items.Clear;
    Items.add(trans(lang,189,'nicht zeigen'));
    Items.add(trans(lang,190,'unterstreichen'));
    if R.ShowURL then
      Text:=Items[1]
    else
      Text:=Items[0];
  end;
  //show+hide URLS
  Label16.Caption:=trans(lang,234,'Zeilenumbruch');
  Label17.Caption:=trans(lang,238,'Einrückung');
  Label18.Caption:=trans(lang,239,'Zwischenzeilen');
  with ComboBox11 do begin
    Items.Clear;
    Items.add(trans(lang,236,'nein'));
    Items.add(trans(lang,235,'ja'));
    if R.wordwrap then
      Text:=Items[1]
    else
      Text:=Items[0];
  end;
  with ComboBox12 do begin
    Items.Clear;
    Items.add(trans(lang,236,'nein'));
    Items.add(trans(lang,235,'ja'));
    if R.artificiallines then
      Text:=Items[1]
    else
      Text:=Items[0];
  end;
end;
//----------------------------------------------------------------------------
//
//Schweinerei von MS: die erste/zweite Zeile gibt es schon
//
//----------------------------------------------------------------------------
procedure TOptionDialog.valueset(Nam,Exts:JString);
var
  i,j:integer;
  extbuf: array of LangType;
begin
  i:=0;
  //find in table
  if Nam>'' then
    for j:=0 to length(Extensions)-1 do begin
      if (i>0)and(Extensions[j].dllname=Nam) then
        errorn(161,'Fehler in den Dateizuordnungen');
      if Extensions[j].dllname=Nam then
        i:=j;
    end;
  //into list editor
  if (i=0)and(ValueList.Keys[1]='') then begin
    ValueList.Keys[1]:=Nam;
    ValueList.cells[2,1]:=Exts;
  end
  else if (i=0)and(ValueList.Keys[1]<>'') then begin
    i:=length(Extensions)+1;
    setlength(extbuf,i);
    for j:=0 to length(Extensions)-1 do
      extbuf[j]:=Extensions[j];
    setlength(Extensions,i);
    for j:=0 to length(Extensions)-1 do
      Extensions[j]:=extbuf[j];
    ValueList.InsertRow(Nam,Exts,true);
    i:=i-1
  end
  else
    ValueList.InsertRow(Nam,Exts,true);
  //into internal file
  Extensions[i].dllname:=Nam;
  Extensions[i].ext:=Exts;
end;
//----------------------------------------------------------------------------
//
//----------------------------------------------------------------------------
procedure TOptionDialog.getValueList();
var
  Fil1:textfile;
  i:integer;
  Exts:JString;
  Nam:JString;
  notfound:boolean;
  Inp:JString;
  //Schweinerei von MS: die erste/zweite Zeile läßt sich nicht löschen
  procedure clearvalues();
  var
    i:integer;
  begin
    //clear value editor
    i:=ValueList.RowCount;
    while (i>2) do begin
      ValueList.DeleteRow(ValueList.RowCount-1);
      i:=ValueList.RowCount;
    end;
  end;
begin
  Extname:=R.HomeDir+extensionfile;
  clearvalues();
  ValueList.ColCount:=2;
  if not FileExists(Extname) then
    notfound:=true
  else begin
    AssignFile(Fil1,Extname);
    Reset(Fil1);
    notfound:=false;
    while not eof(Fil1) do begin
      readln(Fil1,Inp);
      Nam:='';
      i:=1;
      while (i<length(Inp))and(Inp[i]<>';') do begin
        Nam:=Nam+Inp[i];
        i:=i+1;
      end;
      Exts:='';
      if i<length(Inp) then
        i:=i+1;
      while (i<=length(Inp)) do begin
        Exts:=Exts+Inp[i];
        i:=i+1
      end;
      valueset(Nam,Exts);
    end;
    CloseFile(Fil1);
  end;
  //ignore first, header
  if notfound then begin
    clearvalues();
    for i:=0 to length(Extensions)-1 do begin
      Nam:=Extensions[i].dllname;
      Exts:=Extensions[i].ext;
      valueset(Nam,Exts);
    end;
  end;
end;
//----------------------------------------------------------------------------
//
//----------------------------------------------------------------------------
procedure TOptionDialog.putValueList();
var
  Fil1:textfile;
  i,ll,ll2:integer;
  changed:boolean;
  Exts,Nam:JString;
begin
  ll:=length(Extensions);
  ll2:=ValueList.RowCount;
  changed:=ll<>ValueList.RowCount;
  for i:=0 to Math.min(ll2-2,ll-2) do begin
    Exts:=ValueList.cells[2,i+1];
    changed:=changed or(Exts<>Extensions[i].ext);
  end;
  if changed then begin
    Extname:=R.HomeDir+extensionfile;
    AssignFile(Fil1,Extname);
    Rewrite(Fil1);
    i:=1;
    while i<ValueList.RowCount do begin
      Nam:=ValueList.Keys[i];
      Exts:=ValueList.cells[2,i];
      writeln(Fil1,Nam,';',Exts);
      i:=i+1;
    end;
    CloseFile(Fil1);
  end;
end;
//------------------------------------------------------------------
//--
//show associations in Options                                 --
//--
//------------------------------------------------------------------
procedure TOptionDialog.getfileassociations();
var
  i,sp:integer;
  tl:TListItem;
  ex,elm,p:JString;
begin
  with Extlist do begin
    Items.Clear;
    for i:=0 to length(Extensions)-1 do begin
      tl:=Items.add();
      tl.Caption:=Extensions[i].ext;
      ex:=midstr(Extensions[i].ext,2,length(Extensions[i].ext));
      if pos(';',ex)<=0 then
        p:=readfiletype(ex)
      else begin
        p:='';
        while pos(';',ex)>0 do begin
          sp:=pos(';',ex);
          elm:=midstr(ex,1,sp-1);
          if p>'' then
            p:=p+',';
          p:=p+readfiletype(elm);
          ex:=midstr(ex,sp+1,length(ex));
        end;
      end;
      tl.SubItems.add(p);
    end;
  end;
end;
//----------------------------------------------------------------------------
//
//----------------------------------------------------------------------------
procedure TOptionDialog.ListBox1Click(Sender:TObject);
begin
  if ComboBox7.ItemIndex=0 then
    R.LineThickness:=1
  else if ComboBox7.ItemIndex=1 then
    R.LineThickness:=2
end;
//----------------------------------------------------------------------------
//
//----------------------------------------------------------------------------
procedure TOptionDialog.SpeedButton1Click(Sender:TObject);
var
  sTitle,sFolder:JString;
  iFlag:integer;
begin
  sTitle:=trans(lang,191,'Verzeichnis auswählen');
  iFlag:=BIF_RETURNONLYFSDIRS;
  if Edit1.Text<>'' then
    StartFolder:=Edit1.Text;
  if StartFolder='' then
    StartFolder:=ExtractFilePath(R.Infile);
  sFolder:=BrowseDialog(sTitle,iFlag);
  if sFolder<>'' then
    Edit1.Text:=sFolder+'\';
end;
//----------------------------------------------------------------------------
//
//----------------------------------------------------------------------------
procedure TOptionDialog.SpeedButton2Click(Sender:TObject);
var
  sTitle,sFolder:JString;
  iFlag:integer;
begin
  sTitle:=trans(lang,191,'Verzeichnis auswählen');
  iFlag:=BIF_RETURNONLYFSDIRS;
  if Edit2.Text<>'' then
    StartFolder:=Edit2.Text;
  if StartFolder='' then
    StartFolder:=ExtractFilePath(R.Infile);
  sFolder:=BrowseDialog(sTitle,iFlag);
  if sFolder<>'' then
    Edit2.Text:=sFolder+'\';
end;
//----------------------------------------------------------------------------
//
//----------------------------------------------------------------------------
procedure TOptionDialog.SpeedButton3Click(Sender:TObject);
var
  sTitle,sFolder:JString;
  iFlag:integer;
begin
  sTitle:=trans(lang,191,'Verzeichnis auswählen');
  iFlag:=BIF_RETURNONLYFSDIRS;
  if Edit3.Text<>'' then
    StartFolder:=Edit3.Text;
  if StartFolder='' then
    StartFolder:=ExtractFilePath(R.Infile);
  sFolder:=BrowseDialog(sTitle,iFlag);
  if sFolder<>'' then
    Edit3.Text:=sFolder+'\';
end;
//----------------------------------------------------------------------------
//
//----------------------------------------------------------------------------
procedure TOptionDialog.SpeedButton4Click(Sender:TObject);
begin
  if R.CommandFile>'' then
    OpenDialog1.InitialDir:=ExtractFilePath(R.CommandFile)
  else
    OpenDialog1.InitialDir:=ExtractFilePath(R.Infile);
  OpenDialog1.Options:=[ofReadOnly,ofFileMustExist];
  OpenDialog1.Filter:=trans(lang,192,
    'Kommandodateien (*.bat;*.cmd)|*.bat;*.cmd');
  OpenDialog1.FilterIndex:=0;
  if OpenDialog1.Execute then begin
    setl(R.CommandFile,OpenDialog1.FileName);
    Edit4.Text:=R.CommandFile;
  end;
end;
//------------------------------------------------------------------
//
//Ende dieser Quelle                                           --
//
//------------------------------------------------------------------
end.

¤ Dauer der Verarbeitung: 0.25 Sekunden (vorverarbeitet) ¤

Download des Quellennavigators
Download des sprechenden Kalenders
in der Quellcodebibliothek suchen

Haftungshinweis

Die Informationen auf dieser Webseite wurden nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit, noch Qualität der bereit gestellten Informationen zugesichert.

Bemerkung:

Die farbliche Syntaxdarstellung ist noch experimentell.