unit1.pas

自己编写的DBF数据库游览软件,包含TDBF控软件.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, AppEvnts, Grids, DBGrids, DB, dbf, ExtCtrls, FileCtrl, StdCtrls,
  unit2, ImgList;
type
  TForm1 = class(TForm)
    Dbf1: TDbf;
    DataSource1: TDataSource;
    DBGrid1: TDBGrid;
    ApplicationEvents1: TApplicationEvents;
    DriveComboBox1: TDriveComboBox;
    DirectoryListBox1: TDirectoryListBox;
    FileListBox1: TFileListBox;
    ImageList1: TImageList;
    Splitter1: TSplitter;
    Panel1: TPanel;
    Panel2: TPanel;
    Splitter2: TSplitter;
    procedure ApplicationEvents1Message(var Msg: tagMSG;
      var Handled: Boolean);
    procedure FileListBox1DblClick(Sender: TObject);
    procedure DBGrid1DblClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
      DataCol: Integer; Column: TColumn; State: TGridDrawState);
    procedure DBGrid1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormPaint(Sender: TObject);
    procedure DBGrid1ColEnter(Sender: TObject);
    procedure DBGrid1ColExit(Sender: TObject);
    procedure DriveComboBox1Change(Sender: TObject);
  private
    { Private declarations }
    OriginalOptions:TDBGridOptions;
    procedure WMNCPaint(var Msg: TWMNCPaint); message WM_NCPAINT;
    procedure WMNCActivate(var Msg: TWMNCActivate); message WM_NCActivate;
    procedure SaveBoolean;

  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.WMNCPaint(var Msg: TWMNCPaint);
var
  ACanvas : TCanvas;
begin
  inherited;
  ACanvas := TCanvas.Create;
  try
    ACanvas.Handle := GetWindowDC(Form1.Handle);
    with ACanvas do begin
      Brush.Color := clActiveCaption;
//      Rectangle(0, 0, Form1.Width, Form1.Height);
//      Font.Name := 'Tahoma';
      Font.Size := 12;
      Font.Color := clyellow;
//      Font.Style := [fsItalic, fsBold];
      TextOut(GetSystemMetrics(SM_CYMENU) + GetSystemMetrics(SM_CXBORDER),
              Round((GetSystemMetrics(SM_CYCAPTION) - Abs(Font.Height))/2) + 1, form1.Caption );
    end;
  finally
    ReleaseDC(Form1.Handle, ACanvas.Handle);
    ACanvas.Free;
  end;
end;

procedure TForm1.WMNCActivate(var Msg: TWMNCActivate);
var
  ACanvas : TCanvas;
begin
  inherited;
  ACanvas := TCanvas.Create;
  try
    ACanvas.Handle := GetWindowDC(Form1.Handle);
    with ACanvas do begin
      Brush.Color := clActiveCaption;
//      Font.Name := 'Tahoma';
      Font.Size := 12;
      Font.Color := clyellow;
//      Font.Style := [fsItalic, fsBold];
      TextOut(GetSystemMetrics(SM_CYMENU) + GetSystemMetrics(SM_CXBORDER),
              Round((GetSystemMetrics(SM_CYCAPTION) - Abs(Font.Height))/2) + 1, form1.Caption );
    end;
  finally
    ReleaseDC(Form1.Handle, ACanvas.Handle);
    ACanvas.Free;
  end;
end;

procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;
  var Handled: Boolean);
var
i: SmallInt;
begin
if Msg.message = WM_MOUSEWHEEL then
begin
Msg.message := WM_KEYDOWN;
Msg.lParam := 0;
i := HiWord(Msg.wParam) ;
if i > 0 then
Msg.wParam := VK_UP
else
Msg.wParam := VK_DOWN;
Handled := False;
end;
end;

procedure TForm1.FileListBox1DblClick(Sender: TObject);
begin
  form1.Caption:='DBF数据库文件浏览器: '+filelistbox1.FileName;
  form1.Repaint;
  dbf1.Close;
  dbf1.FilePath:=ExtractFilePath(filelistbox1.FileName);
  dbf1.FilePathFull:=ExtractFilePath(filelistbox1.FileName);
  dbf1.TableName:=ExtractFileName(filelistbox1.FileName);
  dbf1.Open;
end;

