definecolor.pas

来自「pasa人力资源考勤管理系统」· PAS 代码 · 共 256 行

PAS
256
字号
unit definecolor;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, RxCombos, Mask, ToolEdit, RXSpin, INIFiles, ExtDlgs;

type
  TFormdefinecolor = class(TForm)
    GroupBox1: TGroupBox;
    Panel1: TPanel;
    CheckBox1: TCheckBox;
    GroupBox2: TGroupBox;
    Button1: TButton;
    Button2: TButton;
    ColorDialog1: TColorDialog;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    Panel2: TPanel;
    Edit1: TEdit;
    Label1: TLabel;
    CheckBox2: TCheckBox;
    Label2: TLabel;
    Panel3: TPanel;
    Panel4: TPanel;
    Label3: TLabel;
    FontDialog1: TFontDialog;
    Button3: TButton;
    Label4: TLabel;
    Button4: TButton;
    Label5: TLabel;
    RxSpinEdit1: TRxSpinEdit;
    Label6: TLabel;
    Panel5: TPanel;
    Button5: TButton;
    CheckBox3: TCheckBox;
    Label7: TLabel;
    Panel6: TPanel;
    Label8: TLabel;
    Panel7: TPanel;
    Label9: TLabel;
    Panel8: TPanel;
    Label10: TLabel;
    filenameedit1: TEdit;
    Button6: TButton;
    OpenPictureDialog1: TOpenPictureDialog;
    procedure RadioButton1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Panel2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure CheckBox2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure writeset;
  end;

var
  Formdefinecolor: TFormdefinecolor;

implementation

uses main;
{$R *.DFM}

procedure TFormdefinecolor.RadioButton1Click(Sender: TObject);
begin
   if radiobutton1.checked then
   begin
      filenameedit1.enabled:=true;
      panel2.enabled:=false;
   end else
   begin
      filenameedit1.enabled:=false;
      panel2.enabled:=true;
   end;
end;

procedure TFormdefinecolor.Button2Click(Sender: TObject);
begin
   close;
end;

procedure TFormdefinecolor.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
   formdefinecolor:=nil;
   action:=cafree;
end;

procedure TFormdefinecolor.Panel2Click(Sender: TObject);
begin
   if colordialog1.execute then
      (Sender as TPanel).color:=colordialog1.Color;
end;

procedure TFormdefinecolor.FormCreate(Sender: TObject);
var ini:TINIFile;
begin
   ini:=TINIFile.create(extractfilepath(application.exename)+'\Data\System.ini');
   with ini do
   begin
        Checkbox1.checked:=ReadBool('Menu','UserDefine',true);
        Checkbox2.checked:=ReadBool('Menu','UseXP',true);
        edit1.text:=readstring('Menu','BarCaption','PASA人事考勤薪资管理系统');
        Panel3.color:=ReadInteger('Menu','BarColorEnd',8421376);
        Panel4.color:=ReadInteger('Menu','BarColorStart',16776960);
        edit1.font.Color:=ReadInteger('Menu','BarFont.Color',65280);
        edit1.font.Size:=ReadInteger('Menu','BarFont.Size',9);
        edit1.font.Name:=readstring('Menu','BarFont.Name','新明细体');
        RxSpinedit1.value:=ReadInteger('Menu','BarWidth',22);
        Label10.Font.Color:=ReadInteger('Menu','Font.Color',8388608);
        Label10.Font.Size:=ReadInteger('Menu','Font.Size',9);
        Label10.Font.Name:=readstring('Menu','Font.Name','新明细体');
        Checkbox3.checked:=ReadBool('Menu','Frame3D',true);
        Panel6.Color:=ReadInteger('Menu','IconBackColor',16776960);
        Panel5.Color:=ReadInteger('Menu','MenuBarColor',13160660);
        Panel7.Color:=ReadInteger('Menu','SelectFontColor',255);
        Panel8.Color:=ReadInteger('Menu','SeparatorColor',8421504);
        Radiobutton1.Checked:=ReadBool('BackGround','UsePicture',true);
        Radiobutton2.Checked:=not ReadBool('BackGround','UsePicture',true);
        filenameedit1.text:=readstring('BackGround','Picture',extractfilepath(application.exename)+'Icon\Back(800x600).BMP');
        if filenameedit1.text='' then
          filenameedit1.text:=extractfilepath(application.exename)+'Icon\Back(800x600).BMP';
        panel2.color:=readinteger('BackGround','Color',32768);
        checkbox1.OnClick(self);
        checkbox2.onclick(self);
        radiobutton1.OnClick(self);
        free;
   end;
