rieditu1.pas

条码控件： 一维条码控件 二维条码控件 PDF417Barcode MaxiCodeBarcode

(* ***** BEGIN LICENSE BLOCK *****
 * Version: MPL 1.1
 *
 * 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/
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
 * for the specific language governing rights and limitations under the
 * License.
 *
 * The Original Code is TurboPower SysTools
 *
 * The Initial Developer of the Original Code is
 * TurboPower Software
 *
 * Portions created by the Initial Developer are Copyright (C) 1996-2002
 * the Initial Developer. All Rights Reserved.
 *
 * Contributor(s):
 *
 * ***** END LICENSE BLOCK ***** *)

unit RIEditU1;

interface

uses
  Windows,
  Messages,
  Graphics,
  Classes,
  SysUtils,
  Dialogs,
  Controls,
  Forms,
  StdCtrls,
  Outline,
  ExtCtrls,
  Buttons,
  Menus,
  Grids,

{$IFOPT H+}
  STStrL,
{$ELSE}
  STStrS,
{$ENDIF}
  STConst,
  STBase;

type
  TForm1 = class(TForm)
    Outline1: TOutline;
    Panel1: TPanel;
    IniFileCB: TCheckBox;
    Label1: TLabel;
    Edit1: TEdit;
    CancelBtn: TBitBtn;
    BrowseBtn: TButton;
    OpenDialog1: TOpenDialog;
    LoadBtn: TButton;
    PopupMenu1: TPopupMenu;
    DeleteAKey: TMenuItem;
    AddKey: TMenuItem;
    AddValue: TMenuItem;
    ListBox1: TListBox;
    N1: TMenuItem;
    ListBoxMenu: TPopupMenu;
    ModifyValue: TMenuItem;
    RenameValue: TMenuItem;
    DeleteValue: TMenuItem;
    N2: TMenuItem;
    AddItem: TMenuItem;
    procedure CancelBtnClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure BrowseBtnClick(Sender: TObject);
    procedure IniFileCBClick(Sender: TObject);
    procedure LoadBtnClick(Sender: TObject);
    procedure DeleteAKeyClick(Sender: TObject);
    procedure AddKeyClick(Sender: TObject);
    procedure AddValueClick(Sender: TObject);
    procedure Outline1Expand(Sender: TObject; Index: Longint);
    procedure Outline1Click(Sender: TObject);
    procedure ListBox1DrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure FormActivate(Sender: TObject);
    procedure Outline1Collapse(Sender: TObject; Index: Longint);
    procedure Outline1DblClick(Sender: TObject);
    procedure DeleteValueClick(Sender: TObject);
    procedure RenameValueClick(Sender: TObject);
    procedure ModifyValueClick(Sender: TObject);
    procedure ListBox1DblClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }

    procedure SetBusy(Busy : Boolean);

    procedure FillListBox;

    procedure LoadIniFileData;
    procedure LoadRegistryData;

    procedure GetIniSectionName(var SN : string; var Index : integer);

    procedure ModifyIniItem(IniItem : string);
    procedure ModifyRegItem(RegItem : string; ModifyValue : Boolean);

    procedure RenameIniItem(IniItem : string);
    procedure RenameRegItem(RegItem : string);
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

uses
  STDate,
  STDateSt,
  STRegIni,
  RIEditU2;

var
  TC : TStRegIni;

procedure TForm1.CancelBtnClick(Sender: TObject);
begin
  Close;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  ListBox1.Clear;
  Outline1.Clear;

{DO NOT ERASE THE FOLLOWING SECITON - FOR INI STARTUP}
  IniFileCB.Checked := True;
{End of Section}

{DO NOT ERASE THE FOLLOWING SECITON - FOR REG STARTUP}
{
  IniFileCB.Checked := False;
  Edit1.Text := 'HKEY_CLASSES_ROOT';
  TC := TStRegIni.Create(Edit1.Text, False);
  TC.CurSubKey := '';
}
{End of Seciton}

  BrowseBtn.Enabled := IniFileCB.Checked;
  Edit1.Enabled := IniFileCB.Checked;
  Edit1.ReadOnly := NOT IniFileCB.Checked;

  if Assigned(TC) and not TC.IsIniFile then
    LoadRegistryData;
end;


procedure TForm1.SetBusy(Busy : Boolean);
begin
  if Busy then
    Screen.Cursor := crHourGlass
  else
    Screen.Cursor := crDefault;
end;


procedure TForm1.FillListBox;
begin
  ListBox1.Clear;
  ListBox1.Perform(WM_SetRedraw,0,0);
  try
    TC.GetValues(ListBox1.Items);
  finally
    ListBox1.Perform(WM_SetRedraw,1,0);
    ListBox1.Update;
  end;
