config.pas

Delphi实效编程百例的随书源代码 这是其中的操作系统部分

UNIT Config;

INTERFACE

USES 	Windows, Classes, Graphics, Forms, Controls, StdCtrls, SysUtils,
	Buttons, ExtCtrls, Dialogs, ComCtrls, Spin, Globals, UPie, UVersion, Ccube;

TYPE
  TDialogConfig = CLASS(TForm)
    Panel1: TPanel;
    ColorDialog1: TColorDialog;
    ButtonOK: TButton;
    Timer1: TTimer;
    PageControl1: TPageControl;
    TabSheetNormal: TTabSheet;
    TabSheetInformation: TTabSheet;
    PanelNormal: TPanel;
    PaintBoxNormal: TPaintBox;
    GroupBoxNormal: TGroupBox;
    ButtonHColor: TButton;
    ButtonMColor: TButton;
    ButtonSColor: TButton;
    ButtonSColorOff: TButton;
    LabelHours: TLabel;
    LabelMinutes: TLabel;
    LabelSeconds: TLabel;
    ButtonSColorBorder: TButton;
    ButtonCancel: TButton;
    RadioGroupView: TRadioGroup;
    RadioButtonNormal: TRadioButton;
    RadioButtonDimmed: TRadioButton;
    CubeSpin1: TCubeSpin;
    Panel2: TPanel;
    Image1: TImage;
    StaticText1: TStaticText;
    StaticText2: TStaticText;
    LabelVersionInfo: TLabel;
    PROCEDURE OKButtonClick(Sender: TObject);
    PROCEDURE FormCreate(Sender: TObject);
    PROCEDURE FormDestroy(Sender: TObject);
    PROCEDURE Timer1Timer(Sender: TObject);
    PROCEDURE ButtonHColorClick(Sender: TObject);
    PROCEDURE ButtonMColorClick(Sender: TObject);
    PROCEDURE ButtonSColorClick(Sender: TObject);
    PROCEDURE ButtonSColorOffClick(Sender: TObject);
    PROCEDURE ButtonSColorBorderClick(Sender: TObject);
    PROCEDURE RadioButtonDimmedClick(Sender: TObject);
    PROCEDURE RadioButtonNormalClick(Sender: TObject);
    PROCEDURE ButtonCancelClick(Sender: TObject);
    PROCEDURE PageControl1Change(Sender: TObject);
    PROCEDURE Image1Click(Sender: TObject);
  PRIVATE
    { Private declarations }
    aRegEntries	: TBerlinUhrRegEntries;
    aSettings  	: TBerlinUhrColors;
    aBerlinUhr 	: TBerlinUhr;
  PUBLIC
	 { Public declarations }
  END;

VAR
  DialogConfig: TDialogConfig;

(*--------------------------------------*)
IMPLEMENTATION

{$R *.DFM}

USES
  MMSystem;

(*--------------------------------------*)
PROCEDURE TDialogConfig.FormCreate(Sender: TObject);

BEGIN
LabelVersionInfo.Caption := GetPVInfo( Application, viProductName) + ' - V'+ GetPVInfo( Application, viFileVersion );
IF bSound THEN
  PlaySound( 'BRIDGE5', hInstance, SND_Resource OR SND_Async );

Caption := 'Configure';

aRegEntries	:= TBerlinUhrRegEntries.Create;
aSettings	:= aRegEntries.BerlinUhrColors;
aRegEntries.Free;
aBerlinUhr	:= TBerlinUhr.Create( aSettings, PaintBoxNormal.Width, PaintBoxNormal.Height, PaintBoxNormal.Width DIV 70 );
Timer1.Enabled 	:= true;
RadioButtonNormal.Checked := true;
END;

(*--------------------------------------*)
PROCEDURE TDialogConfig.FormDestroy(Sender: TObject);

BEGIN
Timer1.Enabled 	:= false;
aBerlinUhr.Free;
IF bSound THEN
  PlaySound( 'BRIDGE7', hInstance, SND_Resource OR SND_sync );
Sleep(300);
END;

(*--------------------------------------*)
PROCEDURE TDialogConfig.OKButtonClick(Sender: TObject);

BEGIN
aRegEntries	:= TBerlinUhrRegEntries.Create;
aRegEntries.BerlinUhrColors := aSettings;
aRegEntries.Free;
Close;
END;

(*--------------------------------------*)
PROCEDURE TDialogConfig.Image1Click(Sender: TObject);


BEGIN
IF bsound THEN
  PlaySound( 'AAA', hInstance, SND_Resource OR SND_Async );
END;

(*--------------------------------------*)
PROCEDURE TDialogConfig.Timer1Timer(Sender: TObject);

BEGIN
Timer1.Enabled := false;
PaintBoxNormal.Canvas.CopyMode := cmSrcCopy;
PaintBoxNormal.Canvas.Draw(0,0, aBerlinUhr.GetBitmap( Now ) );
Timer1.Enabled := true;
END;

(*--------------------------------------*)
PROCEDURE TDialogConfig.ButtonHColorClick(Sender: TObject);

BEGIN
IF bSound THEN
  PlaySound( 'UNROLL', hInstance, SND_Resource OR SND_Async );

TRY
  aSettings		:= aBerlinUhr.Colors;
  IF RadioButtonNormal.Checked THEN
    ColorDialog1.Color	:= aSettings.bucHColorOn
   ELSE
    ColorDialog1.Color	:= aSettings.bucHColorDim;
  ColorDialog1.Options	:= [cdFullOpen];
  IF ColorDialog1.Execute THEN
    BEGIN
    IF RadioButtonNormal.Checked THEN
      aSettings.bucHColorOn := ColorDialog1.Color
     ELSE
      aSettings.bucHColorDim := ColorDialog1.Color;
    aBerlinUhr.Colors	:= aSettings;
    END;
 EXCEPT
  END;