end;

procedure TFormdefinecolor.CheckBox1Click(Sender: TObject);
begin
   if checkbox1.Checked then
   begin
      groupbox1.enabled:=true;
      groupbox1.enabled:=true;
   end else
   begin
      groupbox1.enabled:=true;
      groupbox1.enabled:=true;
   end;
end;

procedure TFormdefinecolor.CheckBox2Click(Sender: TObject);
begin
   if checkbox2.checked then
   begin
      edit1.enabled:=true;
      button3.enabled:=true;
      button5.enabled:=true;
      rxspinedit1.enabled:=true;
      checkbox3.enabled:=true;
      panel3.enabled:=true;
      panel4.enabled:=true;
      panel5.enabled:=true;
      panel6.enabled:=true;
      panel7.enabled:=true;
      panel8.enabled:=true;
   end else
   begin
      edit1.enabled:=false;
      button3.enabled:=false;
      button5.enabled:=false;
      rxspinedit1.enabled:=false;
      checkbox3.enabled:=false;
      panel3.enabled:=false;
      panel4.enabled:=false;
      panel5.enabled:=false;
      panel6.enabled:=false;
      panel7.enabled:=false;
      panel8.enabled:=false;
   end;
end;

procedure TFormdefinecolor.Button3Click(Sender: TObject);
begin
   if fontdialog1.Execute then
   begin
      edit1.Font.Color:=fontdialog1.Font.Color;
      edit1.font.name:=fontdialog1.font.name;
      edit1.font.size:=fontdialog1.font.size;
   end;
end;

procedure TFormdefinecolor.Button5Click(Sender: TObject);
begin
   if fontdialog1.Execute then
   begin
      Label10.Font.Color:=fontdialog1.Font.Color;
      Label10.font.name:=fontdialog1.font.name;
      Label10.font.size:=fontdialog1.font.size;
   end;
end;

procedure TFormdefinecolor.writeset;
var ini:TINIFile;
begin
   ini:=TINIFile.create(extractfilepath(application.exename)+'\Data\System.ini');
   with ini do
   begin
        Writebool('Menu','UserDefine',checkbox1.checked);
        Writebool('Menu','UseXP',checkbox2.checked);
        Writestring('Menu','BarCaption',edit1.text);
        WriteInteger('Menu','BarColorEnd',colortorgb(panel3.color));
        WriteInteger('Menu','BarColorStart',colortorgb(panel4.color));
        WriteInteger('Menu','BarFont.Color',colortorgb(edit1.font.color));
        WriteInteger('Menu','BarFont.Size',edit1.font.size);
        Writestring('Menu','BarFont.Name',edit1.font.name);
        WriteInteger('Menu','BarWidth',trunc(rxspinedit1.value));
        WriteInteger('Menu','Font.Color',colortorgb(label10.font.color));
        WriteInteger('Menu','Font.Size',label10.font.size);
        Writestring('Menu','Font.Name',label10.font.name);
        WriteBool('Menu','Frame3D',checkbox3.checked);
        WriteInteger('Menu','IconBackColor',colortorgb(panel6.Color));
        WriteInteger('Menu','MenuBarColor',colortorgb(panel5.Color));
        WriteInteger('Menu','SelectFontColor',colortorgb(panel7.Color));
        WriteInteger('Menu','SeparatorColor',colortorgb(panel8.Color));
        Writebool('BackGround','UsePicture',radiobutton1.checked);
        Writestring('BackGround','Picture',filenameedit1.text);
        Writeinteger('BackGround','Color',colortorgb(Panel2.color));
        free;
   end;  //with
end;

procedure TFormdefinecolor.Button4Click(Sender: TObject);
begin
    writeset;
    formmain.inidesktop('Menu');
    application.Minimize;
    application.restore;
end;

procedure TFormdefinecolor.Button6Click(Sender: TObject);
begin
    if openpicturedialog1.execute then
       filenameedit1.text:=openpicturedialog1.filename;
end;

procedure TFormdefinecolor.Button1Click(Sender: TObject);
begin
    writeset;
end;

end.

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?