end;


procedure TForm1.LoadIniFileData;
var
  I  : Integer;
  S  : string;
  SKList   : TStringList;

begin
  SetBusy(True);

  Outline1.Clear;
  TC.CurSubKey := '';
  SKList := TStringList.Create;
  try
    S := Edit1.Text;
    I := pos('.',S);
    if (I > 0) then
      Delete(S,I,Length(S)-I+1);
    I := Length(S);
    while S[I] <> '\' do
      Dec(I);
    Delete(S,1,I);

    Outline1.Add(0,S);
    TC.GetSubKeys(SKList);
    if (SKList.Count > 0) then
    begin
      for I := 0 to SKList.Count-1 do
      begin
        with Outline1 do
        begin
          AddChild(1,SKList[I]);

          SelectedItem := GetTextItem(SKList[I]);
          Items[SelectedItem].Expanded := False;
        end;
      end;
      TC.CurSubKey := SKList[0];
    end;
  finally
    SKList.Free;

    Outline1.SelectedItem := 1;
    Outline1.Refresh;

    SetBusy(False);
  end;
end;

procedure TForm1.Outline1Click(Sender: TObject);
var
  S  : string;
  I  : Integer;

begin
  if NOT (TC.IsIniFile) then
  begin
    S := Outline1.Items[Outline1.SelectedItem].FullPath;
    I := pos('=',S);
    if I > 0 then
      Delete(S,I,Length(S)-I+1);
    Edit1.Text := S;
  end;
end;


procedure TForm1.Outline1Expand(Sender: TObject; Index: Longint);
var
  Idx, I, J : integer;

  PriKey,
  S,
  HldSK,
  SelStr  : string;

  SK      : TStringList;

