mainpas.pas
来自「DELPHI 编写个人工作计划事务管理软件」· PAS 代码 · 共 1,690 行 · 第 1/5 页
PAS
1,690 行
unit Mainpas;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, ExtCtrls, Menus, ToolWin, Excel2000, OleServer,
Buttons, ImgList, DB, ADODB, StdCtrls, Grids, DBGrids;
type
TMainForm = class(TForm)
StatusBar: TStatusBar;
JihuaListView: TListView;
MainMenu: TMainMenu;
MainFile: TMenuItem;
FileNews: TMenuItem;
File_Break_1: TMenuItem;
FileOutput: TMenuItem;
OutputText: TMenuItem;
OutputExcel: TMenuItem;
File_Break_2: TMenuItem;
FileExit: TMenuItem;
MainManage: TMenuItem;
FileModify: TMenuItem;
ManageView: TMenuItem;
Manage_Break_1: TMenuItem;
ManageOption: TMenuItem;
ViewPopupMenu: TPopupMenu;
PopuNews: TMenuItem;
PopuModify: TMenuItem;
N1: TMenuItem;
ToolBarCoolBar: TCoolBar;
TopCmdPanel: TPanel;
SaveFileDialog: TSaveDialog;
ManageCount: TMenuItem;
CountWeek: TMenuItem;
CountMonth: TMenuItem;
CountYear: TMenuItem;
PopuCount: TMenuItem;
PopuCountWeek: TMenuItem;
PopuCountMonth: TMenuItem;
PopuCountYear: TMenuItem;
CmdToolBar: TToolBar;
NewsToolBut: TToolButton;
ModifyToolBut: TToolButton;
ToolBut_Break_1: TToolButton;
ViewToolBut: TToolButton;
CountToolBut: TToolButton;
ToolBut_Break_2: TToolButton;
OptionToolBut: TToolButton;
ButImageList: TImageList;
DownPopupMenu: TPopupMenu;
DownPopuWeek: TMenuItem;
DownPopuMonth: TMenuItem;
DownPopuYear: TMenuItem;
ADOQuery: TADOQuery;
PopuCountDay: TMenuItem;
CountDay: TMenuItem;
DownPopuDay: TMenuItem;
SystemTimer: TTimer;
DeleteToolBut: TToolButton;
FileDelete: TMenuItem;
PopuDelete: TMenuItem;
CB_RecordSort: TComboBox;
ListAnLabel: TLabel;
WeekSelPanel: TPanel;
FWeekSpeedBut: TSpeedButton;
NWeekSpeedBut: TSpeedButton;
LWeekSpeedBut: TSpeedButton;
WeekCountLabel: TLabel;
DataSource: TDataSource;
PageControl: TPageControl;
TabDateSheet: TTabSheet;
TabResultSheet: TTabSheet;
DBGrid: TDBGrid;
TreeView: TTreeView;
LeftRightSplitter: TSplitter;
CB_ResultInfo: TComboBox;
ResultInfoLabel: TLabel;
ResultListView: TListView;
ToolShowNowBut: TToolButton;
SearchPopupMenu: TPopupMenu;
SearchNow: TMenuItem;
SearchOther: TMenuItem;
SearchWeek: TMenuItem;
ADOConnection: TADOConnection;
MainWindow: TMenuItem;
WindowAbout: TMenuItem;
ToolAboutBut: TToolButton;
procedure FormCreate(Sender: TObject);
procedure FileNewsClick(Sender: TObject);
procedure FileModifyClick(Sender: TObject);
procedure OutputTextClick(Sender: TObject);
procedure OutputExcelClick(Sender: TObject);
procedure FileExitClick(Sender: TObject);
procedure ManageViewClick(Sender: TObject);
procedure CountWeekClick(Sender: TObject);
procedure CountMonthClick(Sender: TObject);
procedure CountYearClick(Sender: TObject);
procedure ManageOptionClick(Sender: TObject);
procedure NewsToolButClick(Sender: TObject);
procedure ModifyToolButClick(Sender: TObject);
procedure ViewToolButClick(Sender: TObject);
procedure CountToolButClick(Sender: TObject);
procedure OptionToolButClick(Sender: TObject);
procedure PopuNewsClick(Sender: TObject);
procedure PopuModifyClick(Sender: TObject);
procedure PopuCountWeekClick(Sender: TObject);
procedure PopuCountMonthClick(Sender: TObject);
procedure PopuCountYearClick(Sender: TObject);
procedure DownPopuWeekClick(Sender: TObject);
procedure DownPopuMonthClick(Sender: TObject);
procedure DownPopuYearClick(Sender: TObject);
procedure JihuaListViewDblClick(Sender: TObject);
procedure CountDayClick(Sender: TObject);
procedure DownPopuDayClick(Sender: TObject);
procedure PopuCountDayClick(Sender: TObject);
procedure JihuaListViewSelectItem(Sender: TObject; Item: TListItem;
Selected: Boolean);
procedure SystemTimerTimer(Sender: TObject);
procedure FileDeleteClick(Sender: TObject);
procedure DeleteToolButClick(Sender: TObject);
procedure PopuDeleteClick(Sender: TObject);
procedure CB_RecordSortChange(Sender: TObject);
procedure FWeekSpeedButClick(Sender: TObject);
procedure NWeekSpeedButClick(Sender: TObject);
procedure LWeekSpeedButClick(Sender: TObject);
procedure CB_ResultInfoChange(Sender: TObject);
procedure LeftRightSplitterCanResize(Sender: TObject;
var NewSize: Integer; var Accept: Boolean);
procedure PageControlChange(Sender: TObject);
procedure TreeViewClick(Sender: TObject);
procedure ToolShowNowButClick(Sender: TObject);
procedure SearchNowClick(Sender: TObject);
procedure SearchOtherClick(Sender: TObject);
procedure SearchWeekClick(Sender: TObject);
procedure WindowAboutClick(Sender: TObject);
procedure ToolAboutButClick(Sender: TObject);
private
{ Private declarations }
Function LoginDatabase() : Boolean; //---- 建立数据库的链接 ----//
Function DataBaseSearch(DBS_SqlStr : String; DBS_Tag : Integer = 1) : Boolean;
Procedure DataToString(var DTS_Str : TStringList); //----从数据库传到数组----//
Procedure DataInsToView(DITV_Str : TStringList);//---- 插入到信息列表 ----//
Procedure FlushDataBut(FDB_Tag : Boolean); //---- 刷新数据按钮 ----//
Procedure FlushResultBut(FRB_Tag : Boolean); //---- 刷新结果按钮 ----//
Procedure ListViewToString(LVTS_List : TListView; var LVTS_Str : TStringList);//---- 所信息列表中信息输入字 ----//
Procedure ModifyListView(MLV_Str : TStringList);//---- 修改信息列表数值 ----//
Procedure DateRecordToStr(var DRT_Str : TStringList);//---- 数据记录到字串列表 ----//
Procedure FlushListView(FLV_Tag : Boolean);//---- 显示与刷新列表框 ----//
Procedure FlushWeekParle(FWP_Tag : Boolean);//---- 显示与刷新周选择 ----//
Procedure FlushSortBox(FSB_Tag : Boolean);//---- 显示与刷新排序列表 ----//
Procedure FlushResultInfo(FRI_Tag : Boolean);//----- 刷新结果信息选框 ----//
Procedure FlushDBGridWith();//----- 设定数据表格单元格宽度 ----//
Procedure FlushResultListView(FRLV_Tag : Integer);//---- 刷新结果标格 ----//
Procedure GetColumnsStr(GCS_Tag : Integer; var GCS_Str : TStringList);//---- 获取信息列表栏名 ----//
Function GetInfoStr(GIS_String : String) : String;//---- 取得结果信息字串 ----//
Procedure ShowInfoTree(SIT_Str : String); //---- 显示信息树内容 ----//
Function CheckStrHave(CSH_String : String; CSH_Str : TStringList) : Boolean;
Procedure GetLineDateStr(var GLDS_Str : TStringList);//==== 获取一行数据到字符列表 ====//
Procedure ShowDateToView(SDTV_Str : TStringList);//==== 把一行数据加入结果信息 ====//
public
{ Public declarations }
end;
var
MainForm: TMainForm;
DateIsHave : Boolean;
implementation
uses Share_Date, Searchpas, Newspas, Modifypas, Daypas, Optionpas, CountSelPas,
AboutPas;
{$R *.dfm}
{****************************************}
{******** 自定义过程与函数的代码 ********}
{****************************************}
Function TMainForm.LoginDatabase() : Boolean;
var LD_RootDir : String;
begin
LD_RootDir := ExtractFilePath(Application.ExeName);
if LD_RootDir[Length(LD_RootDir)] <> '\' then LD_RootDir := LD_RootDir + '\';
Try
With ADOConnection do begin
Close;
ConnectionString := Format(CONNSTRING, [LD_RootDir, LD_RootDir]);
LoginPrompt := FALSE;
Open;
end;
Result := TRUE;
Except
Result := FALSE;
Application.MessageBox('连接数据库时出错!!', '警告', MB_OK);
Abort();
end;
end;
//---- 数据库查询函数 ----//
Function TMainForm.DataBaseSearch(DBS_SqlStr : String; DBS_Tag : Integer = 1) : Boolean;
var DBS_RootDir : String;
begin
DBS_RootDir := ExtractFilePath(Application.ExeName);
if DBS_RootDir[Length(DBS_RootDir)] <> '\' then DBS_RootDir := DBS_RootDir + '\';
Try
if Trim(DBS_SqlStr) = '' then begin
Result := FALSE;
Exit;
end;
ADOConnection.Close;
ADOConnection.Open;
With ADOQuery do begin
Close;
Connection := ADOConnection;
SQL.Clear;
SQL.Add(DBS_SqlStr);
PrePared;
if DBS_Tag = 1 then Open
else ExecSQL;
end;
Result := TRUE;
Except
Result := FALSE;
Application.MessageBox('查询数据记录错误', '警告', MB_OK);
Abort();
end;
end;
//---- 从数据库传到数组 ----//
Procedure TMainForm.DataToString(var DTS_Str : TStringList);
Const DTS_MAXLEN = 11;
Type TSHOWDATA = (ParkID = 0, //// 星期数 ///
DayWeek = 1,
JihuaName = 2,
JihuaMain = 3,
CreateDate = 4,
EndDate = 5,
LevelStatus = 6,
JihuaStatus = 7,
FinishDate = 8,
JihuaRemark = 9,
Remark = 10
);
var DTS_Array : Array of String;
I : Integer;
DTS_Field : TStringList;
begin
DTS_Str.Clear;
SetLength(DTS_Array, DTS_MAXLEN);
DTS_Field := TStringList.Create;
Try
if ADOQuery.Active = TRUE then begin
ADOQuery.Fields.GetFieldNames(DTS_Field);
if DTS_Field.Count > 0 then begin
for I := 0 to DTS_Field.Count - 1 do begin
if CompareText(DTS_Field[I], 'ID') = 0 then
DTS_Array[Ord(TSHOWDATA(ParkID))] := Trim(ADOQuery.FieldByName(DTS_Field[I]).AsString)
else if CompareText(DTS_Field[I],'JihuaName') = 0 then
DTS_Array[Ord(TSHOWDATA(JihuaName))] := Trim(ADOQuery.FieldByName(DTS_Field[I]).AsString)
else if CompareText(DTS_Field[I],'JihuaMain') = 0 then
DTS_Array[Ord(TSHOWDATA(JihuaMain))] := Trim(ADOQuery.FieldByName(DTS_Field[I]).AsString)
else if CompareText(DTS_Field[I],'CreateDate') = 0 then begin
DTS_Array[Ord(TSHOWDATA(DayWeek))] := FormatDateTime('ddd',ADOQuery.FieldByName(DTS_Field[I]).AsDateTime);
DTS_Array[Ord(TSHOWDATA(CreateDate))] := Trim(FormatDateTime('yyyy-MM-dd hh:mm:ss',ADOQuery.FieldByName(DTS_Field[I]).AsDateTime));
end else if CompareText(DTS_Field[I],'EndDate') = 0 then
DTS_Array[Ord(TSHOWDATA(EndDate))] := Trim(FormatDateTime('yyyy-MM-dd',ADOQuery.FieldByName(DTS_Field[I]).AsDateTime))
else if CompareText(DTS_Field[I],'LevelStatus') = 0 then
DTS_Array[Ord(TSHOWDATA(LevelStatus))] := Trim(GetLevelString(ADOQuery.FieldByName(DTS_Field[I]).AsInteger))
else if CompareText(DTS_Field[I],'JihuaStatus') = 0 then
DTS_Array[Ord(TSHOWDATA(JihuaStatus))] := Trim(ADOQuery.FieldByName(DTS_Field[I]).AsString)
else if CompareText(DTS_Field[I],'FinishDate') = 0 then
DTS_Array[Ord(TSHOWDATA(FinishDate))] := Trim(ADOQuery.FieldByName(DTS_Field[I]).AsString)
else if CompareText(DTS_Field[I],'JihuaRemark') = 0 then
DTS_Array[Ord(TSHOWDATA(JihuaRemark))] := Trim(ADOQuery.FieldByName(DTS_Field[I]).AsString)
else if CompareText(DTS_Field[I],'Remark') = 0 then
DTS_Array[Ord(TSHOWDATA(Remark))] := Trim(ADOQuery.FieldByName(DTS_Field[I]).AsString);
end;
for I:= Low(DTS_Array) to High(DTS_Array) do DTS_Str.Add(DTS_Array[I]);
end;
end;
Finally
DTS_Field.Free;
end;
end;
//---- 插入到信息列表 ----//
Procedure TMainForm.DataInsToView(DITV_Str : TStringList);
var I : Integer;
begin
if DITV_Str.Count > 0 then begin
With JihuaListView.Items.Add do begin
Caption := DITV_Str[0];
For I:= 1 to DITV_Str.Count - 1 do SubItems.Add(DITV_Str[I]);
end;
end;
end;
//---- 刷新数据按钮 ----//
Procedure TMainForm.FlushDataBut(FDB_Tag : Boolean);
begin
FileNews.Enabled := FDB_Tag;
NewsToolBut.Enabled := FDB_Tag;
PopuNews.Enabled := FDB_Tag;
ManageView.Enabled := FDB_Tag;
ViewToolBut.Enabled := FDB_Tag;
ToolShowNowBut.Enabled := FDB_Tag;
//FileOutput.Enabled := FDB_Tag;
ManageCount.Enabled := FDB_Tag;
CountToolBut.Enabled := FDB_Tag;
PopuCount.Enabled := FDB_Tag;
end;
//---- 刷新结果按钮 ----//
Procedure TMainForm.FlushResultBut(FRB_Tag : Boolean);
begin
FileModify.Enabled := FRB_Tag;
ModifyToolBut.Enabled := FRB_Tag;
PopuModify.Enabled := FRB_Tag;
FileDelete.Enabled := FRB_Tag;
DeleteToolBut.Enabled := FRB_Tag;
PopuDelete.Enabled := FRB_Tag;
end;
//---- 所信息列表中信息输入字 ----//
Procedure TMainForm.ListViewToString(LVTS_List : TListView; var LVTS_Str : TStringList);
var I, J : Integer;
LVTS_String : String;
begin
// LVTS_List.Clear;
With LVTS_List.Items do begin
for I := 0 to Count - 1 do begin
LVTS_String := '编号 : ' + Trim(Item[I].Caption) + #13#10;
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?