procedure TForm1.DBGrid1DblClick(Sender: TObject);
begin
  if dbgrid1.SelectedField.DataType=ftMemo then
  begin
    form2.DBMemo1.DataSource:=datasource1;
    form2.DBMemo1.DataField:=DBGrid1.SelectedField.fieldName;
    form2.Caption:='DBF.Memo字段编辑窗口：'+inttostr(datasource1.DataSet.RecNo)+' '+DBGrid1.SelectedField.fieldName;
    form2.ShowModal;
  end;
  if DBGrid1.SelectedField.DataType = ftBoolean then
    SaveBoolean();
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
//  ImageList1.ResInstLoad(FindResourceHInstance(FindHInstance(pointer(HInstance))),rtBitmap,'BCHK',clWhite);
  if ParamCount>0 then
  begin
    form1.Caption:='DBF数据库文件浏览器: '+ParamStr(1);
    filelistbox1.FileName:=ParamStr(1);
    dbf1.Close;
    dbf1.FilePath:=ExtractFilePath(ParamStr(1));
    dbf1.FilePathFull:=ExtractFilePath(ParamStr(1));
    dbf1.TableName:=ExtractFileName(ParamStr(1));
    dbf1.Open;
  end;
end;

procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
  DataCol: Integer; Column: TColumn; State: TGridDrawState);
{var r:trect;
    x,y:Integer;
begin
  r:=rect;
  if (column.Field.DataType=ftBoolean) and (not(gdSelected in state)) then
  begin
    dbgrid1.Canvas.FillRect(rect);
    x:=r.Left+(r.Right-r.Left) div 2-6;
    y:=r.Top+(r.Bottom-r.Top) div 2-6;
    if dbf1.FieldByName(column.FieldName).AsBoolean then
      ImageList1.Draw(DBGrid1.Canvas,x,y,0,true)
    else
      ImageList1.Draw(DBGrid1.Canvas,x,y,1,true)
  end;
end;
}
const
// 这个整数值将按照布尔值返回，并送入数组
CtrlState : array[Boolean] of Integer = (DFCS_BUTTONCHECK,DFCS_BUTTONCHECK or DFCS_CHECKED);
begin
//确保只有在逻辑字段才能插入组件
  if Column.Field.DataType = ftBoolean then
  begin
    DBGrid1.Canvas.FillRect(Rect);
    DrawFrameControl(DBGrid1.Canvas.Handle,Rect,DFC_BUTTON,CtrlState[Column.Field.AsBoolean]);
  end;
end;


procedure TForm1.DBGrid1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (key=VK_RETURN) and (DBGrid1.SelectedField.DataType=ftMemo) then
    begin
      form2.DBMemo1.DataSource:=datasource1;
      form2.DBMemo1.DataField:=DBGrid1.SelectedField.fieldName;
      form2.Caption:='DBF.Memo字段编辑窗口：'+inttostr(datasource1.DataSet.RecNo)+' '+DBGrid1.SelectedField.fieldName;
      form2.ShowModal;
    end;
  if ( Key = VK_SPACE ) and (DBGrid1.SelectedField.DataType = ftBoolean) then
    SaveBoolean();
end;

procedure TForm1.SaveBoolean;
begin
  DBGrid1.SelectedField.Dataset.Edit;
  DBGrid1.SelectedField.AsBoolean :=not DBGrid1.SelectedField.AsBoolean;
  DBGrid1.SelectedField.Dataset.Post;
end;

procedure TForm1.FormPaint(Sender: TObject);
var
  ACanvas : TCanvas;
begin
  inherited;
  ACanvas := TCanvas.Create;
  try
    ACanvas.Handle := GetWindowDC(Form1.Handle);
    with ACanvas do begin
      Brush.Color := clActiveCaption;
//      Rectangle(0, 0, Form1.Width, Form1.Height);
//      Font.Name := 'Tahoma';
      Font.Size := 12;
      Font.Color := clyellow;
//      Font.Style := [fsItalic, fsBold];
      TextOut(GetSystemMetrics(SM_CYMENU) + GetSystemMetrics(SM_CXBORDER),
              Round((GetSystemMetrics(SM_CYCAPTION) - Abs(Font.Height))/2) + 1, form1.Caption );
    end;
  finally
    ReleaseDC(Form1.Handle, ACanvas.Handle);
    ACanvas.Free;
  end;
end;

procedure TForm1.DBGrid1ColEnter(Sender: TObject);
begin
// 确保该栏是逻辑字段
  if DBGrid1.SelectedField.DataType = ftBoolean then
  begin
    OriginalOptions := DBGrid1.Options;
    DBGrid1.Options := DBGrid1.Options - [dgEditing];
  end;
end;

procedure TForm1.DBGrid1ColExit(Sender: TObject);
begin
//确保该栏是逻辑字段
  if DBGrid1.SelectedField.DataType = ftBoolean then
    DBGrid1.Options := OriginalOptions;
end;

procedure TForm1.DriveComboBox1Change(Sender: TObject);
begin
  directorylistbox1.SetFocus;
end;

end.