rieditu1.pas

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

    Outline1.Perform(WM_SETREDRAW,1,0);
    ListBox1.Clear;
    Outline1.Refresh;
  end;
end;


procedure TForm1.AddKeyClick(Sender: TObject);
var
  SK,
  NewName : string;
begin
  NewName := '';
  if InputQuery('New Name','',NewName) then
  begin
    Outline1.Perform(WM_SETREDRAW,0,0);
    try
      if (TC.IsIniFile) then
      begin
        TC.CreateKey(NewName);
        TC.CurSubKey := NewName;
        with Outline1 do
        begin
          Add(0,NewName);
          SelectedItem := GetTextItem(NewName);
        end;
      end else
      begin
        with Outline1 do
        begin
          TC.CurSubKey := '';
          SK := Items[SelectedItem].FullPath + '\' + NewName;
          System.Delete(SK,1,pos('\',SK));
          TC.CreateKey(SK);
          AddChild(SelectedItem,NewName);
        end;
      end;
    finally
      Outline1.Perform(WM_SETREDRAW,1,0);
      Outline1.Refresh;
    end;
  end;
end;


procedure TForm1.AddValueClick(Sender: TObject);
var
  len,
  Code,
  SectionIndex : integer;
  SValue,
  NewName      : string;
  SectionName  : string;
  TmpVal       : array[1..127] of byte;
  ADate        : TStDate;
  ATime        : TStTime;
  AFloat       : Double;
  ALongInt     : LongInt;

begin
  DataDlg.ValueName.Text := '';
  DataDlg.IData.Text := '';
  DataDlg.EditingState := etAll;

  if (DataDlg.ShowModal = mrOK) then
  begin
    Outline1.Perform(WM_SETREDRAW,0,0);
    try
      NewName := DataDlg.ValueName.Text;
      SValue := DataDlg.IData.Text;

      if (TC.IsIniFile) then
      begin
        GetIniSectionName(SectionName,SectionIndex);
        TC.CurSubKey := SectionName;
      end else
      begin
        SectionName := Edit1.Text;
        Delete(SectionName,1,pos('\',SectionName));
        TC.CurSubKey := SectionName;
        SectionIndex := Outline1.SelectedItem;
      end;

      case DataDlg.DataTypeRG.ItemIndex of
        0 : begin
              len := Length(SValue);
              if ((len mod 2) <> 0) then
              begin
                if (len > 2) then
                begin
                  Delete(SValue,len,1);
                  Dec(len);
                end else
                begin
                  SValue := '00';
                  len := 2;
                end;
                ShowMessage('String was adjusted to even number of characters');
              end;
              if (TC.StringToBytes(SValue, TmpVal, len div 2)) then
                TC.WriteBinaryData(NewName, TmpVal,len div 2)
              else
                ShowMessage('Error converting string to Byte array');
            end;
        1 : begin
              if (CompareText(SValue,LoadStr(stscTrueString)) = 0) then
              begin
                TC.WriteBoolean(NewName,True);
                SValue := LoadStr(stscTrueString);
              end else
              begin
                TC.WriteBoolean(NewName,False);
                SValue := LoadStr(stscFalseString);
              end;
            end;
        2 : begin
              ADate := DateStringToStDate(InternationalDate(False),SValue, 1950);
              if (ADate <> BadDate) then
                TC.WriteDate(NewName,ADate)
              else
                ShowMessage('Invalid date or string did not match Windows short date mask');
            end;
        3 : begin
              Val(SValue,ALongInt,Code);
              if (Code = 0) then
                TC.WriteInteger(NewName,ALongInt)
              else
                ShowMessage('String could not be converted to a LongInt');
            end;
        4 : begin
              Val(SValue,AFloat,Code);
              if (Code = 0) then
                TC.WriteFloat(NewName,AFloat)
              else
                ShowMessage('String could not be converted to a Double');
            end;
        5 : begin
              TC.WriteString(NewName,DataDlg.IData.Text);
              SValue := DataDlg.IData.Text;
            end;
        6 : begin
              SectionName := InternationalTime(True);
              ATime := TimeStringToStTime(InternationalTime(True),SValue);
              if (ATime <> BadTime) then
                TC.WriteTime(NewName,ATime)
              else
                ShowMessage('Invalid time or string did not match Windows time mask');
            end;
      end;
    finally
      Outline1.Perform(WM_SETREDRAW,1,0);
      FilLListBox;
      Outline1.Refresh;
    end;
  end;
end;

procedure TForm1.DeleteValueClick(Sender: TObject);
var
  p,
  lbidx,
  len,
  Idx    : Integer;

  SK,
  VN     : string;
begin
  lbidx := ListBox1.ItemIndex;
  if (lbidx) < 0 then
  begin
    ShowMessage('No value selected');
    Exit;
  end;

  VN := ListBox1.Items[lbidx];
  p := pos('=',VN);
  len := Length(VN);
  System.Delete(VN,p,len-p+1);

  if (TC.IsIniFile) then
  begin
    GetIniSectionName(SK,Idx);
    TC.CurSubKey := SK;
  end else
  begin
    SK := Edit1.Text;
    Delete(SK,1,pos('\',SK));
    TC.CurSubKey := SK;
  end;
  TC.DeleteValue(VN);
  ListBox1.Items.Delete(lbidx);
end;


procedure TForm1.ListBox1DblClick(Sender: TObject);
begin
  ModifyValueClick(Sender);
end;


procedure TForm1.ModifyValueClick(Sender: TObject);
var
  Idx : Integer;
begin
  Idx := ListBox1.ItemIndex;
  if (Idx < 0) then
  begin
    ShowMessage('No value selected');
    Exit;
  end;

  if (TC.IsIniFile) then
    ModifyIniItem(ListBox1.Items[Idx])
  else
    ModifyRegItem(ListBox1.Items[Idx],True);
end;


procedure TForm1.ModifyIniItem(IniItem : string);
var
  p,
  len,
  SIndex  : integer;

  SName,
  NewVal,
  ValName : string;

begin
  p := pos('=',IniItem);
  len := Length(IniItem);

  ValName := IniItem;
  NewVal := IniItem;

  Delete(ValName,p,len-p+1);
  Delete(NewVal,1,p);

  with DataDlg do
  begin
    EditingState := etValue;
    ValueName.Text := ValName;
    IData.Text := NewVal;
    RGIdx := 5;
  end;

  if (DataDlg.ShowModal = mrOK) then
  begin
    NewVal := DataDlg.IData.Text;

    {test for empty value which would delete entry from section}
    if (Length(NewVal) = 0) then
      NewVal := ' ';

    GetIniSectionName(SName,SIndex);
    TC.CurSubKey := SName;

    try
      TC.WriteString(ValName,NewVal);
    finally
      FillListBox;
      DataDlg.EditingState := etAll;
    end;
  end else
    DataDlg.EditingState := etAll;
end;


procedure TForm1.ModifyRegItem(RegItem : string; ModifyValue : Boolean);
var
  p,
  len      : Integer;

  Size     : LongInt;

  DType    : DWORD;

  TDbl     : Double;
  BA       : array[1..127] of Byte;

  SKN,
  OldName,
  ValName,
  NewVal   : string;

begin
  p := pos('=',RegItem);
  ValName := RegItem;
  Delete(ValName,p,Length(ValName)-p+1);
  OldName := ValName;

  NewVal := RegItem;
  Delete(NewVal,1,p);
  while pos('"',NewVal) > 0 do
    Delete(NewVal,pos('"',NewVal),1);

  SKN := Edit1.Text;

  Delete(SKN,1,pos('\',SKN));
  TC.CurSubKey := SKN;

  TC.GetDataInfo(0,ValName,Size,DType);

  with DataDlg do
  begin
    if (ModifyValue) then
      EditingState := etValue
    else
      EditingState := etName;
    ValueName.Text := ValName;
    IData.Text := NewVal;
    case DType of
      REG_SZ,
      REG_EXPAND_SZ : RGIdx := 5;

      REG_DWORD     : RGIdx := 3;

      REG_BINARY    : begin
                        case Size of
                          8  : begin
                                 RGIdx := 4;
                                 TDbl := TC.ReadFloat(ValName,0);
                                 Str(TDbl,NewVal);
                                 IData.Text := NewVal;
                               end;
                        else
                          RGIdx := 0;
                        end;
                      end;
    end;
  end;

  if (DataDlg.ShowModal = mrOK) then
  begin
    ValName := DataDlg.ValueName.Text;
    NewVal := DataDlg.IData.Text;
    len := Length(NewVal);
    if NOT (ModifyValue) then
      TC.DeleteValue(OldName);
    try
      case DType of
        REG_SZ,
        REG_EXPAND_SZ : TC.WriteString(ValName,NewVal);

        REG_DWORD     : TC.WriteInteger(ValName,StrToInt(NewVal));

        REG_BINARY    : begin
                          if DataDlg.DataTypeRG.ItemIndex = 1 then
                            TC.WriteBoolean(ValName,StrToInt(NewVal) = 1);
                          if DataDlg.DataTypeRG.ItemIndex = 4 then
                          begin
                            Val(NewVal,TDbl,p);
                            if (p = 0) then
                              TC.WriteFloat(ValName,TDbl);
                          end;
                          if DataDlg.DataTypeRG.ItemIndex = 0 then
                          begin
                            TC.StringToBytes(NewVal,BA,len);
                            TC.WriteBinaryData(NewVal,BA,len div 2);
                          end;
                        end;

      end;
    finally
      DataDlg.EditingState := etAll;
      FillListBox;
    end;
  end else
    DataDlg.EditingState := etAll;
end;


procedure TForm1.RenameValueClick(Sender: TObject);
var
  Idx : Integer;
  VN  : string;

begin
  Idx := ListBox1.ItemIndex;
  if (Idx < 0) then
  begin
    ShowMessage('No value selected');
    Exit;
  end;

  VN := ListBox1.Items[Idx];

  OutLine1.Perform(WM_SETREDRAW,0,0);
  try
    if (TC.IsIniFile) then
      RenameIniItem(VN)
    else
      RenameRegItem(VN);
  finally
    Outline1.Perform(WM_SETREDRAW, 1, 0);
    Outline1.Refresh;
  end;
end;

procedure TForm1.RenameIniItem(IniItem : string);
var
  p, len,
  SIndex   : integer;

  SName,
  NewName,
  OldVal,
  ValName  : string;

begin
  ValName := IniItem;
  p := pos('=',ValName);
  len := Length(ValName);
  Delete(ValName,p,len-p+1);
  NewName := ValName;

  OldVal := IniItem;
  Delete(OldVal,1,p);

  if InputQuery('Change Name Dialog',ValName,NewName) then
  begin
    GetIniSectionName(SName,SIndex);
    TC.CurSubKey := SName;

    TC.DeleteValue(ValName);
    TC.WriteString(NewName,OldVal);

    FillListBox;
  end;
end;


procedure TForm1.RenameRegItem(RegItem : string);
begin
  ModifyRegItem(RegItem,False);
end;


procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
var
  ValName,
  IData     : string;
  Bmp       : TBitMap;
  OS1,
  OS2,
  len,
  p         : Integer;

begin
  OS1 := 25;
  OS2 := 132;

  with (Control as TListBox).Canvas do
  begin
    FillRect(Rect);
    Bmp := TBitMap(TListBox(Control).Items.Objects[Index]);
    if (Bmp <> nil) then
      Draw(Rect.Left+2,Rect.Top,Bmp);
    ValName := TListBox(Control).Items[Index];
    IData := ValName;
    len := Length(ValName);
    p := pos('=',ValName);

    Delete(ValName,p,len-p+1);
    Delete(IData,1,p);

    len := Length(ValName);
    if (len > 15) then
    begin
      Delete(ValName,16,len-15);
      Insert('...',ValName,15);
      Delete(ValName,18,1);
    end;

    if (TC.IsIniFile) then
    begin
      TextOut(Rect.Left+OS1,Rect.Top+1,ValName);
      TextOut(Rect.Left+OS2,Rect.Top+1,IData);
    end else
    begin
      TextOut(Rect.Left + OS1,Rect.Top+1,ValName);
      TextOut(Rect.Left + OS2,Rect.Top+1,IData);
    end;
  end;
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
  SendMessage(ListBox1.Handle,lb_SetHorizontalExtent,2500,longint(0));
end;

procedure TForm1.Outline1Collapse(Sender: TObject; Index: Longint);
var
  I      : integer;
  S      : string;

begin
  if (TC.IsIniFile) then
  begin
    if Outline1.SelectedItem = 1 then
      ListBox1.Clear;
    Exit;
  end;
  ListBox1.Clear;
  SetBusy(True);

  S := Outline1.Items[Index].FullPath;
  I := System.pos('\',S);
  if (I = 0) then begin
    SetBusy(False);
    Exit;
  end;

  System.Delete(S,1,I);
  TC.CurSubKey := S;

  FillListBox;
  Outline1.Refresh;
  SetBusy(False);
end;

procedure TForm1.Outline1DblClick(Sender: TObject);
var
  S : string;
begin
  if (TC.IsIniFile) then
  begin
    with Outline1 do
    begin
      if SelectedItem > 1 then
      begin
        S := Items[Outline1.SelectedItem].Text;
        TC.CurSubKey := S;
        FillListBox;
      end;
    end;
  end;
end;

end.