mainfrm.pas

一个自己总结的delphi常用函数（内有自己编写的一些技巧性函数 ）

{ ********************************************************************** }
{                                                                        }
{                    DelphiFun 1.0 (Delphi函数查询器)                    }
{                            MainForm Source                             }
{                                                                        }
{     Copyright (c) 2003 by netrobo & [e-mail] in changchun      }
{                                                                        }
{ ********************************************************************** }

unit MainFrm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls,  Grids,StdCtrls, Mask,Menus, Buttons, ExtCtrls, ToolWin,
  ActnList, FR_Combo,  DB,  ADODB, ImgList,PubFun, DBGrids, XPMan;

type
  TMainForm = class(TForm)
    StuBar1: TStatusBar;
    MainMenu1: TMainMenu;
    S1: TMenuItem;
    H1: TMenuItem;
    AdoConn1: TADOConnection;
    AdoQ1: TADOQuery;
    DS1: TDataSource;
    AdoQ1ID: TAutoIncField;
    AdoQ1FunName: TWideStringField;
    AdoQ1FunCata: TWideStringField;
    AdoQ1FunNote: TWideStringField;
    CoolBar1: TCoolBar;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    ToolButton6: TToolButton;
    ToolButton7: TToolButton;
  //  EdtFind: TcxTextEdit;
    ImgList1: TImageList;
    ImgListApp: TImageList;
    ActionMain: TActionList;
    SysExit: TAction;
    HelpEmail: TAction;
    HelpAbout: TAction;
    SysFind: TAction;
    V1: TMenuItem;
    ViewTop: TAction;
    F1: TMenuItem;
    E1: TMenuItem;
    T1: TMenuItem;
    L1: TMenuItem;
    A1: TMenuItem;
  {  cxGrid1DBTableView1: TcxGridDBTableView;
    cxGrid1Level1: TcxGridLevel;
    cxGrid1: TcxGrid;
    cxGrid1DBTableView1ID: TcxGridDBColumn;
    cxGrid1DBTableView1FunName: TcxGridDBColumn;
    cxGrid1DBTableView1FunCata: TcxGridDBColumn;
    cxGrid1DBTableView1FunNote: TcxGridDBColumn;  }
    ViewXp: TAction;
    XPP1: TMenuItem;
    DBGrid1: TDBGrid;
    Edit1: TEdit;
    XPManifest1: TXPManifest;
    procedure DispFindRec(const SqlWhere:string);
    procedure HelpAboutExecute(Sender: TObject);
    procedure SysExitExecute(Sender: TObject);
    procedure HelpEmailExecute(Sender: TObject);
    procedure ViewTopExecute(Sender: TObject);
    procedure ViewXpExecute(Sender: TObject);
  //  procedure EdtFindKeyPress(Sender: TObject; var Key: Char);
    procedure DS1DataChange(Sender: TObject; Field: TField);
    procedure SysFindExecute(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Edit1KeyPress(Sender: TObject; var Key: Char);
    procedure Edit1Change(Sender: TObject);
    procedure DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
      DataCol: Integer; Column: TColumn; State: TGridDrawState);
    procedure DBGrid1TitleClick(Column: TColumn);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;
   bsort:Boolean;
implementation

uses AboutFrm, FindFrm;

{$R *.dfm}

procedure TMainForm.HelpAboutExecute(Sender: TObject);
begin
  AboutForm:=TAboutForm.Create(Application);
  AboutForm.ShowModal;
end;

procedure TMainForm.SysExitExecute(Sender: TObject);
begin
  close;
end;

procedure TMainForm.HelpEmailExecute(Sender: TObject);
begin
  ToMyEmail();
end;

procedure TMainForm.ViewTopExecute(Sender: TObject);
begin
  TAction(Sender).Checked:=not TAction(Sender).Checked;
  if TAction(Sender).Checked then begin
      TAction(Sender).imageindex:=6;
      Self.FormStyle:=fsStayOnTop;
  end
  else begin
      TAction(Sender).imageindex:=5;
      Self.FormStyle:=fsNormal;
  end;
