$TYPECHECK ON
$APPTYPE GUI
$OPTION ICON "database.ico"
$OPTIMIZE ON
$INCLUDE "RAPIDQ.INC"
$INCLUDE "ACE32.INC"
CONST LVM_FIRST = &H1000
CONST LVM_SETEXTENDEDLISTVIEWSTYLE = LVM_FIRST + 54
CONST LVM_DELETECOLUMN = LVM_FIRST + 28
CONST LVEX_GRIDLINES = 1
CONST LVEX_SUBITEMIMAGES = 2
CONST LVEX_CHECKBOXES = 4
CONST LVEX_TRACKSELECT = 8
CONST LVEX_HEADERDRAGDROP = 16
CONST LVEX_FULLROWSELECT = 32
CONST LVEX_ONECLICKACTIVATE = 64
CONST LVEX_TWOCLICKACTIVATE = 128
CONST WS_EX_CLIENTEDGE = &H200
CONST WM_COMMAND = &H111
CONST BN_CLICKED = 0
CONST BN_PAINT = 1
CONST BN_HILITE = 2
CONST BN_UNHILITE = 3
CONST BM_DOUBLECLICKED = 4
PUBLIC CONST LVCF_FMT=1
PUBLIC CONST LVCF_WIDTH=2
PUBLIC CONST LVCF_TEXT=4
PUBLIC CONST LVCF_SUBITEM=8
PUBLIC CONST LVCFMT_LEFT=0
PUBLIC CONST LVCFMT_RIGHT=1
PUBLIC CONST LVCFMT_CENTER=2
PUBLIC CONST LVCFMT_JUSTIFYMASK=3
Public CONST WS_OVERLAPPED = &H0&
Public CONST WS_POPUP = &H80000000
Public CONST WS_CHILD = &H40000000
Public CONST WS_MINIMIZE = &H20000000
Public CONST WS_VISIBLE = &H10000000
Public CONST WS_DISABLED = &H8000000
Public CONST WS_CLIPSIBLINGS = &H4000000
Public CONST WS_CLIPCHILDREN = &H2000000
Public CONST WS_MAXIMIZE = &H1000000
Public CONST WS_CAPTION = &HC00000
Public CONST WS_BORDER = &H800000
Public CONST WS_DLGFRAME = &H400000
Public CONST WS_VSCROLL = &H200000
Public CONST WS_HSCROLL = &H100000
Public CONST WS_SYSMENU = &H80000
Public CONST WS_THICKFRAME = &H40000
Public CONST WS_GROUP = &H20000
Public CONST WS_TABSTOP = &H10000
Public CONST WS_MINIMIZEBOX = &H20000
Public CONST WS_MAXIMIZEBOX = &H10000
Public CONST WS_TILED = WS_OVERLAPPED
Public CONST WS_ICONIC = WS_MINIMIZE
Public CONST WS_SIZEBOX = WS_THICKFRAME
Public CONST WS_OVERLAPPEDWINDOW = (WS_OVERLAPPED OR WS_CAPTION OR WS_SYSMENU OR WS_THICKFRAME OR WS_MINIMIZEBOX OR WS_MAXIMIZEBOX)
Public CONST WS_TILEDWINDOW = WS_OVERLAPPEDWINDOW
Public CONST WM_SETFONT = &H30
DECLARE FUNCTION CreateWindowEx LIB "USER32" ALIAS "CreateWindowExA" _
(ExStyle&, ClassName$, WindowName$, Style&, X&, Y&, _
Width&, Height&, WndParent&, hMenu&, hInstance&, Param&) AS LONG
DECLARE FUNCTION GetModuleHandle LIB "KERNEL32" ALIAS "GetModuleHandleA" _
(ModuleName AS STRING) AS LONG
DECLARE FUNCTION SetWindowText LIB "USER32" ALIAS "SetWindowTextA" _
(Hwnd AS INTEGER, Text AS STRING) AS LONG
DECLARE FUNCTION MoveWindow LIB "USER32" ALIAS "MoveWindow" ( hwdn&, X&, Y&, Width&, Height&, refresh&) AS LONG
DECLARE FUNCTION xSendMessage LIB "user32" ALIAS "SendMessageA" (hwnd AS INTEGER, wmsg AS INTEGER, wparam AS INTEGER, lparam AS LONG) AS LONG
DECLARE FUNCTION LoadCursor LIB "USER32" ALIAS "LoadCursorA" (hinst AS LONG, hcursor AS LONG) AS LONG
DECLARE FUNCTION SetCursor LIB "USER32" ALIAS "SetCursor" (hcursor AS LONG) AS LONG
DECLARE FUNCTION ShowCursor LIB "USER32" ALIAS "ShowCursor" (xbool AS INTEGER) AS LONG
TYPE LV_ITEM
mask AS INTEGER
iItem AS INTEGER
iSubItem AS INTEGER
state AS INTEGER
stateMask AS INTEGER
pszText AS LONG
cchTextMax AS INTEGER
iImage AS INTEGER
lParam AS LONG
END TYPE
TYPE LV_COLUMN
mask AS INTEGER
fmt AS INTEGER
cx AS INTEGER
pszText AS LONG
cchTextMax AS INTEGER
iSubItem AS INTEGER
END TYPE
DECLARE SUB BROWINIT
DECLARE SUB GetFile(Sender AS QBUTTON)
DECLARE SUB DBROWEND(Sender AS QBUTTON)
DECLARE SUB MainSize(Sender AS QFORM)
DECLARE SUB MainPaint(Sender AS QFORM)
DIM hTable AS LONG, dbfname AS STRING, dbrw AS LONG
DIM dfont AS QFONT
dFont.Charset=238
dFont.Name="Arial"
dFont.Size=8
dFont.AddStyles(fsBold)
DIM cfont AS QFONT
cFont.Charset=238
cFont.Name="Courier New"
cFont.Size=8
cFont.AddStyles(fsBold)
CREATE DBrow AS QFORM
CAPTION = "XBase file browser"
Width=600
Height=420
Font = dfont
OnReSize = MainSize
OnPaint = MainPaint
Center
CREATE dadd AS QBUTTON
CAPTION = "&Get File"
Left = 4
Top = 366
Height=24
Width=60
TabOrder = 2
OnClick = GetFile
END CREATE
CREATE dend AS QBUTTON
CAPTION = "E&xit"
Left = 530
Top = 366
Height=24
Width=60
TabOrder = 6
OnClick = DBrowEnd
END CREATE
END CREATE
dbrw=CreateWindowEx(512,"SysListView32","", 4 OR 8 OR 1 OR WS_CHILD OR WS_TABSTOP OR WS_VISIBLE, _
2,4,584,358,DBrow.Handle, 201, GetModuleHandle("XBROW.EXE"),0)
SendMessage(dbrw, LVM_SETEXTENDEDLISTVIEWSTYLE, 0, LVEX_FULLROWSELECT OR LVEX_HEADERDRAGDROP OR 1)
SendMessage(dbrw, WM_SETFONT, cFont.Handle, 1 )
dbfname=""
htable=0
AdsSetServerType(1)
IF COMMANDCOUNT > 0 THEN
dbfname=COMMAND$(1)
IF FILEEXISTS(dbfname) THEN
BROWINIT
ELSE
MESSAGEBOX("File "+dbfname+" does not exit !","Error !",48)
END IF
ELSE
GetFile(dadd)
END IF
DBrow.SHOWMODAL
END
SUB BROWINIT()
DIM ulRetVal AS LONG, i AS INTEGER, t AS INTEGER, bEof AS INTEGER, ulNumRecs AS LONG, usCount AS INTEGER, ctmp AS STRING, ulFldLen AS LONG , ulRec AS LONG
DIM lvcol AS LV_COLUMN, lvi AS LV_ITEM, uiFldType AS INTEGER, hcsr AS LONG, ocsr AS LONG
hTable=0
DBrow.Cursor = crHourGlass
ulRetVal=xSendMessage(dbrw, &H1000+28, 0, 0)
WHILE ulRetVal<>0
ulRetVal=xSendMessage(dbrw, &H1000+28, 0, 0)
WEND
SendMessage(dbrw, &H1000+9, 0, 0)
ulRetVal = AdsOpenTable( 0, dbfname, "DBFILE", ADS_NTX, ADS_ANSI, ADS_COMPATIBLE_LOCKING, ADS_CHECKRIGHTS, ADS_DEFAULT, @hTable )
IF ulRetVal <> AE_SUCCESS THEN
AdsShowError("ADS Couldn't open table" )
EXIT SUB
END IF
AdsGetRecordCount( hTable, ADS_IGNOREFILTERS, @ulNumRecs )
AdsGetNumFields( hTable, @usCount )
DIM aFldN(usCount) AS STRING
DIM aFldT(usCount) AS INTEGER
DIM aFldL(uscount) AS INTEGER
lvcol.mask=LVCF_FMT OR LVCF_WIDTH OR LVCF_TEXT OR LVCF_SUBITEM
FOR t=1 TO usCount
ctmp=SPACE$(512)
i=512
AdsGetFieldName(hTable, t, @ctmp, @i)
ctmp=LEFT$(ctmp, i)
aFldN(t)=ctmp
AdsGetFieldLength(hTable, ctmp, @ulFldLen)
aFldL(t)=ulFldLen
AdsGetFieldType(htable, @ctmp, @uiFldType)
aFldT(t)=uiFldType
SELECT CASE aFldT(t)
CASE ADS_CURDOUBLE
lvcol.fmt = 1
CASE ADS_SHORTINT
lvcol.fmt = 1
CASE ADS_INTEGER
lvcol.fmt = 1
CASE ADS_DOUBLE
lvcol.fmt = 1
CASE ADS_NUMERIC
lvcol.fmt = 1
CASE ELSE
lvcol.fmt = 0
END SELECT
lvcol.cx = ulFldLen *10
lvcol.pszText=VARPTR(ctmp)
lvcol.iSubItem=t-1
SendMessage(dbrw, &H1000+27, t-1, @lvcol)
NEXT
AdsGotoTop(hTable)
AdsAtEOF(hTable, @bEof )
WHILE bEof=0
AdsGetRecordNum(hTable, ADS_IGNOREFILTERS, @ulRec)
ctmp=SPACE$(256)
i=256
AdsGetField(hTable, aFldn(1), @ctmp, @i, ADS_TRIM)
lvi.mask=1
lvi.state=0
lvi.stateMask=0
lvi.iImage=0
lvi.iSubItem=0
lvi.iItem=ulRec-1
lvi.pszText=VARPTR(ctmp)
lvi.cchTextMax=LEN(ctmp)
SendMessage(dbrw, &H1000+7, 0, @lvi)
FOR t=2 TO usCount
ctmp=SPACE$(256)
i=256
AdsGetField(hTable, aFldN(t), @ctmp, @i, ADS_TRIM)
lvi.iSubItem=t-1
lvi.pszText=VARPTR(ctmp)
SendMessage(dbrw, &H1000+46, ulRec-1, @lvi)
NEXT
AdsSkip(hTable, 1)
AdsAtEOF( hTable, @bEof )
WEND
AdsGotoTop(hTable)
DBrow.CAPTION="XBase file browser "+dbfname
DBrow.Cursor = crDefault
END SUB
SUB GETFILE
DIM od AS QOPENDIALOG
od.CAPTION="Select a XBASE file to Browse"
od.Filter="XBase files|*.dbf|"
od.FilterIndex=1
IF od.EXECUTE THEN
IF hTable<>0 THEN
AdsCloseTable(hTable)
hTable=0
END IF
dbfname=od.Filename
BROWINIT()
END IF
END SUB
SUB DBROWEND
AdsCloseTable(hTable)
hTable=0
DBrow.CLOSE
END SUB
SUB MainPaint (Sender AS QFORM)
Sender.Line(0,Sender.Height-66,Sender.Width,Sender.Height-66,0)
Sender.Line(0,Sender.Height-65,Sender.Width,Sender.Height-65,&HFFFFFF)
END SUB
SUB MainSize(Sender AS QFORM)
MoveWindow(dbrw, 2, 4, Sender.Width -12, Sender.Height - 76, 1)
MoveWindow(dadd.Handle, 4, Sender.Height-58, 60,24, 1)
MoveWindow(dend.Handle, Sender.Width-70, Sender.Height-58, 60,24, 1)
END SUB
|
|
搜索
论坛
Home
回顶部
g.yi.org Hits:0 Last modified:2003-02-24 13:44:04
