PureBasic Forums - English

Posted: **Sat Mar 11, 2006 2:05 pm**

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 ?

Posted: **Sat Mar 11, 2006 7:53 pm**

You could try Report Manager - available from sourceforge

Posted: **Sun Mar 12, 2006 1:56 am**

I work with the SQLite railways and miss also a simple report manager. The idea is super!! Unfortunately my knowledge is enough to participate not over to such a project. It would be beautifully if some specialists would find!

Sorry for my bad english, I am from Germany and the text is from Google.

Posted: **Sun Mar 12, 2006 5:35 pm**

you might also want to search SourceForge for 'Datavision'.

Posted: **Wed Mar 22, 2006 11:54 am**

I think, which would arouse databaseinterfaces as extension of PB new interest in the programming language pure basic. Ideal way were programmed if these interfaces still in PB. Here a small desire list: - report designers
- Querydesigner
- binding ADO or ODBC
- DatabaseExplorer

Posted: **Thu Jan 07, 2016 5:57 am**

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.

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

Hope this is of use to someone

Posted: **Sat Jan 09, 2016 2:08 pm**

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

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

The Simple Query Builder stays the same and here is the code for a page setup form.

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

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

Posted: **Sun Jan 17, 2016 6:41 am**

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

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

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
  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

Report.pbi

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

Simple Query Builder.pbi

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

Config Text.pbi

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

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

Posted: **Sun Jan 17, 2016 11:54 am**

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"

Posted: **Mon Jan 18, 2016 4:25 am**

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.

Posted: **Mon Jan 18, 2016 4:28 am**

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.

Posted: **Mon Jan 18, 2016 3:44 pm**

Hi, collectordave
OK now, thanks.

Posted: **Mon Jan 18, 2016 4:05 pm**

The mighty sRod created a fully-fledged Report Design in PB:
Arctic Reports

Posted: **Mon Jan 18, 2016 8:07 pm**

@collectordave:
Which task can be of help to this project? (documentation, form design, coding. etc...)
It's a good project, carry on!

Posted: **Tue Jan 19, 2016 6:54 am**

Hi All

The mighty sRod created a fully-fledged Report Design in PB:

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?

I would like this to be a cross platform user module with all code available for everyone.

Amilcar Matos

Which task can be of help to this project? (documentation, form design, coding. etc...)

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.

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

PureBasic Forums - English

Creating a report designer ?

Creating a report designer ?

Re: Creating a report designer ?

Re: Creating a report designer ?

Re: Creating a report designer ?

Re: Creating a report designer ?

Re: Creating a report designer ?

Re: Creating a report designer ?

Re: Creating a report designer ?

Re: Creating a report designer ?

Re: Creating a report designer ?

Re: Creating a report designer ?