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

📄 frmdatagrid.pas

📁 详细说明:毕业论文中关于小型宾馆管理系统的详细设计毕 业论文中关于小型宾馆...一个酒店管理系统VB+Access [学生学籍管理系统(VB+Acess).zip] - !这个是刚刚编的毕业设计,可能
💻 PAS
字号:
//
// Generic data grid
//
//xxx save column widths to registry (need to store under a unique key for
//    each grid, e.g. party grid)
//
//xxx allow user to define their own tabs (need to store under a unique key for
//    each grid, e.g. party grid)
//
//xxx allow user to change font types, size, etc.
//
//xxx save all these settings under a unique key for each grid, e.g. party grid)
//
// (c) Chicony Software 2001
//
// When       Who  How
// ---------  ---  -------------------------------------------------------
// 13 June,2001 century   Initial version
//
unit frmDataGrid;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ToolWin, ComCtrls, StdCtrls, Buttons, ImgList,
  // Prexim
  vafuncs, utils;

// Grid Callback Commands (see TGridCallback)
type
  GV_COMMANDS=(GV_NEWTAB,      // Tab has changed
               GV_DISPLAY,     // Display a row
               GV_DELETE,      // Delete row(s)
               GV_MODIFY,      // Modify a row
               GV_NEW,         // Create a new row
               GV_FIND,        // Find row(s)
               GV_REFRESH);    // Refresh the display and reload data

// Grid Callback function
// See GV_COMMANDS for the meaning of the command parameter
type
  TGridCallback = function(items: TStringList; command: GV_COMMANDS): Integer of object;

type
  TfrmDataGrid = class(TForm)
    ListView: TListView;
    ToolBar: TToolBar;
    tbClose: TToolButton;
    ImageList: TImageList;
    tbDelete: TToolButton;
    tbSep2: TToolButton;
    tbNew: TToolButton;
    BarImagesList: TImageList;
    tbModify: TToolButton;
    tbSep1: TToolButton;
    tbFind: TToolButton;
    tbRefresh: TToolButton;
    tbSep3: TToolButton;
    TabControl: TTabControl;
    procedure ListViewDblClick(Sender: TObject);
    procedure tbCloseClick(Sender: TObject);
    procedure tbDeleteClick(Sender: TObject);
    procedure tbModifyClick(Sender: TObject);
    procedure tbNewClick(Sender: TObject);
    procedure tbFindClick(Sender: TObject);
    procedure tbRefreshClick(Sender: TObject);
    procedure TabControlChange(Sender: TObject);
    procedure FormPaint(Sender: TObject);
  private
    g_rows_selected: TStringList;
    g_delete_items: Boolean;
    g_parent_control: TWinControl;

    g_GridCallback: TGridCallback;
    g_Modal: Boolean;
  public
    function ShowModal(var delete_items: Boolean): TStringList; reintroduce; overload;
    function ChildWindow(parent_control: TWinControl; GridCallback: TGridCallback): Integer;

    procedure AddColumns(captions: array of String; widths: array of Integer);
    procedure ClearColumns;

    function AddRows(rows: OleVariant): Integer;
    function DeleteRow(key: String): Integer;
    procedure ClearRows;

    procedure AddTabs(tabs: array of string);
    procedure ClearTabs;
    function CurrentTab: String;
    function CurrentTabIsSearchTab: Boolean;
    procedure ChangeSearchTab(const caption: String);

    constructor Create(Owner: TComponent); override;
    destructor Destroy; override;
  end;

//var
//  frmDataGrid: TfrmDataGrid;

implementation

{$R *.DFM}

//==============================================================================
//
// Creation & destruction
//

// Create form & initialise global data
constructor TfrmDataGrid.Create(Owner: TComponent);
begin
     inherited Create(owner);

     // Globals
     g_rows_selected:=nil;
     g_delete_items:=FALSE;
     g_GridCallback:=nil;
     g_Modal:=TRUE;
     g_parent_control:=nil;