end;

procedure TMainForm.ViewXpExecute(Sender: TObject);
begin
  TAction(Sender).Checked:=not TAction(Sender).Checked;
  if TAction(Sender).Checked then
    //  xpMenu1.Active:=true
  else
     // xpMenu1.Active:=false;
end;

{procedure TMainForm.EdtFindKeyPress(Sender: TObject; var Key: Char);
begin
  if key=#13 then
      DispFindRec('FunName like''%'+trim(EdtFind.text)+'%''');
end; }

procedure TMainForm.DispFindRec(const SqlWhere:string);
begin
    AdoQ1.SQL.Clear;
    AdoQ1.SQL.add('Select * from FunList where ');
    AdoQ1.SQL.add(SqlWhere);
    AdoQ1.Close;
    AdoQ1.Active:=true;
end;

procedure TMainForm.DS1DataChange(Sender: TObject; Field: TField);
begin
  StuBar1.Panels[1].Text:='记录总数：'+IntToStr(DS1.DataSet.RecordCount);
  StuBar1.Panels[2].Text:=FormatDateTime('YYYY-MM-DD',Date);
end;

procedure TMainForm.SysFindExecute(Sender: TObject);
begin
    FindForm.ShowModal;
end;

procedure TMainForm.FormCreate(Sender: TObject);
//var S,Sc:string;
begin
   // S:=ExtractFilePath(ParamStr(0));
   // if S[Length(S)]<>'\'then S:=S+'\';
   //// S:=S+'DelphiFun.MDB';
   // Sc:='provider=Microsoft.Jet.OLEDB.4.0;Data Source='+S+';'+
     //   'Persist Security Info=False';
   // AdoConn1.ConnectionString:=Sc;
   // AdoConn1.Connected:=true;
   // AdoQ1.Active:=true;
end;

procedure TMainForm.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
//if key=#13 then
     // DispFindRec('FunName like''%'+trim(Edit1.text)+'%''');
end;

procedure TMainForm.Edit1Change(Sender: TObject);
begin
    DispFindRec('FunName like''%'+trim(Edit1.text)+'%''');
end;

procedure TMainForm.DBGrid1DrawColumnCell(Sender: TObject;
  const Rect: TRect; DataCol: Integer; Column: TColumn;
  State: TGridDrawState);
 var i :integer;
begin
  if gdSelected in State then Exit;
  for i :=0 to (Sender as TDBGrid).Columns.Count-1 do
begin
  //(Sender as TDBGrid).Columns[i].Title.Font.Name :='宋体';
  //(Sender as TDBGrid).Columns[i].Title.Font.Size :=12;
 // (Sender as TDBGrid).Columns[i].Title.Font.Color :=clNavy;
  //(Sender as TDBGrid).Columns[i].Title.Color :=$00FFC4C4;
  // (Sender as TDBGrid).Columns[i].Alignment:=taCenter;
end;
   if AdoQ1.RecNo mod 2=0 then
  (Sender as TDBGrid).Canvas.Brush.Color := $00ECFFEC  //绿色
else
  (Sender as TDBGrid).Canvas.Brush.Color :=$00FCFCF8;  //浅绿色
  DBGrid1.DefaultDrawColumnCell(Rect,DataCol,Column,State);
  with (Sender as TDBGrid).Canvas do  begin
  // Pen.Color :=clred;
  MoveTo(Rect.Left, Rect.Bottom);
  LineTo(Rect.Right, Rect.Bottom);
 //  Pen.Color := $00FCFCF8;
  MoveTo(Rect.Right, Rect.Top);
  LineTo(Rect.Right, Rect.Bottom);
  end;
end;

procedure TMainForm.DBGrid1TitleClick(Column: TColumn);
var
    i:integer;
    fieldname:string;
   CTStr:String;
begin//排序