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

📄 ufrmcontact.~pas

📁 Delphi课堂使用用例
💻 ~PAS
字号:
unit ufrmContact;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, ActnList, Menus, ToolWin, ImgList;

type
  TfrmContact = class(TForm)
    ActionList1: TActionList;
    ilAction: TImageList;
    ilSmall: TImageList;
    ilLarge: TImageList;
    ToolBar1: TToolBar;
    sbCount: TStatusBar;
    MainMenu1: TMainMenu;
    PopupMenu1: TPopupMenu;
    F1: TMenuItem;
    acExit: TAction;
    acAdd: TAction;
    acEdit: TAction;
    acDelete: TAction;
    acIcon: TAction;
    acSmall: TAction;
    acList: TAction;
    acReport: TAction;
    acAbout: TAction;
    X1: TMenuItem;
    C1: TMenuItem;
    A1: TMenuItem;
    E1: TMenuItem;
    D1: TMenuItem;
    V1: TMenuItem;
    I1: TMenuItem;
    S1: TMenuItem;
    L1: TMenuItem;
    D2: TMenuItem;
    H1: TMenuItem;
    A2: TMenuItem;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    ToolButton6: TToolButton;
    ToolButton7: TToolButton;
    ToolButton8: TToolButton;
    ToolButton9: TToolButton;
    ToolButton10: TToolButton;
    ToolButton11: TToolButton;
    ToolButton12: TToolButton;
    A3: TMenuItem;
    E2: TMenuItem;
    D3: TMenuItem;
    lvContact: TListView;
    procedure acExitExecute(Sender: TObject);
    procedure acAddExecute(Sender: TObject);
    procedure acEditExecute(Sender: TObject);
    procedure acDeleteExecute(Sender: TObject);
    procedure acViewStyleExecute(Sender: TObject);
    procedure acAboutExecute(Sender: TObject);
    procedure lvContactSelectItem(Sender: TObject; Item: TListItem;
      Selected: Boolean);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
    mContactCount: Integer;
    function getContactCount: Integer;
    procedure setContactCount(const Value: Integer);
    property ContactCount: Integer read getContactCount write setContactCount;
  public
    { Public declarations }
  end;

var
  frmContact: TfrmContact;

implementation

uses udmContact, ufrmInfo;

{$R *.dfm}

procedure TfrmContact.acExitExecute(Sender: TObject);
begin
    Close
end;

procedure TfrmContact.acAddExecute(Sender: TObject);
begin
    frmInfo.ClearValues;
    if frmInfo.ShowModal = mrOk then
    begin
        with lvContact.Items.Add do
        begin
            Caption := frmInfo.edtName.Text;
            SubItems.Add(frmInfo.cmbAddress.Text);
            SubItems.Add(frmInfo.edtPhone.Text);
            SubItems.Add(frmInfo.edtMobile.Text);
            SubItems.Add(frmInfo.cmbGender.Text);
            ImageIndex := frmInfo.cmbGender.ItemIndex;
            SubItems.Add(frmInfo.lstCode.Items[frmInfo.cmbAddress.ItemIndex]);
            case frmInfo.cmbGender.ItemIndex of
                0: SubItems.Add('X');
                1: SubItems.Add('M');
                2: SubItems.Add('F');
            end;
        end;

        dmContact.qrInsert.ParamByName('N').AsString := frmInfo.edtName.Text;
        dmContact.qrInsert.ParamByName('C').AsString := frmInfo.lstCode.Items[frmInfo.cmbAddress.ItemIndex];
        dmContact.qrInsert.ParamByName('P').AsString := frmInfo.edtPhone.Text;
        dmContact.qrInsert.ParamByName('M').AsString := frmInfo.edtMobile.Text;
        case frmInfo.cmbGender.ItemIndex of
            0: dmContact.qrInsert.ParamByName('G').AsString := 'X';
            1: dmContact.qrInsert.ParamByName('G').AsString := 'M';
            2: dmContact.qrInsert.ParamByName('G').AsString := 'F';
        end;
        dmContact.qrInsert.ExecSQL;

    end;
end;

procedure TfrmContact.acEditExecute(Sender: TObject);
begin
    //编辑操作,请参考添加操作补充完成
end;

procedure TfrmContact.acDeleteExecute(Sender: TObject);
begin
    //删除操作,请参考添加操作补充完成
end;

procedure TfrmContact.acViewStyleExecute(Sender: TObject);
begin
    if Sender = acIcon then
        lvContact.ViewStyle := vsIcon
    else if Sender = acSmall then
        lvContact.ViewStyle := vsSmallIcon
    else if Sender = acList then
        lvContact.ViewStyle := vsList
    else if Sender = acReport then
        lvContact.ViewStyle := vsReport
end;

procedure TfrmContact.acAboutExecute(Sender: TObject);
begin
    ShowMessage('About.......');
end;

procedure TfrmContact.lvContactSelectItem(Sender: TObject; Item: TListItem;
  Selected: Boolean);
begin
    acEdit.Enabled := Selected;
    acDelete.Enabled := Selected;
end;

procedure TfrmContact.FormShow(Sender: TObject);
begin
    //从数据库将记录读入
    with dmContact.qrSelect do
    begin
        Open;
        while not Eof do
        begin
            with lvContact.Items.Add do
            begin
                Caption := FieldValues['ContactName'];
                SubItems.Add(FieldValues['PhoneAddress']);
                SubItems.Add(FieldValues['HomePhone']);
                SubItems.Add(FieldValues['Mobile']);
                if FieldValues['Gender'] = 'M' then
                begin
                    SubItems.Add('男');
                    ImageIndex := 1;
                end
                else if FieldValues['Gender'] = 'F' then
                begin
                    SubItems.Add('女');
                    ImageIndex := 2;
                end
                else
                begin
                    SubItems.Add('未知');
                    ImageIndex := 0;
                end;
                SubItems.Add(FieldValues['PhoneCode']);
                SubItems.Add(FieldValues['Gender']);
            end; //with lvContact.Items.Add
            Next;
        end; //while
        Close;
    end; //with dmContact.qrSelect

    ContactCount := lvContact.Items.Count;
end;

procedure TfrmContact.setContactCount(const Value: Integer);
begin
    mContactCount := Value;
    sbCount.SimpleText := '共有' + IntToStr(mContactCount) + '个联系人';
end;

function TfrmContact.getContactCount: Integer;
begin
    Result := mContactCount;
end;

end.

⌨️ 快捷键说明

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