end;

// Destroy form & free any resources used
destructor TfrmDataGrid.Destroy;
begin
     // Globals
     inherited Destroy;
end;

//==============================================================================
//
// Entry points
//

//
// We are being displayed as a modal window. In this case we can only support
// deletion of rows (if delete_items is passed as TRUE).
//
// Args: if delete_items is passed as TRUE then the user can delete rows
//
// Returns: a list of the items selected to be viewed/deleted
//
// The string list returned contains a list of all the items selected by the
// user. They are taken from the FIRST COLUMN in the grid (this column need
// not be displayed to the user - set the width to zero to hide it). If
// delete_items is set to TRUE on return then the user wants to delete those
// items, if it is FALSE then the user wants to view those items.
//
function TfrmDataGrid.ShowModal(var delete_items: Boolean): TStringList;
var r: Integer;
begin
     // We are being shown as a dialog box, not a control
     g_Modal:=TRUE;
     g_parent_control:=nil;
     tbDelete.Enabled:=delete_items;
     tbNew.Visible:=FALSE;
     tbModify.Visible:=FALSE;
     tbSep1.Visible:=tbDelete.Visible and tbModify.Visible and tbModify.Visible;
     tbFind.Visible:=FALSE;
     tbSep2.Visible:=tbFind.Visible;
     tbRefresh.Visible:=FALSE;
     tbSep3.Visible:=tbRefresh.Visible;
     TabControl.Visible:=FALSE;

     delete_items:=FALSE;
     r:=inherited ShowModal;
     delete_items:=g_delete_items;
     if r=mrOK then Result:=g_rows_selected else Result:=nil;
end;

//
// We are being displayed INSIDE an existing window.
//
// Args: the control to display in (e.g. a form or a TScrollBox)
//       the function to callback when the user wants to do something
//
// Returns: 0 always
//
// NOTE: Whenever the user wants to delete, create, modify, view, find, or
//       refresh then the callback function is called
//
function TfrmDataGrid.ChildWindow(parent_control: TWinControl; GridCallback: TGridCallback): Integer;
begin
     // We are being shown as a control, not a modal dialog box
     g_parent_control:=parent_control;
     g_Modal:=FALSE;
     g_GridCallback:=GridCallback;
     tbClose.Enabled:=FALSE;

     TabControl.Parent:=parent_control;
     TabControl.ParentWindow:=parent_control.Handle;
     TabControl.Visible:=TRUE;

     ListView.Parent:=parent_control;
     ListView.ParentWindow:=parent_control.Handle;
     ListView.Visible:=TRUE;

     Toolbar.Parent:=parent_control;
     Toolbar.ParentWindow:=parent_control.Handle;
     Toolbar.Visible:=TRUE;

     Result:=0;
end;

// Clear columns of list
procedure TfrmDataGrid.ClearColumns;
begin
     ListView.Columns.Clear;
end;

// Clear rows in list
procedure TfrmDataGrid.ClearRows;
begin
     ListView.Visible:=FALSE;
     ListView.Items.Clear;
     ListView.Visible:=TRUE;
end;

// Clear tabs in list
procedure TfrmDataGrid.ClearTabs;
begin
     TabControl.Tabs.Clear;
end;

// Change the caption of the special search tab
procedure TfrmDataGrid.ChangeSearchTab(const caption: String);
begin
     if TabControl.Tabs.Count<1 then Exit;
     TabControl.Tabs[TabControl.Tabs.Count - 1]:=caption;
     TabControl.TabIndex:=TabControl.Tabs.Count - 1;
end;

//
// Add columns to the grid
//
// Args: list of strings to name the columns
//       width of the columns
//
// Example:
//
//    datagrid.AddColumns(['Party ID', 'Name', 'Relationship'], [50, 50, 50]);
//
procedure TfrmDataGrid.AddColumns(captions: array of String; widths: array of Integer);
var lc: TListColumn;
    i: Integer;