IF bSound THEN
  PlaySound( 'UNROLL', hInstance, SND_Resource OR SND_Async );
END;

(*--------------------------------------*)
PROCEDURE TDialogConfig.ButtonMColorClick(Sender: TObject);

BEGIN
IF bSound THEN
  PlaySound( 'UNROLL', hInstance, SND_Resource OR SND_Async );

TRY
  aSettings		:= aBerlinUhr.Colors;
  IF RadioButtonNormal.Checked THEN
    ColorDialog1.Color	:= aSettings.bucMColorOn
   ELSE
    ColorDialog1.Color	:= aSettings.bucMColorDim;
  ColorDialog1.Options	:= [cdFullOpen];
  IF ColorDialog1.Execute THEN
    BEGIN
    IF RadioButtonNormal.Checked THEN
      aSettings.bucMColorOn := ColorDialog1.Color
     ELSE
      aSettings.bucMColorDim := ColorDialog1.Color;
    aBerlinUhr.Colors	:= aSettings;
    END;
 EXCEPT
  END;

IF bSound THEN
  PlaySound( 'UNROLL', hInstance, SND_Resource OR SND_Async );
END;

(*--------------------------------------*)
PROCEDURE TDialogConfig.ButtonSColorClick(Sender: TObject);

BEGIN
IF bSound THEN
  PlaySound( 'UNROLL', hInstance, SND_Resource OR SND_Async );

TRY
  aSettings		:= aBerlinUhr.Colors;
  IF RadioButtonNormal.Checked THEN
    ColorDialog1.Color	:= aSettings.bucSColorOn
   ELSE
    ColorDialog1.Color	:= aSettings.bucSColorDim;
  ColorDialog1.Options	:= [cdFullOpen];
  IF ColorDialog1.Execute THEN
    BEGIN
    IF RadioButtonNormal.Checked THEN
      aSettings.bucSColorOn := ColorDialog1.Color
     ELSE
      aSettings.bucSColorDim := ColorDialog1.Color;
    aBerlinUhr.Colors	:= aSettings;
    END;
 EXCEPT
  END;

IF bSound THEN
  PlaySound( 'UNROLL', hInstance, SND_Resource OR SND_Async );
END;

(*--------------------------------------*)
PROCEDURE TDialogConfig.ButtonSColorOffClick(Sender: TObject);

BEGIN
IF bSound THEN
  PlaySound( 'UNROLL', hInstance, SND_Resource OR SND_Async );

TRY
  aSettings		:= aBerlinUhr.Colors;
  ColorDialog1.Color	:= aSettings.bucHColorOff;
  ColorDialog1.Options	:= [cdFullOpen];
  IF ColorDialog1.Execute THEN
    BEGIN
    aSettings.bucHColorOff	:= ColorDialog1.Color;
    aSettings.bucMColorOff	:= ColorDialog1.Color;
    aSettings.bucSColorOff	:= ColorDialog1.Color;
    aBerlinUhr.Colors	:= aSettings;
    END;
 EXCEPT
  END;

IF bSound THEN
  PlaySound( 'UNROLL', hInstance, SND_Resource OR SND_Async );

END;

(*--------------------------------------*)
PROCEDURE TDialogConfig.ButtonSColorBorderClick(Sender: TObject);

BEGIN
IF bSound THEN
  PlaySound( 'UNROLL', hInstance, SND_Resource OR SND_Async );

TRY
  aSettings		:= aBerlinUhr.Colors;
  ColorDialog1.Color	:= aSettings.bucBorderColor;
  ColorDialog1.Options	:= [cdFullOpen];
  IF ColorDialog1.Execute THEN
    BEGIN
    aSettings.bucBorderColor := ColorDialog1.Color;
    aBerlinUhr.Colors	:= aSettings;
    END;
 EXCEPT
  END;

IF bSound THEN
  PlaySound( 'UNROLL', hInstance, SND_Resource OR SND_Async );

END;

(*--------------------------------------*)
PROCEDURE TDialogConfig.RadioButtonDimmedClick(Sender: TObject);

BEGIN
IF bSound THEN
  PlaySound( 'TREKDOOR', hInstance, SND_Resource OR SND_Async );
aBerlinUhr.DimmAll( RadioButtonDimmed.Checked  );
ButtonSColorOff.Enabled := RadioButtonNormal.Checked;
ButtonSColorBorder.Enabled := RadioButtonNormal.Checked;
END;

(*--------------------------------------*)
PROCEDURE TDialogConfig.RadioButtonNormalClick(Sender: TObject);

BEGIN
IF bSound THEN
  PlaySound( 'TREKDOOR', hInstance, SND_Resource OR SND_Async );
aBerlinUhr.DimmAll( RadioButtonDimmed.Checked );
ButtonSColorOff.Enabled := RadioButtonNormal.Checked;
ButtonSColorBorder.Enabled := RadioButtonNormal.Checked;
END;

(*--------------------------------------*)
PROCEDURE TDialogConfig.ButtonCancelClick(Sender: TObject);

BEGIN
Close;
END;

(*--------------------------------------*)
PROCEDURE TDialogConfig.PageControl1Change(Sender: TObject);

BEGIN
IF bSound THEN
  PlaySound( 'TREKDOOR', hInstance, SND_Resource OR SND_Async );
END;
(*++++++++++++++++++++++++++++++++++++++*)

END.