begin
  if (TC.IsIniFile) then
  begin
    with Outline1 do
    begin
      if SelectedItem < 2 then
        Exit
      else begin
        S := Items[Outline1.SelectedItem].Text;
        TC.CurSubKey := S;
        FillListBox;
      end;
    end;
    Exit;
  end;

  ListBox1.Clear;
  SetBusy(True);
  HldSK := TC.CurSubKey;
  with Outline1 do
  begin
    SelStr := Items[Index].FullPath;
    if pos('HKEY_LOCAL_MACHINE',SelStr) > 0 then
      PriKey := RIMachine
    else if pos('HKEY_USERS',SelStr) > 0 then
      PriKey := RIUsers
    else if pos('HKEY_CURRENT_USER',SelStr) > 0 then
      PriKey := RICUser
    else if pos('HKEY_CLASSES_ROOT',SelStr) > 0 then
      PriKey := RIRoot;
    TC.SetPrimary(PriKey);

    I := pos('\',SelStr);
    if (I = 0) then begin
      Edit1.Text := SelStr;
      SetBusy(False);
    end else
    begin
      SK := TStringList.Create;
      try
        System.Delete(SelStr,1,I);
        TC.CurSubKey := SelStr;

        FillListBox;
        if NOT (Items[Index].HasItems) then
        begin
          TC.GetSubKeys(SK);
          for J := 0 to SK.Count-1 do
            AddChild(Index,SK[J]);
        end else
        begin
          Idx := Items[Index].GetFirstChild;
          while (Idx <> -1) do
          begin
            SelStr := Items[Idx].FullPath;
            System.Delete(SelStr,1,pos('\',SelStr));
            TC.CurSubKey := SelStr;
            if NOT (Items[Idx].HasItems) then
            begin
              TC.GetSubKeys(SK);
              for J := 0 to SK.Count-1 do
                AddChild(Idx,SK[J]);
            end;
            SK.Clear;
            Idx := Items[Index].GetNextChild(Idx);
          end;
        end;
      finally
        SK.Free;
        TC.CurSubKey := HldSK;
        SetBusy(False);
      end;
    end;
  end;
  Outline1.Refresh;
end;


procedure TForm1.LoadRegistryData;
var
  Idx,
  I, J, K  : Integer;

  TheKey,
  PriKey   : string;

  ISKList,
  SKList   : TStringList;

begin
  if not Assigned(TC) then
    Exit;

  SetBusy(True);
  Outline1.Clear;
  SKList := TStringList.Create;
  try
    Edit1.Text := 'HKEY_CLASSES_ROOT';
    AddValue.Visible := True;
    RenameValue.Visible := True;
    DeleteValue.Visible := True;
    N2.Visible := True;

    for I := 1 to 4 do
    begin
      case I of
        1 : begin
              TheKey := 'HKEY_CLASSES_ROOT';
              PriKey := RIRoot;
            end;
        2 : begin
              TheKey := 'HKEY_CURRENT_USER';
              PriKey := RICUser;
            end;
        3 : begin
              TheKey := 'HKEY_LOCAL_MACHINE';
              PriKey := RIMachine;
            end;
        4 : begin
              TheKey := 'HKEY_USERS';
              PriKey := RIUsers;
            end;
      end;
      SKList.Clear;

      Outline1.Add(0,TheKey);

      TC.CurSubKey := '';
      TC.SetPrimary(PriKey);
      TC.GetSubKeys(SKList);

      with Outline1 do
      begin
        SelectedItem := GetTextItem(TheKey);
        for J := 0 to SKList.Count-1 do
        begin
          AddChild(SelectedItem,SKList[J]);
          Idx := Items[SelectedItem].GetLastChild;
          ISKList := TStringList.Create;
          try
            TC.CurSubKey := SKList[J];
            try
              TC.GetSubKeys(ISKList);
              if (ISKList.Count > 0) then
                for K := 0 to ISKList.Count-1 do
                  AddChild(Idx,ISKList[K]);
            except
              {In some cases, WinNT in particularl, GetSubKeys raises an
               exception because it tries to access a key to which *no one* has
               access. Here we throw away the exception so the outline can
               continue being filled}
            end;
          finally
            ISKList.Free;
          end;
        end;
        Items[SelectedItem].Expanded := False;
      end;
    end;
  finally
    SKList.Free;
    TC.CurSubKey := '';
    SetBusy(False);
    Outline1.SelectedItem := 1;
    Outline1.Refresh;
  end;
end;


procedure TForm1.GetIniSectionName(var SN : string; var Index : integer);
var
  p : integer;
  S : string;
begin
  with Outline1 do
  begin
    p := SelectedItem;
    S := Items[p].Text;

    while (p > 0) AND (pos('=',S) > 0) do
    begin
      S := Items[p].Text;
      if (pos('=',S) > 0) then
        Dec(p);
    end;
    SN := Items[p].Text;
    Index := p;
  end;
end;


procedure TForm1.BrowseBtnClick(Sender: TObject);
begin
  if (OpenDialog1.Execute) then
  begin
    Edit1.Text := OpenDialog1.FileName;
    TC.Free;
    TC := TStRegIni.Create(Edit1.Text,True);
    LoadIniFileData;
  end;
end;


procedure TForm1.IniFileCBClick(Sender: TObject);
begin
  Outline1.Clear;
  ListBox1.Clear;

  BrowseBtn.Enabled := IniFileCB.Checked;
  Edit1.Enabled := IniFileCB.Checked;
  Edit1.ReadOnly := NOT IniFileCB.Checked;

  if NOT IniFileCB.Checked then
  begin
    LoadBtn.Caption := '&Refresh';
    Edit1.Text := 'HKEY_CLASSES_ROOT';
    TC.Free;
    TC := TStRegIni.Create(Edit1.Text,False);
    TC.CurSubKey := '';
    LoadRegistryData;
  end else
  begin
    Edit1.Text := '';
    LoadBtn.Caption := 'Loa&d';
  end;
end;


procedure TForm1.LoadBtnClick(Sender: TObject);
begin
  ListBox1.Clear;
  if (IniFileCB.Checked) then
  begin
    if NOT FileExists(Edit1.Text) then Exit;
    TC.Free;
    TC := nil;
    TC := TStRegIni.Create(Edit1.Text,True);
    LoadIniFileData;
  end else
  begin
    TC.Free;
    TC := nil;
    TC := TStRegIni.Create(Edit1.Text,False);
    LoadRegistryData;
  end;
end;


procedure TForm1.DeleteAKeyClick(Sender: TObject);
var
  p,
  Idx     : Integer;
  SK      : string;

begin
  if Outline1.SelectedItem = 0 then
      Exit;
  Outline1.Perform(WM_SETREDRAW,0,0);
  try
    if (TC.IsIniFile) then
    begin
      GetIniSectionName(SK,Idx);
      TC.CurSubKey := SK;
    end else
    begin
      SK := Edit1.Text;
      p := pos('\',SK);
      if (p = 0) then
      begin
        ShowMessage('Can not delete primary key');
        Exit;
      end;
      Delete(SK,1,p);
      TC.CurSubKey := SK;
      Idx := Outline1.SelectedItem;
    end;
    TC.DeleteKey(SK,False);
    Outline1.Delete(Outline1.SelectedItem);

  finally