home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 1998 April A / Pcwk4a98.iso / PROGRAM / DELPHI16 / Calmira / Src / SRC / SYSPROP.PAS < prev    next >
Pascal/Delphi Source File  |  1997-02-18  |  14KB  |  492 lines
  1. {**************************************************************************}
  2. {                                                                          }
  3. {    Calmira shell for Microsoft« Windows(TM) 3.1                          }
  4. {    Source Release 1.0                                                    }
  5. {    Copyright (C) 1997  Li-Hsin Huang                                     }
  6. {                                                                          }
  7. {    This program is free software; you can redistribute it and/or modify  }
  8. {    it under the terms of the GNU General Public License as published by  }
  9. {    the Free Software Foundation; either version 2 of the License, or     }
  10. {    (at your option) any later version.                                   }
  11. {                                                                          }
  12. {    This program is distributed in the hope that it will be useful,       }
  13. {    but WITHOUT ANY WARRANTY; without even the implied warranty of        }
  14. {    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the         }
  15. {    GNU General Public License for more details.                          }
  16. {                                                                          }
  17. {    You should have received a copy of the GNU General Public License     }
  18. {    along with this program; if not, write to the Free Software           }
  19. {    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.             }
  20. {                                                                          }
  21. {**************************************************************************}
  22.  
  23. unit Sysprop;
  24.  
  25. interface
  26.  
  27. uses WinTypes, WinProcs, Classes, Graphics, Forms, Controls, Buttons,
  28.   StdCtrls, ExtCtrls, Chklist, TabNotBk, Grids, StylSped, Outline, Spin,
  29.   Scrtree, Dialogs, Settings;
  30.  
  31. type
  32.   TSysPropDlg = class(TForm)
  33.     OKBtn: TBitBtn;
  34.     CancelBtn: TBitBtn;
  35.     Notebook: TTabbedNotebook;
  36.     Bevel1: TBevel;
  37.     CapEdit: TEdit;
  38.     Label2: TLabel;
  39.     PrefList: TCheckList;
  40.     Label1: TLabel;
  41.     Element: TComboBox;
  42.     ColorPick: TComboBox;
  43.     Bevel2: TBevel;
  44.     CustomBtn: TStyleSpeed;
  45.     Sample: TShape;
  46.     Label3: TLabel;
  47.     Label4: TLabel;
  48.     AddBtn: TStyleSpeed;
  49.     RemoveBtn: TStyleSpeed;
  50.     ModifyBtn: TStyleSpeed;
  51.     Bevel3: TBevel;
  52.     Label5: TLabel;
  53.     Label6: TLabel;
  54.     GridWidth: TSpinEdit;
  55.     GridHeight: TSpinEdit;
  56.     Label8: TLabel;
  57.     RowHeight: TSpinEdit;
  58.     Label7: TLabel;
  59.     Label9: TLabel;
  60.     Outline: TScrollTree;
  61.     SaveBtn: TStyleSpeed;
  62.     ColorDialog: TColorDialog;
  63.     DeviceList: TListBox;
  64.     Header: THeader;
  65.     RemoteEdit: TEdit;
  66.     Label10: TLabel;
  67.     Label11: TLabel;
  68.     PasswordEdit: TEdit;
  69.     Connect: TStyleSpeed;
  70.     Disconnect: TStyleSpeed;
  71.     RefreshNet: TStyleSpeed;
  72.     HelpBtn: TBitBtn;
  73.     procedure FormCreate(Sender: TObject);
  74.     procedure OKBtnClick(Sender: TObject);
  75.     procedure OutlineDrawItem(Control: TWinControl; Index: Integer;
  76.       Rect: TRect; State: TOwnerDrawState);
  77.     procedure AddBtnClick(Sender: TObject);
  78.     procedure RemoveBtnClick(Sender: TObject);
  79.     procedure ModifyBtnClick(Sender: TObject);
  80.     procedure OutlineClick(Sender: TObject);
  81.     procedure ColorPickChange(Sender: TObject);
  82.     procedure CustomBtnClick(Sender: TObject);
  83.     procedure FormDestroy(Sender: TObject);
  84.     procedure ElementChange(Sender: TObject);
  85.     procedure SaveBtnClick(Sender: TObject);
  86.     procedure NotebookChange(Sender: TObject; NewTab: Integer;
  87.       var AllowChange: Boolean);
  88.     procedure DeviceListDrawItem(Control: TWinControl; Index: Integer;
  89.       Rect: TRect; State: TOwnerDrawState);
  90.     procedure RefreshNetClick(Sender: TObject);
  91.     procedure HeaderSized(Sender: TObject; ASection, AWidth: Integer);
  92.     procedure ConnectClick(Sender: TObject);
  93.     procedure DeviceListClick(Sender: TObject);
  94.   private
  95.     { Private declarations }
  96.     FilledOutline : Boolean;
  97.     Changes : TSettingChanges;
  98.     AdvancedChanged : Boolean;
  99.     SaveCustomColors : Boolean;
  100.     procedure EnumColorProc(const s: string);
  101.   public
  102.     { Public declarations }
  103.     procedure QueryNetwork;
  104.   end;
  105.  
  106. {
  107. var
  108.   SysPropDlg: TSysPropDlg;
  109. }
  110.  
  111.  
  112. implementation
  113.  
  114. uses Drives, MiscUtil, Sys, SysUtils, Strings;
  115.  
  116. {$R *.DFM}
  117.  
  118. procedure TSysPropDlg.EnumColorProc(const s: string);
  119. begin
  120.   ColorPick.Items.AddObject(
  121.     System.Copy(s, 3, Length(s)-2), TObject(StringToColor(s)));
  122. end;
  123.  
  124.  
  125. function GetNetConnection(LocalName : string): string;
  126. var
  127.   len: Word;
  128. begin
  129.   len := 254;
  130.   if WNetGetConnection(StringAsPChar(LocalName), @Result[1], @len) = WN_SUCCESS then
  131.     Result[0] := Chr(len)
  132.   else
  133.     Result := '(None)';
  134. end;
  135.  
  136.  
  137. procedure TSysPropDlg.QueryNetwork;
  138. var
  139.   d: Char;
  140. begin
  141.   DeviceList.Clear;
  142.  
  143.   for d := 'A' to 'Z' do
  144.     DeviceList.Items.AddObject(
  145.       Format('Drive (%s:)¼%s', [d, GetNetConnection(d + ':')]),
  146.       TObject(d));
  147.  
  148.   for d := '1' to '3' do
  149.     DeviceList.Items.AddObject(
  150.       Format('Parallel port LPT%s¼%s', [d, GetNetConnection('LPT' + d)]),
  151.       TObject(d));
  152.  
  153.   Connect.Enabled := False;
  154.   Disconnect.Enabled := False;
  155. end;
  156.  
  157.  
  158. procedure TSysPropDlg.FormCreate(Sender: TObject);
  159. var
  160.   c: TCalColor;
  161. begin
  162.   Changes := [];
  163.   Notebook.PageIndex := 0;
  164.   CapEdit.Text := SysCaption;
  165.  
  166.   PrefList.SetData(
  167.     [ShowSplash, RestoreSys, SysWinQuit,
  168.      QueryQuit, MsgDialogSounds, LoadTaskbar,
  169.      TrackThumb, KeyBreak]);
  170.  
  171.   for c := Low(TCalColor) to High(TCalColor) do
  172.     Element.Items.AddObject(ColorNames[c], Pointer(Colors[c]));
  173.   GetColorValues(EnumColorProc);
  174.  
  175.   GridWidth.Value := BrowseGrid.X;
  176.   GridHeight.Value := BrowseGrid.Y;
  177.   RowHeight.Value := LineHeight;
  178.  
  179.   ini.ReadSectionValues('Custom colors', ColorDialog.CustomColors);
  180. end;
  181.  
  182.  
  183. procedure TSysPropDlg.OKBtnClick(Sender: TObject);
  184. var
  185.   c: TCalColor;
  186. begin
  187.   if AdvancedChanged and (MsgDialog('Save advanced settings?',
  188.     mtConfirmation, [mbYes, mbNo], 0) = mrYes) then SaveBtn.Click;
  189.  
  190.   SysCaption := CapEdit.Text;
  191.  
  192.   PrefList.GetData(
  193.     [@ShowSplash, @RestoreSys, @SysWinQuit,
  194.      @QueryQuit, @MsgDialogSounds, @LoadTaskbar,
  195.      @TrackThumb, @KeyBreak]);
  196.  
  197.   for c:= Low(TCalColor) to High(TCalColor) do
  198.     Colors[c] := Longint(Element.Items.Objects[Integer(c)]);
  199.  
  200.   BrowseGrid.X := GridWidth.Value;
  201.   BrowseGrid.Y := GridHeight.Value;
  202.   LineHeight := RowHeight.Value;
  203.  
  204.   SaveSystemProp;
  205.   Include(Changes, scSystem);
  206.   if CustomBtn.Enabled then Include(Changes, scDisplay);
  207. end;
  208.  
  209.  
  210. procedure TSysPropDlg.OutlineDrawItem(Control: TWinControl; Index: Integer;
  211.   Rect: TRect; State: TOwnerDrawState);
  212. var
  213.   item: TOutlineNode;
  214.   x : Integer;
  215. begin
  216.   with Outline do begin
  217.     index := GetItem(0, Rect.Top);
  218.     item := Items[index];
  219.     x := Rect.Left + 4 + (item.Level-1) * 20;
  220.  
  221.     with Canvas do begin
  222.       FillRect(Rect);
  223.       TextOut(x + 19, Rect.Top+2, item.Text);
  224.  
  225.       if item.Level = 1 then
  226.         if item.Expanded then
  227.           Draw(x+1, Rect.Top+1, PictureOpen)
  228.         else
  229.           Draw(x+1, Rect.Top+1, PictureClosed)
  230.       else
  231.         Draw(x+1, Rect.Top+1, PictureLeaf);
  232.     end;
  233.   end;
  234. end;
  235.  
  236.  
  237. procedure TSysPropDlg.AddBtnClick(Sender: TObject);
  238. var
  239.   s: string;
  240.   item : TOutlineNode;
  241. begin
  242.   s := '';
  243.   if InputQuery('Add an entry', 'Ident=Value', s) then begin
  244.     AdvancedChanged := True;
  245.     with Outline do
  246.       if SelectedItem > 0 then begin
  247.         item := Items[SelectedItem];
  248.         if item.Level = 1 then AddChild(SelectedItem, s)
  249.         else Add(SelectedItem, s);
  250.       end
  251.       else
  252.         Add(0, s);
  253.   end;
  254. end;
  255.  
  256.  
  257. procedure TSysPropDlg.RemoveBtnClick(Sender: TObject);
  258. begin
  259.   with Outline do
  260.     if SelectedItem > 0 then begin
  261.       Delete(SelectedItem);
  262.       AdvancedChanged := True;
  263.     end;
  264. end;
  265.  
  266.  
  267. procedure TSysPropDlg.ModifyBtnClick(Sender: TObject);
  268. var
  269.   s: string;
  270.   item : TOutlineNode;
  271. begin
  272.   with Outline do begin
  273.     if SelectedItem > 0 then begin
  274.       item := Items[SelectedItem];
  275.       s := item.Text;
  276.       if InputQuery('Modify entry', 'Ident=Value', s) then begin
  277.         item.Text := s;
  278.         AdvancedChanged := True;
  279.       end;
  280.     end;
  281.   end;
  282. end;
  283.  
  284.  
  285. procedure TSysPropDlg.OutlineClick(Sender: TObject);
  286. begin
  287.   with Outline do
  288.   RemoveBtn.Enabled :=
  289.     (SelectedItem > 0) and (Items[SelectedItem].Level > 1);
  290.   ModifyBtn.Enabled := RemoveBtn.Enabled;
  291. end;
  292.  
  293.  
  294. procedure TSysPropDlg.ColorPickChange(Sender: TObject);
  295. var
  296.   c: TColor;
  297. begin
  298.   with ColorPick do c := TColor(Items.Objects[ItemIndex]);
  299.   with Element do Items.Objects[ItemIndex] := TObject(c);
  300.   Sample.Brush.Color := c;
  301. end;
  302.  
  303.  
  304. procedure TSysPropDlg.CustomBtnClick(Sender: TObject);
  305. var
  306.   c: TColor;
  307. begin
  308.   ColorDialog.Color := Sample.Brush.Color;
  309.   if ColorDialog.Execute then begin
  310.     c := ColorDialog.Color;
  311.     with ColorPick do ItemIndex := Items.IndexOfObject(TObject(c));
  312.     with Element do Items.Objects[ItemIndex] := TObject(c);
  313.     Sample.Brush.Color := c;
  314.     SaveCustomColors := True;
  315.   end;
  316. end;
  317.  
  318.  
  319. procedure TSysPropDlg.FormDestroy(Sender: TObject);
  320. begin
  321.   if SaveCustomColors then
  322.     ini.WriteSectionValues('Custom colors', ColorDialog.CustomColors);
  323.   if Changes <> [] then AnnounceSettingsChanged(Changes);
  324. end;
  325.  
  326.  
  327. procedure TSysPropDlg.ElementChange(Sender: TObject);
  328. var
  329.   c: TColor;
  330. begin
  331.   with Element do c := TColor(Items.Objects[ItemIndex]);
  332.   with ColorPick do begin
  333.     Enabled := True;
  334.     ItemIndex := Items.IndexOfObject(TObject(c));
  335.   end;
  336.   CustomBtn.Enabled := True;
  337.   Sample.Brush.Color := c;
  338. end;
  339.  
  340.  
  341.  
  342. procedure TSysPropDlg.SaveBtnClick(Sender: TObject);
  343. var
  344.   i: Longint;
  345. begin
  346.   Screen.Cursor := crHourGlass;
  347.   with ini do
  348.     for i := 1 to Outline.ItemCount do
  349.       with Outline.Items[i] do
  350.         if Level = 1 then EraseSection(Text)
  351.         else WriteString(Parent.Text, GetStrKey(Text), GetStrValue(Text));
  352.  
  353.   Screen.Cursor := crDefault;
  354.   Include(Changes, scINIFile);
  355.   AdvancedChanged := False;
  356. end;
  357.  
  358.  
  359. procedure TSysPropDlg.NotebookChange(Sender: TObject; NewTab: Integer;
  360.   var AllowChange: Boolean);
  361. var
  362.   sections, strings: TStringList;
  363.   i, j : Integer;
  364.   node : Longint;
  365.   s : string[127];
  366. begin
  367.   if (NewTab = 3) and not FilledOutline then begin
  368.     sections := TUniqueStrings.Create;
  369.     ini.ReadStrings('Advanced', sections);
  370.     strings := TStringList.Create;
  371.  
  372.     try
  373.       with Outline do begin
  374.         for i := 0 to sections.Count-1 do Add(0, sections[i]);
  375.  
  376.         BeginUpdate;
  377.         for i := 0 to sections.Count-1 do begin
  378.           s := sections[i];
  379.           node := GetTextItem(s);
  380.           strings.Clear;
  381.           ini.ReadSectionValues(s, strings);
  382.           for j := 0 to strings.Count-1 do AddChild(node, strings[j]);
  383.         end;
  384.         EndUpdate;
  385.         Canvas.Font.Assign(Font);
  386.         ThumbTracking := TrackThumb;
  387.         Click;
  388.       end;
  389.     finally
  390.       sections.Free;
  391.       strings.Free;
  392.       FilledOutline := True;
  393.     end;
  394.   end
  395.  
  396.   else if (NewTab = 2) and (DeviceList.Items.Count = 0) then
  397.     QueryNetwork;
  398. end;
  399.  
  400.  
  401. procedure TSysPropDlg.DeviceListDrawItem(Control: TWinControl;
  402.   Index: Integer; Rect: TRect; State: TOwnerDrawState);
  403. var
  404.   local : string[31];
  405.   remote : string;
  406. begin
  407.   with DeviceList do begin
  408.     remote := '';
  409.     Unformat(Items[Index], '%s¼%s', [@local, 31, @remote, 255]);
  410.     Canvas.FillRect(Rect);
  411.     Inc(Rect.Top);
  412.     Canvas.TextOut(Rect.Left + 2, Rect.Top, local);
  413.     Canvas.TextOut(Header.SectionWidth[0], Rect.Top, remote);
  414.   end;
  415. end;
  416.  
  417.  
  418. procedure TSysPropDlg.RefreshNetClick(Sender: TObject);
  419. begin
  420.   QueryNetwork;
  421. end;
  422.  
  423.  
  424. procedure TSysPropDlg.HeaderSized(Sender: TObject; ASection,
  425.   AWidth: Integer);
  426. begin
  427.   DeviceList.Invalidate;
  428. end;
  429.  
  430.  
  431. function NetError(n: Word): string;
  432. begin
  433.   case n of
  434.     WN_SUCCESS       : Result := 'The connection/disconnection was successful';
  435.     WN_NOT_SUPPORTED : Result := 'This operation is not supported';
  436.     WN_OUT_OF_MEMORY : Result := 'Out of memory';
  437.     WN_NET_ERROR     : Result := 'An error has occured on the network';
  438.     WN_BAD_POINTER   : Result := 'Invalid pointer';
  439.     WN_BAD_NETNAME   : Result := 'Invalid network resource name';
  440.     WN_BAD_LOCALNAME : Result := 'Invalid local device';
  441.     WN_BAD_PASSWORD  : Result := 'Invalid password';
  442.     WN_ACCESS_DENIED : Result := 'Access denied!';
  443.     WN_OPEN_FILES    : Result := 'Files were open so connection not cancelled';
  444.     WN_ALREADY_CONNECTED : Result := 'This device is already remotely connected';
  445.     else Result := 'The connection/disconnection failed';
  446.   end;
  447. end;
  448.  
  449.  
  450. procedure TSysPropDlg.ConnectClick(Sender: TObject);
  451. var
  452.   local : string[7];
  453.   remote, password: string;
  454.   result : Word;
  455. begin
  456.   with DeviceList do
  457.     if ItemIndex > -1 then begin
  458.       { Get the local device name }
  459.       local := 'X';
  460.       local[1] := Char(Items.Objects[ItemIndex]);
  461.       if local[1] in ['1'..'3'] then local := 'LPT' + local
  462.       else AppendStr(local, ':');
  463.  
  464.       if Sender = Connect then begin
  465.         { attempt connection }
  466.         remote := RemoteEdit.Text;
  467.         password := PasswordEdit.Text;
  468.         Result := WNetAddConnection(StringAsPChar(remote), StringAsPChar(password),
  469.           StringAsPchar(local));
  470.       end
  471.       else
  472.         { attempt disconnection }
  473.         Result := WNetCancelConnection(StringAsPChar(local),
  474.           MsgDialog('Close any open files or print jobs?',
  475.           mtWarning, [mbYes, mbNo], 0) = mrYes);
  476.  
  477.       if Result = WN_SUCCESS then QueryNetwork
  478.       else MsgDialog(NetError(Result), mtError, [mbOK], 0);
  479.       Include(Changes, scDevices);
  480.       DetectDrives;
  481.   end;
  482. end;
  483.  
  484.  
  485. procedure TSysPropDlg.DeviceListClick(Sender: TObject);
  486. begin
  487.   Connect.Enabled := True;
  488.   Disconnect.Enabled := True;
  489. end;
  490.  
  491. end.
  492.