⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 option.pas

📁 小闹钟程序
💻 PAS
字号:
unit Option;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, DBCtrls, Menus,DB, DBTables,ExtCtrls;

type
  Tfrm_Option = class(TForm)
    GroupBox1: TGroupBox;
    cmb_Back: TComboBox;
    GroupBox2: TGroupBox;
    lst_Font: TListBox;
    GroupBox3: TGroupBox;
    Image1: TImage;
    GroupBox4: TGroupBox;
    chk_AutoRun: TCheckBox;
    chk_TopMost: TCheckBox;
    btn_OK: TButton;
    btn_Cancel: TButton;
    Label1: TLabel;
    Label2: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure lst_FontDrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure cmb_BackClick(Sender: TObject);
    procedure lst_FontClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frm_Option: Tfrm_Option;

implementation
uses Clock, Control,AlarmOption;
{$R *.dfm}

procedure Tfrm_Option.FormCreate(Sender: TObject);
var
    i:Integer;
    mem:TMemoryStream;
    str_Temp:String;
begin
    if ControlModule.OptionTable.RecordCount<1 then
    begin
        with ControlModule.OptionTable do
        begin
            Append;
            FieldByName('背景来源').AsString:='1大象';
            FieldByName('字体名称').AsString:='宋体';
            FieldByName('自动运行').AsBoolean:=false;
            FieldByName('总在最前面').AsBoolean:=false;
            FieldByName('以图标形式运行').AsBoolean:=false;
            Post;
        end;
    end;

    lst_Font.Items:=Screen.Fonts;
    if not ControlModule.BackTable.Active then
        ControlModule.BackTable.Active:=true;
    if ControlModule.BackTable.RecordCount<1 then
    begin
        with ControlModule.BackTable do
        begin
            Insert;
            FieldByName('Name').AsString:='大象';
            mem:=TMemoryStream.Create();
            mem.LoadFromFile('大象.bmp');
            TBlobField(FieldByName('Data')).LoadFromStream(mem);
            Post;

            Insert;
            FieldByName('Name').AsString:='企鹅';
            mem:=TMemoryStream.Create();
            mem.LoadFromFile('企鹅.bmp');
            TBlobField(FieldByName('Data')).LoadFromStream(mem);
            Post;
            mem.Free;
        end;
    end;

    with ControlModule.BackTable do
    begin
        First;
        while not eof do
        begin
            cmb_Back.Items.Add(FieldByName('Name').AsString);
            Next;
        end;
    end;

    with ControlModule.OptionTable do
    begin
        self.cmb_Back.ItemIndex:=self.cmb_Back.Items.IndexOf(FieldByName('背景来源').AsString);
        self.chk_AutoRun.Checked:=FieldByName('自动运行').AsBoolean;
        self.chk_TopMost.Checked:=FieldByName('总在最前面').AsBoolean;
        self.lst_Font.ItemIndex:=self.lst_Font.Items.IndexOf(FieldByName('字体名称').AsString);
    end;
    cmb_BackClick(sender);
end;

procedure Tfrm_Option.lst_FontDrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
begin
    with self.lst_Font.Canvas do
    begin
        FillRect(Rect);
        Font.Size:=12;
        Font.Name:=Screen.Fonts.Strings[index];
        TextOut(rect.Left+1,rect.Top+1,lst_Font.Items[index]);
    end;
end;

procedure Tfrm_Option.cmb_BackClick(Sender: TObject);
var
    mem:TStream;
    bmp:TBitmap;
begin
    with ControlModule.BackTable do
    begin
        First;
        while not eof do
        begin
            if FieldByName('Name').AsString=cmb_Back.Text then
                break;
            Next;
        end;
        bmp:=TBitmap.Create;
        mem:=CreateBlobStream(FieldByName('Data'),bmRead);
        mem.Position:=0;
        bmp.LoadFromStream(mem);
        self.Image1.Picture.Assign(bmp);
        bmp.Free;
        mem.Free;
    end;

    if cmb_Back.Text='大象' then
    begin
        self.Label2.Left:=107;
        self.Label2.Top:=5;
    end
    else
    begin
        self.Label2.Left:=139;
        self.Label2.Top:=5;
    end;
end;

procedure Tfrm_Option.lst_FontClick(Sender: TObject);
begin
    self.Label2.Font.Name:=self.lst_Font.Items[self.lst_Font.ItemIndex];
end;

end.

⌨️ 快捷键说明

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