begin
     // Check args
     if (Low(captions)<>Low(widths)) or (High(captions)<>High(widths)) then Exit;

     // Create columns
     for i:=Low(captions) to High(captions) do begin
         lc:=ListView.Columns.Add;
         lc.Caption:=captions[i];
         lc.Width:=Widths[i];
     end;
end;

//
// Delete a row in the grid
//
// Args: key value of the row to delete
//
// Returns: 1 if a row was deleted
//          else no row deleted
//
// Note: The key value must match the value of the first column of the row
//
//       The row is removed from the grid, not the database
//
function TfrmDataGrid.DeleteRow(key: String): Integer;
var i: Integer;
    ListItem: TListItem;
begin
     // List control
     for i:=0 to ListView.Items.Count - 1 do begin
         ListItem:=ListView.Items[i];
         if ListItem.Caption=key then begin
            ListView.Items.Delete(i);
            Result:=1;
            Exit;
         end;
     end;

     // Not found
     Result:= -1;
end;

//
// Adds data to listview
//
// Args: two-dimensional array containing data to add to list view
//
// Returns: Number of rows added to list
//
function TfrmDataGrid.AddRows(rows: OleVariant): Integer;
var ListItem: TListItem;
    row, col, hc, lc, hr, lr: Integer;
begin
     // Valid data?
     if (not ValidSelectResult(rows)) or
        (not GetArrayBounds(rows, hc, lc, hr, lr)) then begin
        // No rows
        Result:= -1;
        Exit;
     end;

     // Initialise controls
     for row:=lr to hr do begin
         ListItem:=ListView.Items.Add;
         if VarType(rows[lc, row])=varNull then
            ListItem.Caption:=''
         else if VarType(rows[lc, row])=varEmpty then
            ListItem.Caption:=''
         else if VarType(rows[lc, row])=varInteger then
            ListItem.Caption:=IntToStr(rows[lc, row])
         else if VarType(rows[lc, row])=varDate then
            ListItem.Caption:=DateTimeToStr(rows[lc, row])
         else if VarType(rows[lc, row])=varBoolean then begin
            if rows[lc, rows] then ListItem.Caption:='Yes'
            else ListItem.Caption:='No';
         end else
            ListItem.Caption:=rows[lc, row];

         for col:=lc + 1 to hc do begin
             if VarType(rows[col, row])=varNull then
                ListItem.SubItems.Add('')
             else if VarType(rows[col, row])=varEmpty then
                ListItem.SubItems.Add('')
             else if VarType(rows[col, row])=varInteger then
                ListItem.SubItems.Add(IntToStr(rows[col, row]))
             else if VarType(rows[col, row])=varDate then
                ListItem.SubItems.Add(DateTimeToStr(rows[col, row]))
             else if VarType(rows[col, row])=varBoolean then begin
                if rows[col, row] then ListItem.SubItems.Add('Yes')
                else ListItem.SubItems.Add('No')
             end else
                ListItem.SubItems.Add(rows[col, row]);
         end;
     end;

     // Done
     Result:=(hr - lr) + 1;
end;

//
// Add tabs to the display.
//
// Args: array of strings to name the tabs
//
// Example:
//
//    datagrid.AddTabs(['a-z', 'A-Z', '0-9']);
//
procedure TfrmDataGrid.AddTabs(tabs: array of String);
var i: Integer;
begin
     for i:=Low(tabs) to High(tabs) do
         TabControl.Tabs.Add(tabs[i]);
     if (TabControl.TabIndex < 0) and (TabControl.Tabs.Count > 0) then
        TabControl.TabIndex:=0
end;

//==============================================================================

// Close
procedure TfrmDataGrid.tbCloseClick(Sender: TObject);
begin
     g_rows_selected:=nil;
     Close;
end;

