home *** CD-ROM | disk | FTP | other *** search
/ Delphi 4 Bible / Delphi_4_Bible_Tom_Swan_IDG_Books_1998.iso / source / SYSCOLOR / MAIN.PAS < prev    next >
Pascal/Delphi Source File  |  1998-04-10  |  11KB  |  379 lines
  1. unit Main;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, Windows, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, StdCtrls, Buttons, ExtCtrls,
  8.   AboutDlg, IniFiles, Menus;
  9.  
  10. const
  11.   maxColors = 19;           { Number of Windows system colors }
  12.   redMask = $000000FF;         { Red value extraction mask }
  13.   greenMask = $0000FF00;       { Green value extraction mask }
  14.   blueMask = $00FF0000;        { Blue value extraction mask }
  15.   iniFileName = 'SysColor.Ini';{ Located in Windows directory }
  16.  
  17. type
  18.   TMainForm = class(TForm)
  19.     BlueEdit: TEdit;
  20.     BlueLabel: TLabel;
  21.     BlueSB: TScrollBar;
  22.     ClearBitBtn: TBitBtn;
  23.     CloseBitBtn: TBitBtn;
  24.     ColorEdit: TEdit;
  25.     ColorLabel: TLabel;
  26.     FileAbout: TMenuItem;
  27.     FileExit: TMenuItem;
  28.     FileMenu: TMenuItem;
  29.     GreenEdit: TEdit;
  30.     GreenLabel: TLabel;
  31.     GreenSB: TScrollBar;
  32.     Label1: TLabel;
  33.     Label2: TLabel;
  34.     Label3: TLabel;
  35.     Label4: TLabel;
  36.     Label5: TLabel;
  37.     Label6: TLabel;
  38.     Label7: TLabel;
  39.     Label8: TLabel;
  40.     Label9: TLabel;
  41.     Label10: TLabel;
  42.     Label11: TLabel;
  43.     Label12: TLabel;
  44.     Label13: TLabel;
  45.     Label14: TLabel;
  46.     Label15: TLabel;
  47.     Label16: TLabel;
  48.     Label17: TLabel;
  49.     Label18: TLabel;
  50.     Label19: TLabel;
  51.     MainMenu1: TMainMenu;
  52.     N1: TMenuItem;
  53.     RedEdit: TEdit;
  54.     RedLabel: TLabel;
  55.     RedSB: TScrollBar;
  56.     ResetAllBitBtn: TBitBtn;
  57.     ResetBitBtn: TBitBtn;
  58.     SaveBitBtn: TBitBtn;
  59.     SaveCheckBox: TCheckBox;
  60.     SetBitBtn: TBitBtn;
  61.     Shape1: TShape;
  62.     Shape2: TShape;
  63.     Shape3: TShape;
  64.     Shape4: TShape;
  65.     Shape5: TShape;
  66.     Shape6: TShape;
  67.     Shape7: TShape;
  68.     Shape8: TShape;
  69.     Shape9: TShape;
  70.     Shape10: TShape;
  71.     Shape11: TShape;
  72.     Shape12: TShape;
  73.     Shape13: TShape;
  74.     Shape14: TShape;
  75.     Shape15: TShape;
  76.     Shape16: TShape;
  77.     Shape17: TShape;
  78.     Shape18: TShape;
  79.     Shape19: TShape;
  80.     procedure ClearBitBtnClick(Sender: TObject);
  81.     procedure EditChange(Sender: TObject);
  82.     procedure FileAboutClick(Sender: TObject);
  83.     procedure FileExitClick(Sender: TObject);
  84.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  85.     procedure FormCreate(Sender: TObject);
  86.     procedure FormDestroy(Sender: TObject);
  87.     procedure ResetAllBitBtnClick(Sender: TObject);
  88.     procedure ResetBitBtnClick(Sender: TObject);
  89.     procedure SaveBitBtnClick(Sender: TObject);
  90.     procedure SaveCheckBoxClick(Sender: TObject);
  91.     procedure SBChange(Sender: TObject);
  92.     procedure SetBitBtnClick(Sender: TObject);
  93.     procedure ShapeMouseDown(Sender: TObject; Button: TMouseButton;
  94.       Shift: TShiftState; X, Y: Integer);
  95.   private
  96.     IniFile: TIniFile;
  97.     IniItemList: TStringList;
  98.     EditControls: array[0 .. 2] of TEdit;
  99.     ScrollBars: array[0 .. 2] of TScrollBar;
  100.     Shapes: array[0 .. maxColors - 1] of TShape;
  101.     CurrentShape: TShape;
  102.     procedure UpdateColor;
  103.     procedure InitSysColorArray;
  104.     procedure ChangeSystemColors;
  105.     procedure SetScrollBars(C: TColor);
  106.     procedure LoadSettings;
  107.     procedure SaveSettings;
  108.   public
  109.     { Public declarations }
  110.   end;
  111.  
  112. var
  113.   MainForm: TMainForm;
  114.  
  115. implementation
  116.  
  117. {$R *.DFM}
  118.  
  119. type
  120. { Holds current system colors }
  121.   SysColorRec = record
  122.     OriginalColor: TColor;  { Color on starting program }
  123.     CurrentColor: TColor;   { New color selected by user }
  124.   end;
  125.  
  126. var
  127. { Array of SysColorRec values }
  128.   SysColorArray: array[0 .. maxColors - 1] of SysColorRec;
  129.  
  130. { Update sample colors from scrollbar positions }
  131. procedure TMainForm.UpdateColor;
  132. begin
  133. { Update color edit box (the large sample window) }
  134.   ColorEdit.Color :=
  135.     RGB(RedSB.Position, GreenSB.Position, BlueSB.Position);
  136. { Update labeled Shape color box and SysColorArray }
  137.   if CurrentShape <> nil then with CurrentShape do
  138.   begin
  139.     Brush.Color := ColorEdit.Color;
  140.     SysColorArray[Tag - 1].CurrentColor := Brush.Color;
  141.   end;
  142. end;
  143.  
  144. { Load system colors into the SysColor array }
  145. procedure TMainForm.InitSysColorArray;
  146. var
  147.   I: Integer;
  148. begin
  149.   for I := 0 to maxColors - 1 do with SysColorArray[I] do
  150.   begin
  151.     OriginalColor := GetSysColor(I);
  152.     CurrentColor := OriginalColor;
  153.     Shapes[I].Brush.Color := OriginalColor;
  154.   end;
  155. end;
  156.  
  157. { Change system colors to values in SysColorArray }
  158. procedure TMainForm.ChangeSystemColors;
  159. var
  160.   I: Integer;
  161.   InxArray: Array[0 .. maxColors - 1] of Integer;
  162.   ClrArray: Array[0 .. maxColors - 1] of TColor;
  163. begin
  164.   for I := 0 to maxColors - 1 do
  165.   begin
  166.     InxArray[I] := I;
  167.     ClrArray[I] := SysColorArray[I].CurrentColor;
  168.   end;
  169.   SetSysColors(maxColors, InxArray[0], ClrArray[0]);
  170. end;
  171.  
  172. { Initialize TObject control arrays }
  173. procedure TMainForm.FormCreate(Sender: TObject);
  174. var
  175.   I: Integer;
  176. begin
  177. { Construct IniFile object instance }
  178.   IniFile := TIniFile.Create(iniFileName);
  179. { Miscellaneous initializations }
  180.   CurrentShape := nil;  { No selected labeled color shape }
  181. { Assign object references to easy-access arrays }
  182.   EditControls[0] := RedEdit;
  183.   EditControls[1] := GreenEdit;
  184.   EditControls[2] := BlueEdit;
  185.   ScrollBars[0] := RedSB;
  186.   ScrollBars[1] := GreenSB;
  187.   ScrollBars[2] := BlueSB;
  188. { Assign Shape color box object references to Shapes array }
  189.   for I := 0 to maxColors - 1 do
  190.     Shapes[I] := TShape(FindComponent('Shape' + IntToStr(I + 1)));
  191. { Create item list from Labels for Ini file read/write }
  192.   IniItemList := TStringList.Create;
  193.   with IniItemList do
  194.   for I := 0 to maxColors - 1 do
  195.     Add(TLabel(FindComponent('Label' + IntToStr(I + 1))).Caption);
  196. { Load current colors and possible Ini file settings }
  197.   InitSysColorArray;  { Initialize SysColor array }
  198.   LoadSettings;       { Load SysColor.Ini settings if present }
  199. end;
  200.  
  201. { Save settings if SaveCheckBox selected }
  202. procedure TMainForm.FormClose(Sender: TObject;
  203.   var Action: TCloseAction);
  204. begin
  205.   if SaveCheckBox.Checked then
  206.     SaveSettings;  { Save settings in SysColor.Ini }
  207. end;
  208.  
  209. { Last chance to clean up }
  210. procedure TMainForm.FormDestroy(Sender: TObject);
  211. begin
  212.   IniItemList.Free;
  213.   IniFile.Free;
  214. end;
  215.  
  216. { Set scrollbar positions to match color C }
  217. procedure TMainForm.SetScrollBars(C: TColor);
  218. begin
  219. { The following assignments also update Edit boxes }
  220.   RedSB.Position := C and redMask;
  221.   GreenSB.Position := (C and greenMask) shr 8;
  222.   BlueSB.Position := (C and blueMask) shr 16;
  223. end;
  224.  
  225. { Update values in Edit boxes for ScrollBar changes }
  226. procedure TMainForm.SBChange(Sender: TObject);
  227. begin
  228.   with Sender as TScrollBar do
  229.     EditControls[Tag].Text := IntToStr(Position);
  230.   UpdateColor;
  231. end;
  232.  
  233. { Update scrollbar positions for Edit box changes }
  234. procedure TMainForm.EditChange(Sender: TObject);
  235. begin
  236.   with Sender as TEdit do
  237.     ScrollBars[Tag].Position := StrToInt(Text);
  238. end;
  239.  
  240. { Select color shape on mouse down event }
  241. procedure TMainForm.ShapeMouseDown(Sender: TObject;
  242.   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  243. var
  244.   P: TLabel;   { Pointer to matching TLabel object }
  245. begin
  246.   CurrentShape := TShape(Sender);  { Save clicked Shape }
  247.   P := TLabel(FindComponent('Label' + IntToStr(CurrentShape.Tag)));
  248.   if P <> nil then
  249.     ColorLabel.Caption := P.Caption;  { Show color name }
  250.   SetScrollBars(CurrentShape.Brush.Color);  { Synch scroll bars }
  251. end;
  252.  
  253. { Load colors and options from SysColor.Ini if present }
  254. procedure TMainForm.LoadSettings;
  255. var
  256.   IniValueList: TStringList;
  257.   I: Integer;
  258. begin
  259.   IniValueList := TStringList.Create;
  260.   try
  261.   { [SysColor] settings }
  262.     IniFile.ReadSectionValues('SysColor', IniValueList);
  263.     for I := 0 to IniValueList.Count - 1 do
  264.     with SysColorArray[I] do
  265.     begin
  266.       CurrentColor := StrToInt(
  267.         IniValueList.Values[IniItemList[I]]);
  268.       OriginalColor := CurrentColor;
  269.     end;
  270.   { [Options] settings }
  271.     SaveCheckBox.Checked :=
  272.       IniFile.ReadBool('Options', 'Save settings', False);
  273.   finally
  274.     IniValueList.Free;
  275.   end;
  276.   ChangeSystemColors;
  277.   InitSysColorArray;
  278. end;
  279.  
  280. { Create or update SysColor.Ini color settings only }
  281. procedure TMainForm.SaveSettings;
  282. var
  283.   I: Integer;
  284. begin
  285. { [SysColor]