I'm looking for a small (in size) report designer tool with the possibilities of Quickreport (Delphi). It should be easy for the enduser to create a report based on a limited set of tables/views from their database.
Maybe we can start a project to develop this ?
The PrintingLibEx from Fraiser72 could be a good start ?
Creating a report designer ?
-
the.weavster
- Addict
- Posts: 1581
- Joined: Thu Jul 03, 2003 6:53 pm
- Location: England
-
radtke.i.j
- New User
- Posts: 9
- Joined: Sat Jan 28, 2006 8:58 pm
- Location: Germany, MVP
-
dell_jockey
- Enthusiast
- Posts: 767
- Joined: Sat Jan 24, 2004 6:56 pm
-
radtke.i.j
- New User
- Posts: 9
- Joined: Sat Jan 28, 2006 8:58 pm
- Location: Germany, MVP
-
collectordave
- Addict
- Posts: 1310
- Joined: Fri Aug 28, 2015 6:10 pm
- Location: Portugal
Re: Creating a report designer ?
I have a need for a simple report designer and printer. Found this topic so will post here.
I would like the code to be freely available to all with no API calls, just using native Pure Basic commands and cross platform compatible. Hopefully as a series of modules.
1. Report designer
2. Simple Query builder
3. Page Setup
4. Report printer
I can test on Windows 7 and MAC but have no Linux machine can anyone help test as the modules are coded?
This will be based only on SQLite to keep things as simple as possible but if anyone would like to take up the cudgel and modify the code for other databases it would be great.
So to get the ball rolling here is the code for number 2 a simple Query Builder. It allows you to open a database and then either type in a query to test or build a simple SELECT query from a single table or view. I have included views as more complex queries can be built and stored in the database. These can restrict the database user to accessing only what you wish and could also be used to make queries a little more understandable to the avarage user, by hiding RecordIDs etc.
If you wish to follow this then I suggest you create a folder called "Report Designer" and create a project for the same then copy all code etc into the folder and add the files to the project.
Here is the code for the main form frmMain.pb. This is just a throwaway form as it will change as more modules are coded.
And here is the module "Simple Query Builder.pbi".
Hope this is of use to someone
I would like the code to be freely available to all with no API calls, just using native Pure Basic commands and cross platform compatible. Hopefully as a series of modules.
1. Report designer
2. Simple Query builder
3. Page Setup
4. Report printer
I can test on Windows 7 and MAC but have no Linux machine can anyone help test as the modules are coded?
This will be based only on SQLite to keep things as simple as possible but if anyone would like to take up the cudgel and modify the code for other databases it would be great.
So to get the ball rolling here is the code for number 2 a simple Query Builder. It allows you to open a database and then either type in a query to test or build a simple SELECT query from a single table or view. I have included views as more complex queries can be built and stored in the database. These can restrict the database user to accessing only what you wish and could also be used to make queries a little more understandable to the avarage user, by hiding RecordIDs etc.
If you wish to follow this then I suggest you create a folder called "Report Designer" and create a project for the same then copy all code etc into the folder and add the files to the project.
Here is the code for the main form frmMain.pb. This is just a throwaway form as it will change as more modules are coded.
Code: Select all
EnableExplicit
IncludeFile "Simple Query Builder.pbi"
Global Window_0.i,frmQueryBuilder.i
Global btnSelectDB, strDBName, btnBuildQuery, strQuery
Global MyDB.s,Pattern.s
Define Event.i
Procedure.i IsValidPBEvent(Event)
Select event
Case #PB_Event_Menu, ; a menu has been selected
#PB_Event_Gadget , ; a gadget has been pushed
#PB_Event_SysTray, ; an icon in the systray zone was clicked
#PB_Event_Timer , ; a timer has reached its timeout
#PB_Event_CloseWindow, ; the window close gadget has been pushed
#PB_Event_Repaint, ; the window content has been destroyed
#PB_Event_SizeWindow, ; the window has been resized
#PB_Event_MoveWindow, ; the window has been moved
#PB_Event_MinimizeWindow, ; the window has been minimized
#PB_Event_MaximizeWindow, ; the window has been maximized
#PB_Event_RestoreWindow, ; the window has been restored To normal size
#PB_Event_ActivateWindow, ; the window has been activated (got the focus)
#PB_Event_DeactivateWindow,; the window has been deactivated (lost the focus)
#PB_Event_WindowDrop, ; a Drag & Drop operation was finished on a window
#PB_Event_GadgetDrop, ; a Drag & Drop operation was finished on a gadget
#PB_Event_RightClick, ; a right mouse button click has occurred on the window.
#PB_Event_LeftClick, ; a left mouse button click has occurred on the window
#PB_Event_LeftDoubleClick ; a left mouse button double-click has occurred on the window
ProcedureReturn #True
Default
ProcedureReturn #False
EndSelect
EndProcedure
Procedure Event_Handler(Event)
Select Event
Case #PB_Event_CloseWindow
End
Case #PB_Event_Gadget
Select EventGadget()
Case btnSelectDB
Pattern = "Database (*.db)|*.db;|All files (*.*)|*.*"
MyDB = OpenFileRequester("Please choose Database", GetCurrentDirectory(), Pattern, 0)
If MyDB
SetGadgetText(strDBName,MyDB)
Else
SetGadgetText(strDBName,"")
EndIf
Case btnBuildQuery
If Not IsWindow(frmQueryBuilder)
If MyDB
frmQueryBuilder = QueryBuilder::Open(MyDB)
Else
MessageRequester("Information","No Database Selected!",#PB_MessageRequester_Ok)
SetActiveGadget(btnSelectDB)
EndIf
Else
MessageRequester("Information","Query Builder Form Allready Open!",#PB_MessageRequester_Ok)
SetActiveWindow(frmQueryBuilder)
EndIf
EndSelect
EndSelect
EndProcedure
Window_0 = OpenWindow(#PB_Any, 20, 20, 600, 70, "", #PB_Window_SystemMenu)
btnSelectDB = ButtonGadget(#PB_Any, 10, 10, 100, 20, "Select Database")
strDBName = StringGadget(#PB_Any, 120, 10, 470, 20, "")
btnBuildQuery = ButtonGadget(#PB_Any, 10, 40, 100, 20, "Build Query")
strQuery = StringGadget(#PB_Any, 120, 40, 470, 20, "")
MyDB = ""
Repeat
Event = WaitWindowEvent()
If IsValidPBEvent(Event)
Select EventWindow()
Case Window_0
Event_Handler(Event)
Case frmQueryBuilder
QueryBuilder::Event_Handler(Event)
If QueryBuilder::Query > ""
SetGadgetText(strQuery,QueryBuilder::Query)
Else
SetGadgetText(strQuery,"")
EndIf
EndSelect
EndIf
ForEver
And here is the module "Simple Query Builder.pbi".
Code: Select all
DeclareModule QueryBuilder
Global Query.s
Declare.i Open(MyDB.s)
Declare Event_Handler(Event)
EndDeclareModule
Module QueryBuilder
EnableExplicit
UseSQLiteDatabase()
;Where Clause Gadgets
Structure UserClause
strFieldID.i
strClauseID.i
strConditionID.i
EndStructure
Global Dim WhereClause.UserClause(3)
Structure FData
Name.s
Type.i
EndStructure
Global Dim FieldData.FData(0)
Global QueryDB.l
Global ThisWindow.l
Global Query.s
;String Gadgets
Global strQuery.i
Global strC1Condition.i,strC2Condition.i,strC3Condition.i
;Buttons
Global btnAllFields.i,btnSelectedFields.i,btnOk.i,btnCancel.i,btnTest.i,btnNew.i,btnBuild.i
Global btnC1FieldSelect.i,btnC2FieldSelect.i,btnC3FieldSelect.i
;Combos and Lists
Global cmbTables.i,lstAvailableFields.i,lstSelectedFields.i,LstResult.i
Procedure.l Open_Database(DBName.s)
Define DBHnd.l
;Open Main Database
DBHnd.l = OpenDatabase(#PB_Any,DBName.s, "", "")
If DBHnd.l = 0
MessageRequester("Database Error","Failed to open Database!", #PB_MessageRequester_Ok )
ProcedureReturn 0
Else
ProcedureReturn DBHnd.l
EndIf
EndProcedure
Procedure ShowTables()
Define ObjType.s
ClearGadgetItems(cmbTables)
DatabaseQuery(QueryDB, "SELECT * FROM sqlite_master;")
FirstDatabaseRow(QueryDB)
ObjType = GetDatabaseString(QueryDB,DatabaseColumnIndex(QueryDB, "type"))
If ObjType = "table" Or ObjType = "view"
AddGadgetItem(cmbTables,-1,GetDatabaseString(QueryDB,DatabaseColumnIndex(QueryDB, "tbl_name")))
EndIf
While NextDatabaseRow( QueryDB)
ObjType = GetDatabaseString(QueryDB,DatabaseColumnIndex(QueryDB, "type"))
If ObjType = "table" Or ObjType = "view"
AddGadgetItem(cmbTables,-1,GetDatabaseString(QueryDB,DatabaseColumnIndex(QueryDB, "tbl_name")))
EndIf
Wend
FinishDatabaseQuery(QueryDB) ;free the query
EndProcedure
Procedure.i GetColumnType(FieldNum.i)
Select DatabaseColumnType(QueryDB, FieldNum)
Case #PB_Database_Blob
ProcedureReturn 3 ;Blob
Case #PB_Database_Long ,#PB_Database_Float,#PB_Database_Double ,#PB_Database_Quad
ProcedureReturn 1 ;Numeric
Case #PB_Database_String
ProcedureReturn 2 ;Text
Default
ProcedureReturn 0 ;Unknown
EndSelect
EndProcedure
Procedure ShowFields(TableName.s)
ClearGadgetItems(lstAvailableFields)
Define iloop.i = 0
Define txt.s = ""
DatabaseQuery(QueryDB, "SELECT * FROM " + TableName + ";")
FirstDatabaseRow(QueryDB)
ReDim FieldData(DatabaseColumns(QueryDB))
For iloop = 0 To DatabaseColumns(QueryDB) -1
txt = DatabaseColumnName(QueryDB, iloop)
FieldData(iloop)\Name = DatabaseColumnName(QueryDB, iloop)
fielddata(iloop)\Type = GetColumnType(iloop)
AddGadgetItem(lstAvailableFields,-1,txt )
Next
FinishDatabaseQuery(QueryDB) ;free the query
EndProcedure
Procedure LoadOperators(CmbID.i,Type.i)
ClearGadgetItems(WhereClause(CmbID)\strClauseID)
Select Type
Case 1 ;Numeric
AddGadgetItem(WhereClause(CmbID)\strClauseID,-1,"=")
SetGadgetItemData(WhereClause(CmbID)\strClauseID, 0, 3)
AddGadgetItem(WhereClause(CmbID)\strClauseID,-1,"<")
SetGadgetItemData(WhereClause(CmbID)\strClauseID, 1, 4)
AddGadgetItem(WhereClause(CmbID)\strClauseID,-1,"<=")
SetGadgetItemData(WhereClause(CmbID)\strClauseID, 2, 5)
AddGadgetItem(WhereClause(CmbID)\strClauseID,-1,">")
SetGadgetItemData(WhereClause(CmbID)\strClauseID, 3, 6)
AddGadgetItem(WhereClause(CmbID)\strClauseID,-1,">=")
SetGadgetItemData(WhereClause(CmbID)\strClauseID, 4, 7)
Case 2 ;Text
AddGadgetItem(WhereClause(CmbID)\strClauseID,-1,"=")
SetGadgetItemData(WhereClause(CmbID)\strClauseID, 0, 1)
AddGadgetItem(WhereClause(CmbID)\strClauseID,-1,"LIKE")
SetGadgetItemData(WhereClause(CmbID)\strClauseID, 1, 2)
EndSelect
EndProcedure
Procedure Clear_Gadgets()
Define iloop.i = 0
Define ColCount.i = 0
SetGadgetText(strQuery,"")
ClearGadgetItems(lstAvailableFields)
ClearGadgetItems(lstSelectedFields)
SetGadgetText(WhereClause(0)\strFieldID,"")
SetGadgetText(WhereClause(1)\strFieldID,"")
SetGadgetText(WhereClause(2)\strFieldID,"")
SetGadgetText(WhereClause(0)\strConditionID,"")
SetGadgetText(WhereClause(1)\strConditionID,"")
SetGadgetText(WhereClause(2)\strConditionID,"")
DisableGadget(WhereClause(0)\strConditionID, 1)
DisableGadget(WhereClause(1)\strConditionID, 1)
DisableGadget(WhereClause(2)\strConditionID, 1)
ClearGadgetItems(WhereClause(0)\strClauseID)
ClearGadgetItems(WhereClause(1)\strClauseID)
ClearGadgetItems(WhereClause(2)\strClauseID)
DisableGadget(WhereClause(0)\strClauseID, 1)
DisableGadget(WhereClause(1)\strClauseID, 1)
DisableGadget(WhereClause(2)\strClauseID, 1)
ClearGadgetItems(lstResult)
While GetGadgetItemText(lstResult,-1,ColCount) <> ""
ColCount + 1 ; count the columns
Wend
For iloop = ColCount To 1 Step -1 ;Do not remove column 0
RemoveGadgetColumn(lstResult, iloop)
Next
SetGadgetItemText(lstResult, -1, "Results" ,0)
EndProcedure
Procedure UpDateTableData(BQuery.s)
Define iloop.i = 0
ClearGadgetItems(lstResult)
For iloop = 1 To 10
RemoveGadgetColumn(lstResult, iloop) ; Remove the 'Column 2'
Next
Define txt.s = ""
DatabaseQuery(QueryDB, BQuery.s)
FirstDatabaseRow(QueryDB)
SetGadgetItemText(lstResult, -1, DatabaseColumnName(QueryDB, 0) ,0)
For iloop = 1 To DatabaseColumns(QueryDB) -1
AddGadgetColumn(lstResult, iloop, DatabaseColumnName(QueryDB, iloop), 100)
Next
txt = GetDatabaseString(QueryDB,0) + Chr(10)
For iloop = 1 To DatabaseColumns(QueryDB) -1
txt = txt + GetDatabaseString(QueryDB,iloop) + Chr(10)
Next
AddGadgetItem(lstResult, -1, txt)
While NextDatabaseRow(QueryDB)
txt = ""
For iloop = 0 To DatabaseColumns(QueryDB) -1
txt = txt + GetDatabaseString(QueryDB,iloop) + Chr(10)
Next
AddGadgetItem(lstResult, -1, txt)
Wend
FinishDatabaseQuery(QueryDB) ;free the query
EndProcedure
Procedure BuildQuery()
Define iLoop.i
If CountGadgetItems(lstSelectedFields) > 0
;Build Query
Query = "SELECT "
For iloop = 0 To CountGadgetItems(lstSelectedFields) - 1
Query = Query + GetGadgetItemText(lstSelectedFields,iloop) + ","
Next
;remove last comma
Query = Left(Query, Len(Query)-1)
Query = Query + " FROM " + GetGadgetText(cmbTables)
Define Field.s,Clause.s,Condition.s
;Add WHERE Clause
For iLoop = 0 To 2
Field = GetGadgetText(WhereClause(iLoop)\strFieldID)
Clause = GetGadgetText(WhereClause(iLoop)\strClauseID)
Condition = GetGadgetText(WhereClause(iLoop)\strConditionID)
If Field > "" And Clause > "" And Condition > ""
If iLoop = 0
Query = Query + " WHERE "
Else
Query = Query + " AND "
EndIf
Select GetGadgetItemData(WhereClause(iLoop)\strClauseID,GetGadgetState(WhereClause(iLoop)\strClauseID))
Case 1 ;String =
Query = Query + Field + " = '" + Condition + "' "
Case 2 ;String LIKE
Query = Query + Field + " " + " LIKE '%" + Condition + "%'"
Case 3 ;Number =
Query = Query + Field + " " + " = " + Condition
Case 4 ;Number <
Query = Query + Field + " < " + Condition
Case 5 ;Number <=
Query = Query + Field + " <= " + Condition
Case 6 ;Number >
Query = Query + Field + " > " + Condition
Case 7 ;Number >=
Query = Query + Field + " >=" + Condition
EndSelect
EndIf
Next iLoop
Query = Query + ";"
SetGadgetText(strQuery,Query)
EndIf
EndProcedure
Procedure.i Open(MyDB.s)
QueryDB = Open_Database(MyDB)
If QueryDB = 0
ProcedureReturn 0
EndIf
ThisWindow = OpenWindow(#PB_Any, 50, 150, 790, 400, "Simple Query Builder", #PB_Window_SystemMenu)
TextGadget(#PB_Any, 10, 10, 150, 20, "Select Table\View")
cmbTables = ComboBoxGadget(#PB_Any, 10, 30, 150, 20)
TextGadget(#PB_Any, 170, 10, 150, 20, "Query")
strQuery = StringGadget(#PB_Any, 170, 30, 610, 20, "")
TextGadget(#PB_Any, 10, 60, 150, 20, "Available Fields")
lstAvailableFields = ListViewGadget(#PB_Any, 10, 90, 150, 170, #PB_ListView_MultiSelect)
btnSelectedFields = ButtonGadget(#PB_Any, 170, 90, 30, 30, ">")
GadgetToolTip(btnSelectedFields, "Add Selected")
btnAllFields = ButtonGadget(#PB_Any, 170, 130, 30, 30, ">>")
GadgetToolTip(btnAllFields, "Add All")
TextGadget(#PB_Any, 210, 60, 150, 20, "Selected Fields")
lstSelectedFields = ListViewGadget(#PB_Any, 210, 90, 150, 170)
btnBuild = ButtonGadget(#PB_Any, 370, 230, 70, 30, "Build")
btnTest = ButtonGadget(#PB_Any, 450, 230, 70, 30, "Test")
btnNew = ButtonGadget(#PB_Any, 530, 230, 70, 30, "New")
btnCancel = ButtonGadget(#PB_Any, 630, 230, 70, 30, "Cancel")
btnOk = ButtonGadget(#PB_Any, 710, 230, 70, 30, "Ok")
GadgetToolTip(btnTest, "Test Query")
TextGadget(#PB_Any, 370, 60, 150, 20, "WHERE")
btnC1FieldSelect = ButtonGadget(#PB_Any, 370, 90, 30, 20, ">")
GadgetToolTip(btnC1FieldSelect, "Select Field")
WhereClause(0)\strFieldID = StringGadget(#PB_Any, 410, 90, 150, 20, "", #PB_String_ReadOnly)
SetGadgetColor(WhereClause(0)\strFieldID, #PB_Gadget_BackColor,RGB(255,255,255))
GadgetToolTip(WhereClause(0)\strFieldID, "Selected Field Read Only")
WhereClause(0)\strClauseID = ComboBoxGadget(#PB_Any, 570, 90, 60, 20)
DisableGadget(WhereClause(0)\strClauseID, 1)
WhereClause(0)\strConditionID = StringGadget(#PB_Any, 640, 90, 140, 20, "")
DisableGadget(WhereClause(0)\strConditionID, 1)
btnC2FieldSelect = ButtonGadget(#PB_Any, 370, 120, 30, 20, ">")
GadgetToolTip(btnC2FieldSelect, "Select Field")
WhereClause(1)\strFieldID = StringGadget(#PB_Any, 410, 120, 150, 20, "", #PB_String_ReadOnly)
SetGadgetColor(WhereClause(1)\strFieldID, #PB_Gadget_BackColor,RGB(255,255,255))
GadgetToolTip(WhereClause(1)\strFieldID, "Selected Field Read Only")
WhereClause(1)\strClauseID = ComboBoxGadget(#PB_Any, 570, 120, 60, 20)
DisableGadget(WhereClause(1)\strClauseID, 1)
WhereClause(1)\strConditionID = StringGadget(#PB_Any, 640, 120, 140, 20, "")
DisableGadget(WhereClause(1)\strConditionID, 1)
btnC3FieldSelect = ButtonGadget(#PB_Any, 370, 150, 30, 20, ">")
GadgetToolTip(btnC3FieldSelect, "Select Field")
WhereClause(2)\strFieldID = StringGadget(#PB_Any, 410, 150, 150, 20, "", #PB_String_ReadOnly)
SetGadgetColor(WhereClause(2)\strFieldID, #PB_Gadget_BackColor,RGB(255,255,255))
GadgetToolTip(WhereClause(2)\strFieldID, "Selected Field Read Only")
WhereClause(2)\strClauseID = ComboBoxGadget(#PB_Any, 570, 150, 60, 20)
DisableGadget(WhereClause(2)\strClauseID, 1)
WhereClause(2)\strConditionID = StringGadget(#PB_Any, 640, 150, 140, 20, "")
DisableGadget(WhereClause(2)\strConditionID, 1)
lstResult = ListIconGadget(#PB_Any, 0, 270, 790, 130, "Results", 100, #PB_ListIcon_GridLines)
ShowTables()
ProcedureReturn ThisWindow
EndProcedure
Procedure Event_Handler(Event)
Define iLoop.i
Select event
Case #PB_Event_Gadget
Select EventGadget()
Case btnOk
QueryBuilder::Query = GetGadgetText(strQuery)
CloseWindow(Thiswindow)
Case btncancel
QueryBuilder::Query = ""
CloseWindow(Thiswindow)
Case btnBuild
BuildQuery()
Case btnNew
Clear_Gadgets()
Case cmbTables
ShowFields(GetGadgetItemText(cmbTables,GetGadgetState(cmbTables)))
Case btnAllFields
ClearGadgetItems(lstSelectedFields)
For iLoop = 0 To CountGadgetItems(lstAvailableFields) -1
AddGadgetItem(lstSelectedFields,-1,GetGadgetItemText(lstAvailableFields,iloop))
Next
Case btnSelectedFields
ClearGadgetItems(lstSelectedFields)
For iLoop = 0 To CountGadgetItems(lstAvailableFields) -1
If GetGadgetItemState(lstAvailableFields,iLoop) = 1
AddGadgetItem(lstSelectedFields,-1,GetGadgetItemText(lstAvailableFields,iLoop))
EndIf
Next iLoop
Case btnC1FieldSelect
If GetGadgetText(lstSelectedFields) > ""
SetGadgetText(WhereClause(0)\strFieldID,GetGadgetText(lstSelectedFields))
EndIf
For iloop = 0 To CountGadgetItems(lstAvailableFields) - 1
If Trim(GetGadgetItemText(lstAvailableFields, iloop)) = Trim(GetGadgetText(WhereClause(0)\strFieldID))
LoadOperators(0,FieldData(iloop)\Type)
SetGadgetText(WhereClause(0)\strFieldID,GetGadgetText(lstSelectedFields))
SetGadgetData(WhereClause(0)\strFieldID, FieldData(iloop)\Type)
DisableGadget(WhereClause(0)\strClauseID, 0)
DisableGadget(WhereClause(0)\strConditionID, 0)
Break
EndIf
Next
Case btnC2FieldSelect
If GetGadgetText(lstSelectedFields) > ""
SetGadgetText(WhereClause(1)\strFieldID,GetGadgetText(lstSelectedFields))
EndIf
For iloop = 0 To CountGadgetItems(lstAvailableFields) - 1
If Trim(GetGadgetItemText(lstAvailableFields, iloop)) = Trim(GetGadgetText(WhereClause(1)\strFieldID))
LoadOperators(1,FieldData(iloop)\Type)
DisableGadget(WhereClause(1)\strClauseID, 0)
DisableGadget(WhereClause(1)\strConditionID, 0)
Break
EndIf
Next
Case btnC3FieldSelect
If GetGadgetText(lstSelectedFields) > ""
SetGadgetText(WhereClause(2)\strFieldID,GetGadgetText(lstSelectedFields))
EndIf
For iloop = 0 To CountGadgetItems(lstAvailableFields) - 1
If Trim(GetGadgetItemText(lstAvailableFields, iloop)) = Trim(GetGadgetText(WhereClause(2)\strFieldID))
LoadOperators(2,FieldData(iloop)\Type)
DisableGadget(WhereClause(2)\strClauseID, 0)
DisableGadget(WhereClause(2)\strConditionID, 0)
Break
EndIf
Next
Case btnBuild
BuildQuery()
Case btnTest
UpDateTableData(GetGadgetText(strQuery))
EndSelect ;EventGadget()
EndSelect ;Event
EndProcedure
EndModule
Any intelligent fool can make things bigger and more complex. It takes a touch of genius — and a lot of courage to move in the opposite direction.
-
collectordave
- Addict
- Posts: 1310
- Joined: Fri Aug 28, 2015 6:10 pm
- Location: Portugal
Re: Creating a report designer ?
Hi All again
Hopefully we have the means of allowing users to create a query based on the tables and views in the target database.
The next stage in report creation is to get hold of the paper size and orienbtation of the target page so the report can be built around the paper size on which it is to be printed.
So here is the next module Page Setup.
First is a new frmMain.pb, delete the original frmMain.pb and copy the code below into a new frmMain.pb file in the Reprt Designer project folder you created.
frmMain.pb
The Simple Query Builder stays the same and here is the code for a page setup form.
Page Setup.pbi
Add this module to the project and run. The query builder is still available and you can select Page Setup from the File menu.
Next I will be defining the main design form.
Enjoy
Hopefully we have the means of allowing users to create a query based on the tables and views in the target database.
The next stage in report creation is to get hold of the paper size and orienbtation of the target page so the report can be built around the paper size on which it is to be printed.
So here is the next module Page Setup.
First is a new frmMain.pb, delete the original frmMain.pb and copy the code below into a new frmMain.pb file in the Reprt Designer project folder you created.
frmMain.pb
Code: Select all
EnableExplicit
IncludeFile "Simple Query Builder.pbi"
IncludeFile "PageSetup.pbi"
Enumeration FormMenu
#mnuFilePageSetup
#mnuFileExit
EndEnumeration
Global frmMain.i,frmQueryBuilder.i,frmPageSetUp.i
Global btnSelectDB, strDBName, btnBuildQuery, strQuery,lstPageDetail.i
Global MyDB.s,Pattern.s
Define Event.i
Procedure.i IsValidPBEvent(Event)
Select event
Case #PB_Event_Menu, ; a menu has been selected
#PB_Event_Gadget , ; a gadget has been pushed
#PB_Event_SysTray, ; an icon in the systray zone was clicked
#PB_Event_Timer , ; a timer has reached its timeout
#PB_Event_CloseWindow, ; the window close gadget has been pushed
#PB_Event_Repaint, ; the window content has been destroyed
#PB_Event_SizeWindow, ; the window has been resized
#PB_Event_MoveWindow, ; the window has been moved
#PB_Event_MinimizeWindow, ; the window has been minimized
#PB_Event_MaximizeWindow, ; the window has been maximized
#PB_Event_RestoreWindow, ; the window has been restored To normal size
#PB_Event_ActivateWindow, ; the window has been activated (got the focus)
#PB_Event_DeactivateWindow,; the window has been deactivated (lost the focus)
#PB_Event_WindowDrop, ; a Drag & Drop operation was finished on a window
#PB_Event_GadgetDrop, ; a Drag & Drop operation was finished on a gadget
#PB_Event_RightClick, ; a right mouse button click has occurred on the window.
#PB_Event_LeftClick, ; a left mouse button click has occurred on the window
#PB_Event_LeftDoubleClick ; a left mouse button double-click has occurred on the window
ProcedureReturn #True
Default
ProcedureReturn #False
EndSelect
EndProcedure
Procedure Event_Handler(Event)
Select Event
Case #PB_Event_CloseWindow
End
Case #PB_Event_Menu
Select EventMenu()
Case #mnuFilePageSetup
;Set margins here if you wish
;PageSetup::Pagedetail\TopMargin = 10
;PageSetup::PageDetail\LeftMargin = 10
;PageSetup::PageDetail\BottomMargin = 10
;PageSetup::PageDetail\RightMargin = 10
frmPageSetUp = PageSetup::Open()
DisableWindow(frmMain, #True)
Case #mnuFileExit
End
EndSelect
Case #PB_Event_Gadget
Select EventGadget()
Case btnSelectDB
Pattern = "Database (*.db)|*.db;|All files (*.*)|*.*"
MyDB = OpenFileRequester("Please choose Database", GetCurrentDirectory(), Pattern, 0)
If MyDB
SetGadgetText(strDBName,MyDB)
Else
SetGadgetText(strDBName,"")
EndIf
Case btnBuildQuery
If Not IsWindow(frmQueryBuilder)
If MyDB
frmQueryBuilder = QueryBuilder::Open(MyDB)
Else
MessageRequester("Information","No Database Selected!",#PB_MessageRequester_Ok)
SetActiveGadget(btnSelectDB)
EndIf
Else
MessageRequester("Information","Query Builder Form Allready Open!",#PB_MessageRequester_Ok)
SetActiveWindow(frmQueryBuilder)
EndIf
EndSelect
EndSelect
EndProcedure
frmMain = OpenWindow(#PB_Any, 20, 20, 600, 350, "Temporary Report Main", #PB_Window_SystemMenu)
CreateMenu(0, WindowID(frmMain))
MenuTitle("File")
MenuItem(#mnuFilePageSetup, "Page Setup")
MenuItem(#mnuFileExit, "Exit")
btnSelectDB = ButtonGadget(#PB_Any, 10, 10, 100, 20, "Select Database")
strDBName = StringGadget(#PB_Any, 120, 10, 470, 20, "")
btnBuildQuery = ButtonGadget(#PB_Any, 10, 40, 100, 20, "Build Query")
strQuery = StringGadget(#PB_Any, 120, 40, 470, 20, "")
lstPageDetail = ListViewGadget(#PB_Any, 10, 100, 210, 180)
MyDB = ""
Repeat
Event = WaitWindowEvent()
If IsValidPBEvent(Event)
Select EventWindow()
Case frmMain
Event_Handler(Event)
Case frmQueryBuilder
QueryBuilder::Event_Handler(Event)
If Not IsWindow(frmQueryBuilder)
If QueryBuilder::Query > ""
SetGadgetText(strQuery,QueryBuilder::Query)
Else
SetGadgetText(strQuery,"")
EndIf
EndIf
Case frmPageSetUp
PageSetup::Event_Handler(Event)
If Not IsWindow(frmPageSetUp)
DisableWindow(frmMain, #False)
ClearGadgetItems(lstPageDetail)
AddGadgetItem(lstPageDetail,-1,"Page Height " + PageSetup::PageDetail\Height)
AddGadgetItem(lstPageDetail,-1,"Page Width " + PageSetup::PageDetail\Width)
AddGadgetItem(lstPageDetail,-1,"Top Margin " + PageSetup::PageDetail\TopMargin)
AddGadgetItem(lstPageDetail,-1,"Left Margin " + PageSetup::PageDetail\LeftMargin)
AddGadgetItem(lstPageDetail,-1,"Bottom Margin " + PageSetup::PageDetail\BottomMargin)
AddGadgetItem(lstPageDetail,-1,"Right Margin " + PageSetup::PageDetail\RightMargin)
If PageSetup::PageDetail\Orientation = 0
AddGadgetItem(lstPageDetail,-1,"Orientation Portrait")
Else
AddGadgetItem(lstPageDetail,-1,"Orientation Landscape")
EndIf
EndIf
EndSelect
EndIf
ForEver
Page Setup.pbi
Code: Select all
DeclareModule PageSetup
;Anything declared here is available to other modules or main form even after page setup window closure
;Page variables all default to A4
Structure Detail
Height.i
Width.i
TopMargin.i
LeftMargin.i
BottomMargin.i
RightMargin.i
Orientation.i
EndStructure
Global Pagedetail.Detail
Global OkPressed.i = #False
;Procedures needed to open and use Page Setup
Declare Event_Handler(event)
Declare.i Open()
EndDeclareModule
Module PageSetup
EnableExplicit
Structure PSize
Title.s
Width.i
Height.i
EndStructure
Global Dim PageSize.PSize(3)
Global ThisWindow.i
Global GPageHeight.i,GPageWidth.i
Global btnOk,btnCancel,strTopMargin,strLeftMargin,strBottomMargin,strRightMargin
Global imgPage,cmb_Printers,cmb_PaperSize,opt_Portrait,opt_Landscape,img_Back.i
Global PageImage.l
Procedure GetPrinterPageSizes()
;Temporary Until Printer Page sizes defined
PageSize(0)\Title = "A4"
PageSize(0)\Height = 297
PageSize(0)\Width = 210
PageSize(1)\Title = "A5"
PageSize(1)\Height = 210
PageSize(1)\Width = 148
PageSize(2)\Title = "Letter"
PageSize(2)\Height = 279
PageSize(2)\Width = 216
Define iLoop.i
ClearGadgetItems(cmb_PaperSize)
For iLoop = 0 To ArraySize(PageSize()) -1
AddGadgetItem(cmb_PaperSize, -1, PageSize(iLoop)\Title)
Next iLoop
SetGadgetState(cmb_PaperSize, 0)
EndProcedure
Procedure GetSelectedPageSize()
PageDetail\Width = PageSize(GetGadgetState(cmb_PaperSize))\Width
PageDetail\Height = PageSize(GetGadgetState(cmb_PaperSize))\Height
EndProcedure
Procedure DrawPageImage()
Define GraphicScale.f
Define Left.i,Top.i
;Set Orientation
If PageDetail\Orientation = 0 ;Portrait
GPageHeight = PageDetail\Height
GPageWidth = PageDetail\Width
ElseIf PageDetail\Orientation = 1
GPageHeight = PageDetail\Width
GPageWidth = PageDetail\Height
EndIf
;Calculate Scaling
If GPageHeight > GPageWidth
GraphicScale = 190/GPageHeight
Else
GraphicScale = 190/GPageWidth
EndIf
;Create Page Image
PageImage = CreateImage(#PB_Any,GPageWidth * GraphicScale ,GPageHeight* GraphicScale , 32,RGB(255,255,255))
;Draw the page image
If StartDrawing(ImageOutput(PageImage))
;Add Margin Lines
FrontColor(RGB(255,0,0)) ; Red lines For Margins
;Top Margin
LineXY(0,PageDetail\TopMargin*GraphicScale,190,PageDetail\TopMargin * GraphicScale)
;Left Margin
;x = PageDetail\LeftMargin
LineXY(PageDetail\LeftMargin*GraphicScale,0,PageDetail\LeftMargin * GraphicScale, 190)
;Bottom Margin
;x = PageDetail\BottomMargin
LineXY(0,(GPageHeight-PageDetail\BottomMargin)*GraphicScale.f,190,(GPageHeight-PageDetail\BottomMargin) * GraphicScale)
;Right Margin
;x = PageDetail\RightMargin
LineXY((GPageWidth-PageDetail\RightMargin)*GraphicScale,0,(GPageWidth-PageDetail\RightMargin) * GraphicScale, 190)
StopDrawing()
EndIf
;Show Page Image
SetGadgetState(imgPage,ImageID(PageImage))
;Centre Page Image
If GPageHeight > GPageWidth
left = (190 -GadgetWidth(imgPage))/2
Else
top = (190 -GadgetHeight(imgPage))/2
EndIf
ResizeGadget(imgPage, left + 330, top + 10, #PB_Ignore, #PB_Ignore)
EndProcedure
Procedure.i Open()
ThisWindow = OpenWindow(#PB_Any, #PB_Ignore, #PB_Ignore, 530, 210, "Page Setup", #PB_Window_TitleBar | #PB_Window_Tool | #PB_Window_ScreenCentered)
FrameGadget(#PB_Any, 10, 10, 200, 70, " Select Paper Size ")
btnOk = ButtonGadget(#PB_Any, 10, 165, 100, 30, "Ok")
btnCancel = ButtonGadget(#PB_Any, 120, 165, 100, 30, "Cancel")
cmb_PaperSize = ComboBoxGadget(#PB_Any, 20, 40, 180, 20)
FrameGadget(#PB_Any, 10, 85, 310, 70, " Margins")
TextGadget(#PB_Any, 20, 105, 50, 20, "Top", #PB_Text_Right)
strTopMargin = StringGadget(#PB_Any, 80, 100, 40, 20, Str(PageDetail\TopMargin))
TextGadget(#PB_Any, 130, 105, 30, 20, "mm")
TextGadget(#PB_Any, 170, 105, 50, 20, "Left", #PB_Text_Right)
strLeftMargin = StringGadget(#PB_Any, 230, 100, 40, 20, Str(PageDetail\LeftMargin))
TextGadget(#PB_Any, 280, 105, 30, 20, "mm")
TextGadget(#PB_Any, 20, 130, 50, 20, "Bottom", #PB_Text_Right)
strBottomMargin = StringGadget(#PB_Any, 80, 125, 40, 20, Str(PageDetail\BottomMargin))
TextGadget(#PB_Any, 130, 130, 30, 20, "mm")
TextGadget(#PB_Any, 170, 130, 50, 20, "Right", #PB_Text_Right)
strRightMargin = StringGadget(#PB_Any, 230, 125, 40, 20, Str(PageDetail\RightMargin))
TextGadget(#PB_Any, 280, 130, 30, 20, "mm")
img_Back = ImageGadget(#PB_Any, 330, 10, 190, 190, 0, #PB_Image_Border)
imgPage = ImageGadget(#PB_Any, 390, 90, 80, 60, 0)
opt_Portrait = OptionGadget(#PB_Any, 230, 30, 80, 20, "Portrait")
opt_Landscape = OptionGadget(#PB_Any, 230, 50, 80, 20, "Landscape")
FrameGadget(#PB_Any, 220, 10, 100, 70, " Orientation ")
;Create a black image for background
SetGadgetState(img_Back,ImageID(CreateImage(#PB_Any,190 ,190 , 32,RGB(0,0,0))))
If PageDetail\Orientation = 0 ;Portrait
SetGadgetState(opt_Portrait,1)
SetGadgetState(opt_Landscape,0)
Else
SetGadgetState(opt_Portrait,0)
SetGadgetState(opt_Landscape,1)
EndIf
GetPrinterPageSizes()
GetSelectedPageSize()
DrawPageImage()
;Keep PageSetup on top till closed
StickyWindow(ThisWindow, #True)
ProcedureReturn ThisWindow
EndProcedure
Procedure Event_Handler(event)
Select event
Case #PB_Event_Gadget
Select EventGadget()
Case btnOk
;Just close the window
CloseWindow(ThisWindow)
Case btnCancel
;Cancel button clicked so clear all values
PageDetail\Height = 0
PageDetail\Width = 0
PageDetail\TopMargin = 0
PageDetail\LeftMargin = 0
PageDetail\BottomMargin = 0
PageDetail\RightMargin = 0
CloseWindow(ThisWindow)
Case strTopMargin
PageDetail\TopMargin = Val(GetGadgetText(strTopMargin))
DrawPageImage()
Case strLeftMargin
PageDetail\LeftMargin = Val(GetGadgetText(strLeftMargin))
DrawPageImage()
Case strBottomMargin
PageDetail\BottomMargin = Val(GetGadgetText(strBottomMargin))
DrawPageImage()
Case strRightMargin
PageDetail\RightMargin = Val(GetGadgetText(strRightMargin))
DrawPageImage()
Case cmb_PaperSize
;Get selected page size in mm
GetSelectedPageSize()
DrawPageImage()
Case opt_Portrait
If GetGadgetState(opt_Portrait) = 1
PageDetail\Orientation = 0
EndIf
DrawPageImage()
Case opt_Landscape
If GetGadgetState(opt_Landscape) = 1
PageDetail\Orientation = 1
EndIf
DrawPageImage()
EndSelect
EndSelect
EndProcedure
EndModule
Next I will be defining the main design form.
Enjoy
Any intelligent fool can make things bigger and more complex. It takes a touch of genius — and a lot of courage to move in the opposite direction.
-
collectordave
- Addict
- Posts: 1310
- Joined: Fri Aug 28, 2015 6:10 pm
- Location: Portugal
Re: Creating a report designer ?
Ok Moving on.
Lots of rewrites so here are all the modules etc.
When running use the menu to load a report. Not a real one just for testing. You can then right click on the report header or page header text and set the properties for these two items including font, colour, text and position.
Just writing the code to allow the addition of more text and fields to all sections and to allow the mouse to be used to resize and position the report elements.
Starting the use of a Report.pbi module to define a report load and save routines will go in this module.
So as of this moment here are all the files.
frmMain.pb
Page Setup.pbi
Report.pbi
Simple Query Builder.pbi
Config Text.pbi
Code getting longer once complete will start new thread with all codes as beta test.
Print routine will be a separate module to allow reports designed in this way to be printed from an application without all the designer code.
Hope you all enjoy
Lots of rewrites so here are all the modules etc.
When running use the menu to load a report. Not a real one just for testing. You can then right click on the report header or page header text and set the properties for these two items including font, colour, text and position.
Just writing the code to allow the addition of more text and fields to all sections and to allow the mouse to be used to resize and position the report elements.
Starting the use of a Report.pbi module to define a report load and save routines will go in this module.
So as of this moment here are all the files.
frmMain.pb
Code: Select all
EnableExplicit
IncludeFile "Report.pbi"
IncludeFile "Simple Query Builder.pbi"
IncludeFile "PageSetup.pbi"
IncludeFile "Configtext.pbi"
Global frmMain.i,frmQueryBuilder.i,frmPageSetUp.i,frmTextProperties.i
Global ScrollArea_0, cvsReportHeader, cvsPageHeader, cvsDetail, btnReportHeader, btnPageHeader, btnDetail
Global cvsRuler.i,PPmm.i,CanvasWidth.i,txtPageDetail.i,strPageWidth.i,strPageHeight.i
Global MyDB.s,Pattern.s,ReportQuery.s,cvsOffset.i
Global strLeftMargin.i,strTopMargin.i,strBottomMargin.i,strRightMargin.i
;Gadget Operations
Global ActiveGadget.i
Define Event.i
Enumeration FormMenu
#mnuReportNew
#mnuReportLoad
#mnuReportSave
#mnuReportPageSetup
#mnuReportPrint
#mnuExit
#mnuDatabase
#mnuDatabaseConnect
#mnuEditAdd
#mnuAddText
#mnuAddField
EndEnumeration
Macro GadgetHoverCheck(x, y,Gadget)
(((Not x < Report::ReportObject(iLoop)\x) & (Not y< Report::ReportObject(iLoop)\y)) &(Not x>=(Report::ReportObject(iLoop)\x+Report::ReportObject(iLoop)\Width)) & (Not y>=(Report::ReportObject(iLoop)\y+Report::ReportObject(iLoop)\Height)))
EndMacro
Procedure.i GadgetCheck(Section.s,x, y)
Define iloop.i = 0
For iloop = 0 To ArraySize(report::ReportObject()) -1
If Report::ReportObject(iloop)\Section = Section
If GadgetHoverCheck(x,y,iloop)
ProcedureReturn iloop
EndIf
EndIf
Next iloop
ProcedureReturn -1
EndProcedure
Procedure DrawRuler()
Define OffSet.i,i.i ;Temporary
Define UsedWidth.i
UsedWidth = Report::PageWidth - (Report::LeftMargin + Report::RightMargin)
CanvasWidth = UsedWidth * PPmm
SetGadgetText(strPageWidth,Str(Report::PageWidth))
SetGadgetText(strPageHeight,Str(Report::PageHeight))
SetGadgetText(strTopMargin,Str(Report::TopMargin))
SetGadgetText(strLeftMargin,Str(Report::LeftMargin))
SetGadgetText(strBottomMargin,Str(Report::BottomMargin))
SetGadgetText(strRightMargin,Str(Report::RightMargin))
If CanvasWidth < 780
cvsOffset = (780 - CanvasWidth )/2
Else
cvsOffset = 0
EndIf
SetGadgetAttribute(ScrollArea_0,#PB_ScrollArea_InnerWidth,CanvasWidth + cvsOffset)
ResizeGadget(cvsRuler,cvsOffset,#PB_Ignore,CanvasWidth,#PB_Ignore)
ResizeGadget(btnReportHeader,cvsOffset,#PB_Ignore,CanvasWidth,#PB_Ignore)
ResizeGadget(cvsReportHeader,cvsOffset,#PB_Ignore,CanvasWidth,#PB_Ignore)
ResizeGadget(btnPageHeader,cvsOffset,#PB_Ignore,CanvasWidth,#PB_Ignore)
ResizeGadget(cvsPageHeader,cvsOffset,#PB_Ignore,CanvasWidth,#PB_Ignore)
ResizeGadget(btnDetail,cvsOffset,#PB_Ignore,CanvasWidth,#PB_Ignore)
ResizeGadget(cvsDetail,cvsOffset,#PB_Ignore,CanvasWidth,#PB_Ignore)
If StartDrawing(CanvasOutput(cvsRuler))
For i = 1 To UsedWidth
If Mod(i, 10) = 0
LineXY(i * PPmm, 0, i * PPmm,20,RGB(100,100,100))
DrawText((i * PPmm) + 2,5,Str(i/10),RGB(0,0,0),RGB(255,255,255))
ElseIf Mod(i, 5) = 0
LineXY(i * PPmm, 0, i * PPmm,10,RGB(100,100,100))
Else
LineXY(i * PPmm, 0, i * PPmm,5,RGB(100,100,100))
EndIf
Next i
StopDrawing()
EndIf
EndProcedure
Procedure.i IsValidPBEvent(Event)
Select event
Case #PB_Event_Menu, ; a menu has been selected
#PB_Event_Gadget , ; a gadget has been pushed
#PB_Event_SysTray, ; an icon in the systray zone was clicked
#PB_Event_Timer , ; a timer has reached its timeout
#PB_Event_CloseWindow, ; the window close gadget has been pushed
#PB_Event_Repaint, ; the window content has been destroyed
#PB_Event_SizeWindow, ; the window has been resized
#PB_Event_MoveWindow, ; the window has been moved
#PB_Event_MinimizeWindow, ; the window has been minimized
#PB_Event_MaximizeWindow, ; the window has been maximized
#PB_Event_RestoreWindow, ; the window has been restored To normal size
#PB_Event_ActivateWindow, ; the window has been activated (got the focus)
#PB_Event_DeactivateWindow,; the window has been deactivated (lost the focus)
#PB_Event_WindowDrop, ; a Drag & Drop operation was finished on a window
#PB_Event_GadgetDrop, ; a Drag & Drop operation was finished on a gadget
#PB_Event_RightClick, ; a right mouse button click has occurred on the window.
#PB_Event_LeftClick, ; a left mouse button click has occurred on the window
#PB_Event_LeftDoubleClick ; a left mouse button double-click has occurred on the window
ProcedureReturn #True
Default
ProcedureReturn #False
EndSelect
EndProcedure
Procedure DrawReportObjects()
Define iLoop.i
Define x.i,y.i,Width.i,Height.i
Define test.i
For iLoop = 0 To ArraySize(report::ReportObject()) -1
Select Report::ReportObject(iLoop)\Section
Case "RHeader"
x = Report::ReportObject(iLoop)\x
y = Report::ReportObject(iLoop)\y
If LoadFont(1, Report::ReportObject(iLoop)\FontName, Report::ReportObject(iLoop)\FontSize,Report::ReportObject(iLoop)\Effects)
StartDrawing(WindowOutput(frmMain))
DrawingFont(FontID(1))
Height = TextHeight(Report::ReportObject(iLoop)\Text)
Width = TextWidth(Report::ReportObject(iLoop)\Text)
StopDrawing()
EndIf
OpenGadgetList(ScrollArea_0)
;Remove Old gadget if it exists
If IsGadget(Report::ReportObject(iLoop)\ID)
FreeGadget(Report::ReportObject(iLoop)\ID)
EndIf
Report::ReportObject(iLoop)\ID = TextGadget(#PB_Any, x, y, Width, Height, "") ;Report::ReportObject(iLoop)\Text)
CloseGadgetList()
Report::ReportObject(iLoop)\Width = Width/PPmm
Report::ReportObject(iLoop)\Height = Height/PPmm
SetGadgetColor(Report::ReportObject(iLoop)\ID,#PB_Gadget_FrontColor,Report::ReportObject(iLoop)\Colour)
SetGadgetColor(Report::ReportObject(iLoop)\ID,#PB_Gadget_BackColor ,RGB(255,255,255))
SetGadgetFont(Report::ReportObject(iLoop)\ID, FontID(1))
SetGadgetText(Report::ReportObject(iLoop)\ID, Report::ReportObject(iLoop)\Text)
ResizeGadget(Report::ReportObject(iLoop)\ID, (x* PPmm) + cvsOffset, (y* PPmm) + 39, Width, Height)
Case "PHeader"
x = Report::ReportObject(iLoop)\x
y = Report::ReportObject(iLoop)\y
If LoadFont(2, Report::ReportObject(iLoop)\FontName, Report::ReportObject(iLoop)\FontSize,Report::ReportObject(iLoop)\Effects)
StartDrawing(WindowOutput(frmMain))
DrawingFont(FontID(2))
Height = TextHeight(Report::ReportObject(iLoop)\Text)
Width = TextWidth(Report::ReportObject(iLoop)\Text)
StopDrawing()
EndIf
OpenGadgetList(ScrollArea_0)
;Remove Old gadget if it exists
If IsGadget(Report::ReportObject(iLoop)\ID)
FreeGadget(Report::ReportObject(iLoop)\ID)
EndIf
Report::ReportObject(iLoop)\ID = TextGadget(#PB_Any, x, y, Width, Height, "")
CloseGadgetList()
Report::ReportObject(iLoop)\Width = Width/PPmm
Report::ReportObject(iLoop)\Height = Height/PPmm
SetGadgetColor(Report::ReportObject(iLoop)\ID,#PB_Gadget_FrontColor,Report::ReportObject(iLoop)\Colour)
SetGadgetColor(Report::ReportObject(iLoop)\ID,#PB_Gadget_BackColor ,RGB(255,255,255))
SetGadgetFont(Report::ReportObject(iLoop)\ID, FontID(1))
SetGadgetText(Report::ReportObject(iLoop)\ID, Report::ReportObject(iLoop)\Text)
ResizeGadget(Report::ReportObject(iLoop)\ID, (x* PPmm) + cvsOffset, (y* PPmm) + 140, Width, Height)
EndSelect
Next iLoop
EndProcedure
Procedure Event_Handler(Event)
Define StartPos.i,x.i,y.i
Select Event
Case #PB_Event_CloseWindow
End
Case #PB_Event_Menu
Select EventMenu()
Case #mnuDatabaseConnect
Pattern = "Database (*.db)|*.db;|All files (*.*)|*.*"
MyDB = OpenFileRequester("Please choose Database", GetCurrentDirectory(), Pattern, 0)
If MyDB
SetWindowTitle(frmMain, MyDB)
Else
SetWindowTitle(frmMain, "")
EndIf
Case #mnuReportNew
PageSetup::Open()
DisableWindow(frmMain, #True)
Case #mnuReportLoad
Report::Load()
DrawRuler()
DrawReportObjects()
Case #mnuReportPageSetup
;Pass Current Report Page Detail
PageSetup::Pagedetail\Width = Report::PageWidth
PageSetup::Pagedetail\Height = Report::PageHeight
PageSetup::Pagedetail\TopMargin = Report::TopMargin
PageSetup::Pagedetail\LeftMargin = Report::LeftMargin
PageSetup::Pagedetail\BottomMargin = Report::BottomMargin
PageSetup::Pagedetail\RightMargin = Report::RightMargin
PageSetup::Open()
DisableWindow(frmMain, #True)
; Case #mnuQueryBuilder
; If Not IsWindow(QueryBuilder::Window_ID)
; If MyDB
; QueryBuilder::Open(MyDB)
; DisableWindow(frmMain, #True)
; Else
; MessageRequester("Information","No Database Selected!",#PB_MessageRequester_Ok)
; EndIf
; EndIf
Case #mnuExit
End
EndSelect ;EventMenu()
Case #PB_Event_Gadget
Select EventGadget()
Case ScrollArea_0
If GetGadgetAttribute(ScrollArea_0, #PB_ScrollArea_X ) > 0
StartPos = Int(Report::PageWidth - (Report::PageWidth * (CanvasWidth - GetGadgetAttribute(ScrollArea_0, #PB_ScrollArea_X )) / CanvasWidth))
Else
StartPos = 0
EndIf
Case cvsReportHeader
Select EventType ()
Case #PB_EventType_RightClick
;Get current mouse co-ordinates on header canvas
x = GetGadgetAttribute(cvsReportHeader, #PB_Canvas_MouseX)
y = GetGadgetAttribute(cvsReportHeader, #PB_Canvas_MouseY)
;Convert To mm
x = x/PPmm
y = y/PPmm
ActiveGadget = GadgetCheck("RHeader",x, y)
If ActiveGadget > -1
Select Report::ReportObject(ActiveGadget)\Type
Case "Text"
;Show text Properties
TextProperties::Open(ActiveGadget)
EndSelect
EndIf
EndSelect ;EventType ()
Case cvsPageHeader
Select EventType ()
Case #PB_EventType_RightClick
;Get current mouse co-ordinates on page header canvas
x = GetGadgetAttribute(cvsPageHeader, #PB_Canvas_MouseX)
y = GetGadgetAttribute(cvsPageHeader, #PB_Canvas_MouseY)
;Convert To mm
x = x/PPmm
y = y/PPmm
ActiveGadget = GadgetCheck("PHeader",x, y)
If ActiveGadget > -1
Select Report::ReportObject(ActiveGadget)\Type
Case "Text"
;Show text Properties
TextProperties::Open(ActiveGadget)
EndSelect
EndIf
EndSelect ;EventType ()
EndSelect ;EventGadget()
EndSelect ;Event
EndProcedure
frmMain = OpenWindow(#PB_Any, 0, 0,950, 385, "Report Designer", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
CreateMenu(0, WindowID(frmMain))
CreateMenu(0, WindowID(frmMain))
MenuTitle("Report")
MenuItem(#mnuReportNew, "New")
MenuItem(#mnuReportLoad, "Load")
MenuItem(#mnuReportSave, "Save")
MenuBar()
OpenSubMenu("Database")
MenuItem(#mnuDatabaseConnect, "Connect")
CloseSubMenu()
MenuItem(#mnuReportPageSetup, "Page Setup")
MenuItem(#mnuReportPrint, "Print")
MenuItem(#mnuExit, "Exit")
MenuTitle("Edit")
OpenSubMenu("Add")
MenuItem(#mnuAddText, "Text")
MenuItem(#mnuAddField, "Field")
CloseSubMenu()
MenuBar()
StartVectorDrawing(WindowVectorOutput(frmMain))
PPmm = VectorResolutionX()/25.4
StopVectorDrawing()
ScrollArea_0 = ScrollAreaGadget(#PB_Any, 10, 0, 780, 350, 854, 325, PPmm,#PB_ScrollArea_BorderLess)
SetGadgetColor(ScrollArea_0, #PB_Gadget_BackColor,RGB(192,192,192))
cvsRuler = CanvasGadget(#PB_Any, 0, 0, 845, 20)
btnReportHeader = ButtonGadget(#PB_Any, 0, 20, 845, 20, "Report Header")
cvsReportHeader = CanvasGadget(#PB_Any, 0, 40, 845, 80)
GadgetToolTip(cvsReportHeader, "Report Header printed once on page one")
btnPageHeader = ButtonGadget(#PB_Any, 0, 120, 600, 20, "Page\Section Header")
cvsPageHeader = CanvasGadget(#PB_Any, 0, 140, 600, 80)
GadgetToolTip(cvsPageHeader, "Page Header printed at start of each new page Or Section")
btnDetail = ButtonGadget(#PB_Any, 0, 220, 570, 20, "Detail")
cvsDetail = CanvasGadget(#PB_Any, 0, 240, 370, 80)
GadgetToolTip(cvsDetail, "Detail Section")
CloseGadgetList()
txtPageDetail = TextGadget(#PB_Any, 800, 10, 130, 20, "Page Detail")
TextGadget(#PB_Any, 800, 45, 130, 20, "Width")
strPageWidth = StringGadget(#PB_Any, 875, 40, 40, 20, "")
TextGadget(#PB_Any, 800, 70, 130, 20, "Height")
strPageHeight = StringGadget(#PB_Any, 875, 65, 40, 20, "")
TextGadget(#PB_Any, 800, 95, 130, 20, "Top Margin")
strTopMargin = StringGadget(#PB_Any, 875, 90, 40, 20, "")
TextGadget(#PB_Any, 800, 120, 130, 20, "Left Margin")
strLeftMargin = StringGadget(#PB_Any, 875, 115, 40, 20, "")
TextGadget(#PB_Any, 800, 145, 155, 20, "Bottom Margin")
strBottomMargin = StringGadget(#PB_Any, 875, 140, 40, 20, "")
TextGadget(#PB_Any, 800, 170, 180, 20, "Right Margin")
strRightMargin = StringGadget(#PB_Any, 875, 165, 40, 20, "")
DrawRuler()
Repeat
Event = WaitWindowEvent()
If IsValidPBEvent(Event)
Select EventWindow()
Case frmMain
Event_Handler(Event)
Case QueryBuilder::Window_ID
QueryBuilder::Event_Handler(Event)
If Not IsWindow(QueryBuilder::Window_ID)
DisableWindow(frmMain, #False)
If QueryBuilder::Query > ""
ReportQuery = QueryBuilder::Query
Else
ReportQuery = ""
EndIf
EndIf
Case PageSetup::Window_ID
PageSetup::Event_Handler(Event)
If Not IsWindow(PageSetup::Window_ID)
DisableWindow(frmMain, #False)
If PageSetup::Pagedetail\Width > 0
;User Clicked OK so save page detail
Report::PageWidth = PageSetup::Pagedetail\Width
Report::PageHeight = PageSetup::Pagedetail\Height
Report::TopMargin = PageSetup::Pagedetail\TopMargin
Report::LeftMargin = PageSetup::Pagedetail\LeftMargin
Report::BottomMargin = PageSetup::Pagedetail\BottomMargin
Report::RightMargin = PageSetup::Pagedetail\RightMargin
DrawRuler()
DrawReportObjects()
EndIf
EndIf
Case TextProperties::Window_ID
TextProperties::Event_Handler(Event)
If Not IsWindow(TextProperties::Window_ID)
DrawReportObjects()
EndIf
EndSelect
EndIf
ForEver
Code: Select all
DeclareModule PageSetup
;Anything declared here is available to other modules or main form even after page setup window closure
Structure Detail
Height.i
Width.i
TopMargin.i
LeftMargin.i
BottomMargin.i
RightMargin.i
Orientation.i
EndStructure
Global Pagedetail.Detail
Global Window_ID.l
Global OkPressed.i = #False
;Procedures needed to open and use Page Setup
Declare Event_Handler(event)
Declare Open()
EndDeclareModule
Module PageSetup
EnableExplicit
Structure PSize
Title.s
Width.i
Height.i
EndStructure
Global Dim PageSize.PSize(3)
Global ThisWindow.i
Global GPageHeight.i,GPageWidth.i
Global btnOk,btnCancel,strTopMargin,strLeftMargin,strBottomMargin,strRightMargin
Global imgPage,cmb_Printers,cmb_PaperSize,opt_Portrait,opt_Landscape,img_Back.i
Global PageImage.l
Procedure GetPrinterPageSizes()
;Temporary Until Printer Page sizes defined
PageSize(0)\Title = "A4"
PageSize(0)\Height = 297
PageSize(0)\Width = 210
PageSize(1)\Title = "A5"
PageSize(1)\Height = 210
PageSize(1)\Width = 148
PageSize(2)\Title = "Letter"
PageSize(2)\Height = 279
PageSize(2)\Width = 216
Define iLoop.i
ClearGadgetItems(cmb_PaperSize)
For iLoop = 0 To ArraySize(PageSize()) -1
AddGadgetItem(cmb_PaperSize, -1, PageSize(iLoop)\Title)
Next iLoop
SetGadgetState(cmb_PaperSize, 0)
EndProcedure
Procedure GetSelectedPageSize()
PageDetail\Width = PageSize(GetGadgetState(cmb_PaperSize))\Width
PageDetail\Height = PageSize(GetGadgetState(cmb_PaperSize))\Height
EndProcedure
Procedure DrawPageImage()
Define GraphicScale.f
Define Left.i,Top.i
;Set Orientation
If PageDetail\Orientation = 0 ;Portrait
GPageHeight = PageDetail\Height
GPageWidth = PageDetail\Width
ElseIf PageDetail\Orientation = 1
GPageHeight = PageDetail\Width
GPageWidth = PageDetail\Height
EndIf
;Calculate Scaling
If GPageHeight > GPageWidth
GraphicScale = 190/GPageHeight
Else
GraphicScale = 190/GPageWidth
EndIf
;Create Page Image
PageImage = CreateImage(#PB_Any,GPageWidth * GraphicScale ,GPageHeight* GraphicScale , 32,RGB(255,255,255))
;Draw the page image
If StartDrawing(ImageOutput(PageImage))
;Add Margin Lines
FrontColor(RGB(255,0,0)) ; Red lines For Margins
;Top Margin
LineXY(0,PageDetail\TopMargin*GraphicScale,190,PageDetail\TopMargin * GraphicScale)
;Left Margin
;x = PageDetail\LeftMargin
LineXY(PageDetail\LeftMargin*GraphicScale,0,PageDetail\LeftMargin * GraphicScale, 190)
;Bottom Margin
;x = PageDetail\BottomMargin
LineXY(0,(GPageHeight-PageDetail\BottomMargin)*GraphicScale.f,190,(GPageHeight-PageDetail\BottomMargin) * GraphicScale)
;Right Margin
;x = PageDetail\RightMargin
LineXY((GPageWidth-PageDetail\RightMargin)*GraphicScale,0,(GPageWidth-PageDetail\RightMargin) * GraphicScale, 190)
StopDrawing()
EndIf
;Show Page Image
SetGadgetState(imgPage,ImageID(PageImage))
;Centre Page Image
If GPageHeight > GPageWidth
left = (190 -GadgetWidth(imgPage))/2
Else
top = (190 -GadgetHeight(imgPage))/2
EndIf
ResizeGadget(imgPage, left + 330, top + 10, #PB_Ignore, #PB_Ignore)
EndProcedure
Procedure Open()
Window_ID = OpenWindow(#PB_Any, #PB_Ignore, #PB_Ignore, 530, 210, "Page Setup", #PB_Window_TitleBar | #PB_Window_Tool | #PB_Window_ScreenCentered)
FrameGadget(#PB_Any, 10, 10, 200, 70, " Select Paper Size ")
btnOk = ButtonGadget(#PB_Any, 10, 165, 100, 30, "Ok")
btnCancel = ButtonGadget(#PB_Any, 120, 165, 100, 30, "Cancel")
cmb_PaperSize = ComboBoxGadget(#PB_Any, 20, 40, 180, 20)
FrameGadget(#PB_Any, 10, 85, 310, 70, " Margins")
TextGadget(#PB_Any, 20, 105, 50, 20, "Top", #PB_Text_Right)
strTopMargin = StringGadget(#PB_Any, 80, 100, 40, 20, Str(PageDetail\TopMargin))
TextGadget(#PB_Any, 130, 105, 30, 20, "mm")
TextGadget(#PB_Any, 170, 105, 50, 20, "Left", #PB_Text_Right)
strLeftMargin = StringGadget(#PB_Any, 230, 100, 40, 20, Str(PageDetail\LeftMargin))
TextGadget(#PB_Any, 280, 105, 30, 20, "mm")
TextGadget(#PB_Any, 20, 130, 50, 20, "Bottom", #PB_Text_Right)
strBottomMargin = StringGadget(#PB_Any, 80, 125, 40, 20, Str(PageDetail\BottomMargin))
TextGadget(#PB_Any, 130, 130, 30, 20, "mm")
TextGadget(#PB_Any, 170, 130, 50, 20, "Right", #PB_Text_Right)
strRightMargin = StringGadget(#PB_Any, 230, 125, 40, 20, Str(PageDetail\RightMargin))
TextGadget(#PB_Any, 280, 130, 30, 20, "mm")
img_Back = ImageGadget(#PB_Any, 330, 10, 190, 190, 0, #PB_Image_Border)
imgPage = ImageGadget(#PB_Any, 390, 90, 80, 60, 0)
opt_Portrait = OptionGadget(#PB_Any, 230, 30, 80, 20, "Portrait")
opt_Landscape = OptionGadget(#PB_Any, 230, 50, 80, 20, "Landscape")
FrameGadget(#PB_Any, 220, 10, 100, 70, " Orientation ")
;Create a black image for background
SetGadgetState(img_Back,ImageID(CreateImage(#PB_Any,190 ,190 , 32,RGB(0,0,0))))
If PageDetail\Orientation = 0 ;Portrait
SetGadgetState(opt_Portrait,1)
SetGadgetState(opt_Landscape,0)
Else
SetGadgetState(opt_Portrait,0)
SetGadgetState(opt_Landscape,1)
EndIf
GetPrinterPageSizes()
GetSelectedPageSize()
DrawPageImage()
;Keep PageSetup on top till closed
StickyWindow(Window_ID, #True)
EndProcedure
Procedure Event_Handler(event)
Select event
Case #PB_Event_Gadget
Select EventGadget()
Case btnOk
;Just close the window
CloseWindow(Window_ID)
Window_ID = -1
Case btnCancel
;Cancel button clicked so clear all values
PageDetail\Height = 0
PageDetail\Width = 0
PageDetail\TopMargin = 0
PageDetail\LeftMargin = 0
PageDetail\BottomMargin = 0
PageDetail\RightMargin = 0
CloseWindow(Window_ID)
Window_ID = -1
Case strTopMargin
PageDetail\TopMargin = Val(GetGadgetText(strTopMargin))
DrawPageImage()
Case strLeftMargin
PageDetail\LeftMargin = Val(GetGadgetText(strLeftMargin))
DrawPageImage()
Case strBottomMargin
PageDetail\BottomMargin = Val(GetGadgetText(strBottomMargin))
DrawPageImage()
Case strRightMargin
PageDetail\RightMargin = Val(GetGadgetText(strRightMargin))
DrawPageImage()
Case cmb_PaperSize
;Get selected page size in mm
GetSelectedPageSize()
DrawPageImage()
Case opt_Portrait
If GetGadgetState(opt_Portrait) = 1
PageDetail\Orientation = 0
EndIf
DrawPageImage()
Case opt_Landscape
If GetGadgetState(opt_Landscape) = 1
PageDetail\Orientation = 1
EndIf
DrawPageImage()
EndSelect
EndSelect
EndProcedure
EndModule
Code: Select all
DeclareModule Report
Global PageHeight.i ;Height of Selected Page in mm
Global PageWidth.i ;Width of Selected Page in mm
Global TopMargin.i ;Top Margin In mm
Global LeftMargin.i ;Left Margin In mm
Global BottomMargin.i ;Bottom Margin In mm
Global RightMargin.i ;Right Margin In mm
Global Orientation.i = 1 ;Portrait or Landscape
Global DBName.s ;Database FileName
Structure RepObj
ID.i
Section.s
Type.s
Text.s
x.i
y.i
Width.i
Height.i
FontName.s
FontSize.i
Colour.i
Effects.i
EndStructure
Global Dim ReportObject.RepObj(1)
Declare Load()
Declare Save(RepFile.s)
EndDeclareModule
Module Report
Procedure Load()
;Get Report File
;Load Report Detail
;A4 Page Defaults
Report::PageWidth = 210
Report::PageHeight = 297
Report::TopMargin = 15
Report::LeftMargin = 10
Report::BottomMargin = 10
Report::RightMargin = 10
;Report Objects Just a report header here
ReDim ReportObject(1)
ReportObject(0)\ID = -1
ReportObject(0)\Section = "RHeader"
ReportObject(0)\Type = "Text"
ReportObject(0)\Text = "Report Header"
ReportObject(0)\x = 30
ReportObject(0)\y = 0
ReportObject(0)\FontName = "Arial"
ReportObject(0)\FontSize = 28
ReportObject(0)\Effects = 0 ;No Effects
ReportObject(0)\Colour = 0 ;Text colour Black
ReDim ReportObject(2)
ReportObject(1)\ID = -1
ReportObject(1)\Section = "PHeader"
ReportObject(1)\Type = "Text"
ReportObject(1)\Text = "Page Header Text"
ReportObject(1)\x = 30
ReportObject(1)\y = 0
ReportObject(1)\FontName = "Arial"
ReportObject(1)\FontSize = 28
ReportObject(1)\Effects = 0 ;No Effects
ReportObject(1)\Colour = 0 ;Text colour Black
EndProcedure
Procedure Save(RepFile.s)
;If RepFile = ""
;SaveFile Requester
;If
;Endif
EndProcedure
EndModule
Code: Select all
DeclareModule QueryBuilder
Global Window_ID.l
Global Query.s
Declare Open(MyDB.s)
Declare Event_Handler(Event)
EndDeclareModule
Module QueryBuilder
EnableExplicit
UseSQLiteDatabase()
;Where Clause Gadgets
Structure UserClause
strFieldID.i
strClauseID.i
strConditionID.i
EndStructure
Global Dim WhereClause.UserClause(3)
Structure FData
Name.s
Type.i
EndStructure
Global Dim FieldData.FData(0)
Global QueryDB.l
Global Query.s
;String Gadgets
Global strQuery.i
Global strC1Condition.i,strC2Condition.i,strC3Condition.i
;Buttons
Global btnAllFields.i,btnSelectedFields.i,btnOk.i,btnCancel.i,btnTest.i,btnNew.i,btnBuild.i
Global btnC1FieldSelect.i,btnC2FieldSelect.i,btnC3FieldSelect.i
;Combos and Lists
Global cmbTables.i,lstAvailableFields.i,lstSelectedFields.i,LstResult.i
Procedure.l Open_Database(DBName.s)
Define DBHnd.l
;Open Main Database
DBHnd.l = OpenDatabase(#PB_Any,DBName.s, "", "")
If DBHnd.l = 0
MessageRequester("Database Error","Failed to open Database!", #PB_MessageRequester_Ok )
ProcedureReturn 0
Else
ProcedureReturn DBHnd.l
EndIf
EndProcedure
Procedure ShowTables()
Define ObjType.s
ClearGadgetItems(cmbTables)
DatabaseQuery(QueryDB, "SELECT * FROM sqlite_master;")
FirstDatabaseRow(QueryDB)
ObjType = GetDatabaseString(QueryDB,DatabaseColumnIndex(QueryDB, "type"))
If ObjType = "table" Or ObjType = "view"
AddGadgetItem(cmbTables,-1,GetDatabaseString(QueryDB,DatabaseColumnIndex(QueryDB, "tbl_name")))
EndIf
While NextDatabaseRow( QueryDB)
ObjType = GetDatabaseString(QueryDB,DatabaseColumnIndex(QueryDB, "type"))
If ObjType = "table" Or ObjType = "view"
AddGadgetItem(cmbTables,-1,GetDatabaseString(QueryDB,DatabaseColumnIndex(QueryDB, "tbl_name")))
EndIf
Wend
FinishDatabaseQuery(QueryDB) ;free the query
EndProcedure
Procedure.i GetColumnType(FieldNum.i)
Select DatabaseColumnType(QueryDB, FieldNum)
Case #PB_Database_Blob
ProcedureReturn 3 ;Blob
Case #PB_Database_Long ,#PB_Database_Float,#PB_Database_Double ,#PB_Database_Quad
ProcedureReturn 1 ;Numeric
Case #PB_Database_String
ProcedureReturn 2 ;Text
Default
ProcedureReturn 0 ;Unknown
EndSelect
EndProcedure
Procedure ShowFields(TableName.s)
ClearGadgetItems(lstAvailableFields)
Define iloop.i = 0
Define txt.s = ""
DatabaseQuery(QueryDB, "SELECT * FROM " + TableName + ";")
FirstDatabaseRow(QueryDB)
ReDim FieldData(DatabaseColumns(QueryDB))
For iloop = 0 To DatabaseColumns(QueryDB) -1
txt = DatabaseColumnName(QueryDB, iloop)
FieldData(iloop)\Name = DatabaseColumnName(QueryDB, iloop)
fielddata(iloop)\Type = GetColumnType(iloop)
AddGadgetItem(lstAvailableFields,-1,txt )
Next
FinishDatabaseQuery(QueryDB) ;free the query
EndProcedure
Procedure LoadOperators(CmbID.i,Type.i)
ClearGadgetItems(WhereClause(CmbID)\strClauseID)
Select Type
Case 1 ;Numeric
AddGadgetItem(WhereClause(CmbID)\strClauseID,-1,"=")
SetGadgetItemData(WhereClause(CmbID)\strClauseID, 0, 3)
AddGadgetItem(WhereClause(CmbID)\strClauseID,-1,"<")
SetGadgetItemData(WhereClause(CmbID)\strClauseID, 1, 4)
AddGadgetItem(WhereClause(CmbID)\strClauseID,-1,"<=")
SetGadgetItemData(WhereClause(CmbID)\strClauseID, 2, 5)
AddGadgetItem(WhereClause(CmbID)\strClauseID,-1,">")
SetGadgetItemData(WhereClause(CmbID)\strClauseID, 3, 6)
AddGadgetItem(WhereClause(CmbID)\strClauseID,-1,">=")
SetGadgetItemData(WhereClause(CmbID)\strClauseID, 4, 7)
Case 2 ;Text
AddGadgetItem(WhereClause(CmbID)\strClauseID,-1,"=")
SetGadgetItemData(WhereClause(CmbID)\strClauseID, 0, 1)
AddGadgetItem(WhereClause(CmbID)\strClauseID,-1,"LIKE")
SetGadgetItemData(WhereClause(CmbID)\strClauseID, 1, 2)
EndSelect
EndProcedure
Procedure Clear_Gadgets()
Define iloop.i = 0
Define ColCount.i = 0
SetGadgetText(strQuery,"")
ClearGadgetItems(lstAvailableFields)
ClearGadgetItems(lstSelectedFields)
SetGadgetText(WhereClause(0)\strFieldID,"")
SetGadgetText(WhereClause(1)\strFieldID,"")
SetGadgetText(WhereClause(2)\strFieldID,"")
SetGadgetText(WhereClause(0)\strConditionID,"")
SetGadgetText(WhereClause(1)\strConditionID,"")
SetGadgetText(WhereClause(2)\strConditionID,"")
DisableGadget(WhereClause(0)\strConditionID, 1)
DisableGadget(WhereClause(1)\strConditionID, 1)
DisableGadget(WhereClause(2)\strConditionID, 1)
ClearGadgetItems(WhereClause(0)\strClauseID)
ClearGadgetItems(WhereClause(1)\strClauseID)
ClearGadgetItems(WhereClause(2)\strClauseID)
DisableGadget(WhereClause(0)\strClauseID, 1)
DisableGadget(WhereClause(1)\strClauseID, 1)
DisableGadget(WhereClause(2)\strClauseID, 1)
ClearGadgetItems(lstResult)
While GetGadgetItemText(lstResult,-1,ColCount) <> ""
ColCount + 1 ; count the colum
Wend
For iloop = ColCount To 1 Step -1 ;Do not remove column 0
RemoveGadgetColumn(lstResult, iloop)
Next
SetGadgetItemText(lstResult, -1, "Results" ,0)
EndProcedure
Procedure UpDateTableData(BQuery.s)
Define iloop.i = 0
ClearGadgetItems(lstResult)
For iloop = 1 To 10
RemoveGadgetColumn(lstResult, iloop) ; Remove the 'Column 2'
Next
Define txt.s = ""
DatabaseQuery(QueryDB, BQuery.s)
FirstDatabaseRow(QueryDB)
SetGadgetItemText(lstResult, -1, DatabaseColumnName(QueryDB, 0) ,0)
For iloop = 1 To DatabaseColumns(QueryDB) -1
AddGadgetColumn(lstResult, iloop, DatabaseColumnName(QueryDB, iloop), 100)
Next
txt = GetDatabaseString(QueryDB,0) + Chr(10)
For iloop = 1 To DatabaseColumns(QueryDB) -1
txt = txt + GetDatabaseString(QueryDB,iloop) + Chr(10)
Next
AddGadgetItem(lstResult, -1, txt)
While NextDatabaseRow(QueryDB)
txt = ""
For iloop = 0 To DatabaseColumns(QueryDB) -1
txt = txt + GetDatabaseString(QueryDB,iloop) + Chr(10)
Next
AddGadgetItem(lstResult, -1, txt)
Wend
FinishDatabaseQuery(QueryDB) ;free the query
EndProcedure
Procedure BuildQuery()
Define iLoop.i
If CountGadgetItems(lstSelectedFields) > 0
;Build Query
Query = "SELECT "
For iloop = 0 To CountGadgetItems(lstSelectedFields) - 1
Query = Query + GetGadgetItemText(lstSelectedFields,iloop) + ","
Next
;remove last comma
Query = Left(Query, Len(Query)-1)
Query = Query + " FROM " + GetGadgetText(cmbTables)
Define Field.s,Clause.s,Condition.s
;Add WHERE Clause
For iLoop = 0 To 2
Field = GetGadgetText(WhereClause(iLoop)\strFieldID)
Clause = GetGadgetText(WhereClause(iLoop)\strClauseID)
Condition = GetGadgetText(WhereClause(iLoop)\strConditionID)
If Field > "" And Clause > "" And Condition > ""
If iLoop = 0
Query = Query + " WHERE "
Else
Query = Query + " AND "
EndIf
Select GetGadgetItemData(WhereClause(iLoop)\strClauseID,GetGadgetState(WhereClause(iLoop)\strClauseID))
Case 1 ;String =
Query = Query + Field + " = '" + Condition + "' "
Case 2 ;String LIKE
Query = Query + Field + " " + " LIKE '%" + Condition + "%'"
Case 3 ;Number =
Query = Query + Field + " " + " = " + Condition
Case 4 ;Number <
Query = Query + Field + " < " + Condition
Case 5 ;Number <=
Query = Query + Field + " <= " + Condition
Case 6 ;Number >
Query = Query + Field + " > " + Condition
Case 7 ;Number >=
Query = Query + Field + " >=" + Condition
EndSelect
EndIf
Next iLoop
Query = Query + ";"
SetGadgetText(strQuery,Query)
EndIf
EndProcedure
Procedure Open(MyDB.s)
QueryDB = Open_Database(MyDB)
If QueryDB = 0
ProcedureReturn 0
EndIf
Window_ID = OpenWindow(#PB_Any, 50, 150, 790, 400, "Simple Query Builder", #PB_Window_TitleBar | #PB_Window_Tool | #PB_Window_ScreenCentered)
TextGadget(#PB_Any, 10, 10, 150, 20, "Select Table\View")
cmbTables = ComboBoxGadget(#PB_Any, 10, 30, 150, 20)
TextGadget(#PB_Any, 170, 10, 150, 20, "Query")
strQuery = StringGadget(#PB_Any, 170, 30, 610, 20, "")
TextGadget(#PB_Any, 10, 60, 150, 20, "Available Fields")
lstAvailableFields = ListViewGadget(#PB_Any, 10, 90, 150, 170, #PB_ListView_MultiSelect)
btnSelectedFields = ButtonGadget(#PB_Any, 170, 90, 30, 30, ">")
GadgetToolTip(btnSelectedFields, "Add Selected")
btnAllFields = ButtonGadget(#PB_Any, 170, 130, 30, 30, ">>")
GadgetToolTip(btnAllFields, "Add All")
TextGadget(#PB_Any, 210, 60, 150, 20, "Selected Fields")
lstSelectedFields = ListViewGadget(#PB_Any, 210, 90, 150, 170)
btnBuild = ButtonGadget(#PB_Any, 370, 230, 70, 30, "Build")
btnTest = ButtonGadget(#PB_Any, 450, 230, 70, 30, "Test")
btnNew = ButtonGadget(#PB_Any, 530, 230, 70, 30, "New")
btnCancel = ButtonGadget(#PB_Any, 630, 230, 70, 30, "Cancel")
btnOk = ButtonGadget(#PB_Any, 710, 230, 70, 30, "Ok")
GadgetToolTip(btnTest, "Test Query")
TextGadget(#PB_Any, 370, 60, 150, 20, "WHERE")
btnC1FieldSelect = ButtonGadget(#PB_Any, 370, 90, 30, 20, ">")
GadgetToolTip(btnC1FieldSelect, "Select Field")
WhereClause(0)\strFieldID = StringGadget(#PB_Any, 410, 90, 150, 20, "", #PB_String_ReadOnly)
SetGadgetColor(WhereClause(0)\strFieldID, #PB_Gadget_BackColor,RGB(255,255,255))
GadgetToolTip(WhereClause(0)\strFieldID, "Selected Field Read Only")
WhereClause(0)\strClauseID = ComboBoxGadget(#PB_Any, 570, 90, 60, 20)
DisableGadget(WhereClause(0)\strClauseID, 1)
WhereClause(0)\strConditionID = StringGadget(#PB_Any, 640, 90, 140, 20, "")
DisableGadget(WhereClause(0)\strConditionID, 1)
btnC2FieldSelect = ButtonGadget(#PB_Any, 370, 120, 30, 20, ">")
GadgetToolTip(btnC2FieldSelect, "Select Field")
WhereClause(1)\strFieldID = StringGadget(#PB_Any, 410, 120, 150, 20, "", #PB_String_ReadOnly)
SetGadgetColor(WhereClause(1)\strFieldID, #PB_Gadget_BackColor,RGB(255,255,255))
GadgetToolTip(WhereClause(1)\strFieldID, "Selected Field Read Only")
WhereClause(1)\strClauseID = ComboBoxGadget(#PB_Any, 570, 120, 60, 20)
DisableGadget(WhereClause(1)\strClauseID, 1)
WhereClause(1)\strConditionID = StringGadget(#PB_Any, 640, 120, 140, 20, "")
DisableGadget(WhereClause(1)\strConditionID, 1)
btnC3FieldSelect = ButtonGadget(#PB_Any, 370, 150, 30, 20, ">")
GadgetToolTip(btnC3FieldSelect, "Select Field")
WhereClause(2)\strFieldID = StringGadget(#PB_Any, 410, 150, 150, 20, "", #PB_String_ReadOnly)
SetGadgetColor(WhereClause(2)\strFieldID, #PB_Gadget_BackColor,RGB(255,255,255))
GadgetToolTip(WhereClause(2)\strFieldID, "Selected Field Read Only")
WhereClause(2)\strClauseID = ComboBoxGadget(#PB_Any, 570, 150, 60, 20)
DisableGadget(WhereClause(2)\strClauseID, 1)
WhereClause(2)\strConditionID = StringGadget(#PB_Any, 640, 150, 140, 20, "")
DisableGadget(WhereClause(2)\strConditionID, 1)
lstResult = ListIconGadget(#PB_Any, 0, 270, 790, 130, "Results", 100, #PB_ListIcon_GridLines)
ShowTables()
StickyWindow(Window_ID, #True)
EndProcedure
Procedure Event_Handler(Event)
Define iLoop.i
Select event
Case #PB_Event_Gadget
Select EventGadget()
Case btnOk
QueryBuilder::Query = GetGadgetText(strQuery)
CloseWindow(Window_ID)
Window_ID = -1
Case btncancel
QueryBuilder::Query = ""
CloseWindow(Window_ID)
Window_ID = -1
Case btnBuild
BuildQuery()
Case btnNew
Clear_Gadgets()
Case cmbTables
ShowFields(GetGadgetItemText(cmbTables,GetGadgetState(cmbTables)))
Case btnAllFields
ClearGadgetItems(lstSelectedFields)
For iLoop = 0 To CountGadgetItems(lstAvailableFields) -1
AddGadgetItem(lstSelectedFields,-1,GetGadgetItemText(lstAvailableFields,iloop))
Next
Case btnSelectedFields
ClearGadgetItems(lstSelectedFields)
For iLoop = 0 To CountGadgetItems(lstAvailableFields) -1
If GetGadgetItemState(lstAvailableFields,iLoop) = 1
AddGadgetItem(lstSelectedFields,-1,GetGadgetItemText(lstAvailableFields,iLoop))
EndIf
Next iLoop
Case btnC1FieldSelect
If GetGadgetText(lstSelectedFields) > ""
SetGadgetText(WhereClause(0)\strFieldID,GetGadgetText(lstSelectedFields))
EndIf
For iloop = 0 To CountGadgetItems(lstAvailableFields) - 1
If Trim(GetGadgetItemText(lstAvailableFields, iloop)) = Trim(GetGadgetText(WhereClause(0)\strFieldID))
LoadOperators(0,FieldData(iloop)\Type)
SetGadgetText(WhereClause(0)\strFieldID,GetGadgetText(lstSelectedFields))
SetGadgetData(WhereClause(0)\strFieldID, FieldData(iloop)\Type)
DisableGadget(WhereClause(0)\strClauseID, 0)
DisableGadget(WhereClause(0)\strConditionID, 0)
Break
EndIf
Next
Case btnC2FieldSelect
If GetGadgetText(lstSelectedFields) > ""
SetGadgetText(WhereClause(1)\strFieldID,GetGadgetText(lstSelectedFields))
EndIf
For iloop = 0 To CountGadgetItems(lstAvailableFields) - 1
If Trim(GetGadgetItemText(lstAvailableFields, iloop)) = Trim(GetGadgetText(WhereClause(1)\strFieldID))
LoadOperators(1,FieldData(iloop)\Type)
DisableGadget(WhereClause(1)\strClauseID, 0)
DisableGadget(WhereClause(1)\strConditionID, 0)
Break
EndIf
Next
Case btnC3FieldSelect
If GetGadgetText(lstSelectedFields) > ""
SetGadgetText(WhereClause(2)\strFieldID,GetGadgetText(lstSelectedFields))
EndIf
For iloop = 0 To CountGadgetItems(lstAvailableFields) - 1
If Trim(GetGadgetItemText(lstAvailableFields, iloop)) = Trim(GetGadgetText(WhereClause(2)\strFieldID))
LoadOperators(2,FieldData(iloop)\Type)
DisableGadget(WhereClause(2)\strClauseID, 0)
DisableGadget(WhereClause(2)\strConditionID, 0)
Break
EndIf
Next
Case btnBuild
BuildQuery()
Case btnTest
UpDateTableData(GetGadgetText(strQuery))
EndSelect ;EventGadget()
EndSelect ;Event
EndProcedure
Code: Select all
DeclareModule TextProperties
Global Window_ID.l
Global ActiveGadget.i
Declare Open(Gadget.i)
Declare Event_Handler(Event)
EndDeclareModule
Module TextProperties
Global Canvas_0, txtFont, strFont, btnSetFont, Text_2, txtTop, strTop, txtLeft, strLeft, btnCentre, btnOk, btnCancel
Global StrTitle.i
Global RText.s,Rx.i,Ry.i,RFontName.s,RFontSize.i
Procedure Open(Gadget)
ActiveGadget = Gadget
RText = Report::ReportObject(ActiveGadget)\Text
Rx = Report::ReportObject(ActiveGadget)\x
Ry = Report::ReportObject(ActiveGadget)\y
RFontName = Report::ReportObject(ActiveGadget)\FontName
RFontSize = Report::ReportObject(ActiveGadget)\FontSize
Window_ID = OpenWindow(#PB_Any, 0, 0, 420, 220, "", #PB_Window_SystemMenu)
Canvas_0 = CanvasGadget(#PB_Any, 10, 110, 400, 60)
txtFont = TextGadget(#PB_Any, 20, 40, 50, 20,"Font" , #PB_Text_Right)
strFont = StringGadget(#PB_Any, 80, 40, 300, 20, RFontName + " " + RFontSize)
btnSetFont = ButtonGadget(#PB_Any, 380, 40, 20, 20, "...")
Text_2 = TextGadget(#PB_Any, 10, 110, 190, 20, RText)
SetGadgetColor(Text_2, #PB_Gadget_BackColor,RGB(255,255,255))
txtTop = TextGadget(#PB_Any, 20, 70, 50, 20, "Top", #PB_Text_Right)
strTop = StringGadget(#PB_Any, 80, 70, 50, 20, Str(Ry) + "mm")
txtLeft = TextGadget(#PB_Any, 190, 70, 50, 20, "Left", #PB_Text_Right)
strLeft = StringGadget(#PB_Any, 250, 70, 50, 20, Str(Rx) + "mm")
btnCentre = ButtonGadget(#PB_Any, 310, 70, 90, 20, "Centre Area")
btnOk = ButtonGadget(#PB_Any, 270, 180, 60, 30, "Ok")
btnCancel = ButtonGadget(#PB_Any, 340, 180, 60, 30, "Cancel")
StrTitle = StringGadget(#PB_Any, 80, 10, 320, 20, RText)
txtTitle = TextGadget(#PB_Any, 10, 10, 60, 20, "Title", #PB_Text_Right)
EndProcedure
Procedure Event_Handler(Event)
Select Event
Case #PB_Event_Gadget
Select EventGadget()
Case btnSetFont
FontRequester(RFontName, RFontSize, #PB_FontRequester_Effects,Report::ReportObject(ActiveGadget)\Colour)
If LoadFont(1, SelectedFontName(), SelectedFontSize(),SelectedFontStyle())
RFontName = SelectedFontName()
StartDrawing(WindowOutput(Window_ID))
DrawingFont(FontID(1))
Height = TextHeight(RText)
Width = TextWidth(RText)
StopDrawing()
ResizeGadget(Text_2, #PB_Ignore, #PB_Ignore, Width, Height)
SetGadgetFont(Text_2, FontID(1))
SetGadgetColor(Text_2,#PB_Gadget_FrontColor,SelectedFontColor())
EndIf
Case btnOk
;Set activegadget properties here
Report::ReportObject(ActiveGadget)\Text = GetGadgetText(StrTitle)
Report::ReportObject(ActiveGadget)\Colour = SelectedFontColor()
Report::ReportObject(ActiveGadget)\FontName = RFontName
Report::ReportObject(ActiveGadget)\FontSize = RFontSize
Report::ReportObject(ActiveGadget)\x = Val(GetGadgetText(strLeft))
Report::ReportObject(ActiveGadget)\y = Val(GetGadgetText(strTop))
Report::ReportObject(ActiveGadget)\Effects = SelectedFontStyle()
CloseWindow(Window_ID)
Case btnCancel
CloseWindow(Window_ID)
EndSelect
EndSelect
EndProcedure
EndModule
Print routine will be a separate module to allow reports designed in this way to be printed from an application without all the designer code.
Hope you all enjoy
Any intelligent fool can make things bigger and more complex. It takes a touch of genius — and a lot of courage to move in the opposite direction.
Re: Creating a report designer ?
Hi, collectordave.
Thanks for shring!
1.In your last code i have an error in PageSetup.pbi
[17:40:40] [COMPILER] Line 1: Modules can not be nested.
2. In frmMain.pb:
IncludeFile "PageSetup.pbi"
but in your post you wrote "Page Setup.pbi"
Thanks for shring!
1.In your last code i have an error in PageSetup.pbi
[17:40:40] [COMPILER] Line 1: Modules can not be nested.
2. In frmMain.pb:
IncludeFile "PageSetup.pbi"
but in your post you wrote "Page Setup.pbi"
-
collectordave
- Addict
- Posts: 1310
- Joined: Fri Aug 28, 2015 6:10 pm
- Location: Portugal
Re: Creating a report designer ?
Hi AAT
Just a typo I think. Must have missed off an endmodule or included the pagesetup module twice will look into it a little further and repost.
I have had to rethink the way the reports are set up and I am now writing an options form for page setup, database connection, queries and title etc.
The idea being that an end user when selecting a new report can set everything in one place and a report can be generated fairly automatically.
Just a typo I think. Must have missed off an endmodule or included the pagesetup module twice will look into it a little further and repost.
I have had to rethink the way the reports are set up and I am now writing an options form for page setup, database connection, queries and title etc.
The idea being that an end user when selecting a new report can set everything in one place and a report can be generated fairly automatically.
Any intelligent fool can make things bigger and more complex. It takes a touch of genius — and a lot of courage to move in the opposite direction.
-
collectordave
- Addict
- Posts: 1310
- Joined: Fri Aug 28, 2015 6:10 pm
- Location: Portugal
Re: Creating a report designer ?
Hi AAT
Just had a quick look and the EndModule line is missing from the very end of the simple query module. must have missed it when copying sorry.
Just had a quick look and the EndModule line is missing from the very end of the simple query module. must have missed it when copying sorry.
Any intelligent fool can make things bigger and more complex. It takes a touch of genius — and a lot of courage to move in the opposite direction.
Re: Creating a report designer ?
Hi, collectordave
OK now, thanks.
OK now, thanks.
-
IdeasVacuum
- Always Here
- Posts: 6426
- Joined: Fri Oct 23, 2009 2:33 am
- Location: Wales, UK
- Contact:
Re: Creating a report designer ?
IdeasVacuum
If it sounds simple, you have not grasped the complexity.
If it sounds simple, you have not grasped the complexity.
-
Amilcar Matos
- User
- Posts: 43
- Joined: Thu Nov 27, 2014 3:10 pm
- Location: San Juan, Puerto Rico
Re: Creating a report designer ?
@collectordave:
Which task can be of help to this project? (documentation, form design, coding. etc...)
It's a good project, carry on!
Which task can be of help to this project? (documentation, form design, coding. etc...)
It's a good project, carry on!
-
collectordave
- Addict
- Posts: 1310
- Joined: Fri Aug 28, 2015 6:10 pm
- Location: Portugal
Re: Creating a report designer ?
Hi All
I would like this to be a cross platform user module with all code available for everyone.
Amilcar Matos
Contact me by PM with your email and I will send a dropbox link for the project. Thanks in advance for your help.
Cheers
collectordave
I thought that Arctic reports was for windows only and I have not found the source code for it yet. Can anyone point me in the direction of the source code?The mighty sRod created a fully-fledged Report Design in PB:
I would like this to be a cross platform user module with all code available for everyone.
Amilcar Matos
Well basically everything. At the moment I have the main form design just about right and I am writing the Options\new report form. Just down to associating selected fields with display titles now. then design the file format for the report etc and code save and load routines. Help file,error checking and preview\print routines still to do.Which task can be of help to this project? (documentation, form design, coding. etc...)
Contact me by PM with your email and I will send a dropbox link for the project. Thanks in advance for your help.
Cheers
collectordave
Any intelligent fool can make things bigger and more complex. It takes a touch of genius — and a lot of courage to move in the opposite direction.