// User has selected one row
procedure TfrmDataGrid.ListViewDblClick(Sender: TObject);
begin
     // Anything selected?
     if ListView.Selected=nil then Exit;

     // Create a list of the items selected
     g_rows_selected:=TStringList.Create;
     g_rows_selected.Add(ListView.Selected.caption);

     // Calling back?
     if g_Modal then ModalResult:=mrOK
     else g_GridCallback(g_rows_selected, GV_DISPLAY);
end;

// Delete item(s)
procedure TfrmDataGrid.tbDeleteClick(Sender: TObject);
var i: Integer;
begin
     // Get a list of the items selected for deletion
     g_rows_selected:=TStringList.Create;
     for i:=0 to listview.Items.Count - 1 do begin
         if listview.Items[i].Selected then
            g_rows_selected.Add(listview.Items[i].caption);
     end;

     // Anything selected?
     if g_rows_selected.Count > 0 then begin
        // Yes, exit
        g_delete_items:=TRUE;

        // Calling back?
        if g_Modal then ModalResult:=mrOK
        else g_GridCallback(g_rows_selected, GV_DELETE);
     end else begin
        // No, do not exit
        g_rows_selected.Free;
        g_rows_selected:=nil;
     end;
end;

// User wants to modify the selected row
procedure TfrmDataGrid.tbModifyClick(Sender: TObject);
begin
     // Anything selected?
     if ListView.Selected=nil then Exit;

     // Create a list of the items selected
     g_rows_selected:=TStringList.Create;
     g_rows_selected.Add(ListView.Selected.caption);

     // Not possible in modal dialog mode
     if not g_Modal then g_GridCallback(g_rows_selected, GV_MODIFY);
end;

// User wants to create a new row
procedure TfrmDataGrid.tbNewClick(Sender: TObject);
begin
     // Anything selected?
     if ListView.Selected<>nil then begin
        // Create a list of the items selected
        g_rows_selected:=TStringList.Create;
        g_rows_selected.Add(ListView.Selected.caption);
     end else
        g_rows_selected:=nil;

     // Not possible in modal dialog mode
     if not g_Modal then g_GridCallback(g_rows_selected, GV_NEW);
end;

// User wants to find rows
procedure TfrmDataGrid.tbFindClick(Sender: TObject);
begin
     // Anything selected?
     if ListView.Selected<>nil then begin
        // Create a list of the items selected
        g_rows_selected:=TStringList.Create;
        g_rows_selected.Add(ListView.Selected.caption);
     end else
        g_rows_selected:=nil;

     // Not possible in modal dialog mode
     if not g_Modal then g_GridCallback(g_rows_selected, GV_FIND);
end;

// Refresh data
procedure TfrmDataGrid.tbRefreshClick(Sender: TObject);
begin
     // Not possible in modal dialog mode
     if g_Modal then Exit;
     g_GridCallback(nil, GV_REFRESH);
end;

// Return current tab
function TfrmDataGrid.CurrentTab: String;
begin
     // Has a tab been selected?
     if TabControl.TabIndex < 0 then Result:=''
     else Result:=TabControl.Tabs[TabControl.TabIndex];
end;

// Return TRUE if the current tab is the search tab
function TfrmDataGrid.CurrentTabIsSearchTab: Boolean;
begin
     if TabControl.TabIndex=TabControl.Tabs.Count - 1 then Result:=TRUE
     else Result:=FALSE;
end;

// User has changed the tab
procedure TfrmDataGrid.TabControlChange(Sender: TObject);
begin
     // Has a tab been selected?
     if TabControl.TabIndex < 0 then Exit;

     // Get its name
     g_rows_selected:=TStringList.Create;
     g_rows_selected.Add(TabControl.Tabs[TabControl.TabIndex]);

     // Pass it back and check to see if we can change tabs
     if g_GridCallback(g_rows_selected, GV_NEWTAB) < 0 then ClearRows;
end;

// Repaint the parent control when we need a repaint
procedure TfrmDataGrid.FormPaint(Sender: TObject);
begin
     if g_parent_control<>nil then g_parent_control.Repaint;
end;

end.

⌨️ 快捷键说明

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