Search Results

Search found 2181 results on 88 pages for 'dim fish'.

Page 4/88 | < Previous Page | 1 2 3 4 5 6 7 8 9 10 11 12  | Next Page >

  • Automated SSRS deployment with the RS utility

    - by Stacy Vicknair
    If you’re familiar with SSRS and development you are probably aware of the SSRS web services. The RS utility is a tool that comes with SSRS that allows for scripts to be executed against against the SSRS web service without needing to create an application to consume the service. One of the better benefits of using this format rather than writing an application is that the script can be modified by others who might be involved in the creation and addition of scripts or management of the SSRS environment.   Reporting Services Scripter Jasper Smith from http://www.sqldbatips.com created Reporting Services Scripter to assist with the created of a batch process to deploy an entire SSRS environment. The helper scripts below were created through the modification of his generated scripts. Why not just use this tool? You certainly can. For me, the volume of scripts generated seems less maintainable than just using some common methods extracted from these scripts and creating a deployment in a single script file. I would, however, recommend this as a product if you do not think that your environment will change drastically or if you do not need to deploy with a higher level of control over the deployment. If you just need to replicate, this tool works great. Executing with RS.exe Executing a script against rs.exe is fairly simple. The Script Half the battle is having a starting point. For the scripting I needed to do the below is the starter script. A few notes: This script assumes integrated security. This script assumes your reports have one data source each. Both of the above are just what made sense for my scenario and are definitely modifiable to accommodate your needs. If you are unsure how to change the scripts to your needs, I recommend Reporting Services Scripter to help you understand how the differences. The script has three main methods: CreateFolder, CreateDataSource and CreateReport. Scripting the server deployment is just a process of recreating all of the elements that you need through calls to these methods. If there are additional elements that you need to deploy that aren’t covered by these methods, again I suggest using Reporting Services Scripter to get the code you would need, convert it to a repeatable method and add it to this script! Public Sub Main() CreateFolder("/", "Data Sources") CreateFolder("/", "My Reports") CreateDataSource("/Data Sources", "myDataSource", _ "Data Source=server\instance;Initial Catalog=myDatabase") CreateReport("/My Reports", _ "MyReport", _ "C:\myreport.rdl", _ True, _ "/Data Sources", _ "myDataSource") End Sub   Public Sub CreateFolder(parent As String, name As String) Dim fullpath As String = GetFullPath(parent, name) Try RS.CreateFolder(name, parent, GetCommonProperties()) Console.WriteLine("Folder created: {0}", name) Catch e As SoapException If e.Detail.Item("ErrorCode").InnerText = "rsItemAlreadyExists" Then Console.WriteLine("Folder {0} already exists and cannot be overwritten", fullpath) Else Console.WriteLine("Error : " + e.Detail.Item("ErrorCode").InnerText + " (" + e.Detail.Item("Message").InnerText + ")") End If End Try End Sub   Public Sub CreateDataSource(parent As String, name As String, connectionString As String) Try RS.CreateDataSource(name, parent,False, GetDataSourceDefinition(connectionString), GetCommonProperties()) Console.WriteLine("DataSource {0} created successfully", name) Catch e As SoapException Console.WriteLine("Error : " + e.Detail.Item("ErrorCode").InnerText + " (" + e.Detail.Item("Message").InnerText + ")") End Try End Sub   Public Sub CreateReport(parent As String, name As String, location As String, overwrite As Boolean, dataSourcePath As String, dataSourceName As String) Dim reportContents As Byte() = Nothing Dim warnings As Warning() = Nothing Dim fullpath As String = GetFullPath(parent, name)   'Read RDL definition from disk Try Dim stream As FileStream = File.OpenRead(location) reportContents = New [Byte](stream.Length-1) {} stream.Read(reportContents, 0, CInt(stream.Length)) stream.Close()   warnings = RS.CreateReport(name, parent, overwrite, reportContents, GetCommonProperties())   If Not (warnings Is Nothing) Then Dim warning As Warning For Each warning In warnings Console.WriteLine(Warning.Message) Next warning Else Console.WriteLine("Report: {0} published successfully with no warnings", name) End If   'Set report DataSource references Dim dataSources(0) As DataSource   Dim dsr0 As New DataSourceReference dsr0.Reference = dataSourcePath Dim ds0 As New DataSource ds0.Item = CType(dsr0, DataSourceDefinitionOrReference) ds0.Name=dataSourceName dataSources(0) = ds0     RS.SetItemDataSources(fullpath, dataSources)   Console.Writeline("Report DataSources set successfully")       Catch e As IOException Console.WriteLine(e.Message) Catch e As SoapException Console.WriteLine("Error : " + e.Detail.Item("ErrorCode").InnerText + " (" + e.Detail.Item("Message").InnerText + ")") End Try End Sub     Public Function GetCommonProperties() As [Property]() 'Common CatalogItem properties Dim descprop As New [Property] descprop.Name = "Description" descprop.Value = "" Dim hiddenprop As New [Property] hiddenprop.Name = "Hidden" hiddenprop.Value = "False"   Dim props(1) As [Property] props(0) = descprop props(1) = hiddenprop Return props End Function   Public Function GetDataSourceDefinition(connectionString as String) Dim definition As New DataSourceDefinition definition.CredentialRetrieval = CredentialRetrievalEnum.Integrated definition.ConnectString = connectionString definition.Enabled = True definition.EnabledSpecified = True definition.Extension = "SQL" definition.ImpersonateUser = False definition.ImpersonateUserSpecified = True definition.Prompt = "Enter a user name and password to access the data source:" definition.WindowsCredentials = False definition.OriginalConnectStringExpressionBased = False definition.UseOriginalConnectString = False Return definition End Function   Private Function GetFullPath(parent As String, name As String) As String If parent = "/" Then Return parent + name Else Return parent + "/" + name End If End Function

    Read the article

  • batch_add_field_VBA

    - by Elaine Kuo
    I am unsure where goes wrong. Please kindly help and thanks. Public Sub AddField() Dim pApp As esriCatalogUI.IGxApplication Set pApp = esriArcCatalog.Application Dim pGxSelection As esriCatalog.IGxSelection Set pGxSelection = pApp.Selection Dim plist As esriCatalog.IEnumGxObject Set plist = pGxSelection.SelectedObjects Dim pGxObject As esriCatalog.IGxObject Dim pName As esriSystem.IName Dim pDS As esriGeoDatabase.IDataset Dim pGDSE As esriGeoDatabase.IGeoDatasetSchemaEdit Dim pStatusBar As esriSystem.IStatusBar Set pStatusBar = esriArcCatalog.Application.StatusBar Dim pFeatLyr As esriCarto.IFeatureLayer Dim pFeatureClass As esriGeoDatabase.IFeatureClass Dim pFeatureDataset As esriGeoDatabase.IFeatureDataset Dim pFieldEdit As esriGeoDatabase.IFieldEdit Set pGxObject = plist.Next Set pFeatureClass = pGxObject If pFeatureClass.Type = esriDTFeatureClass Then Set pFeatLyr = New FeatureLayer Set pFeatLyr.FeatureClass = pFeatureDataset.Dataset pFeatLyr.name = pGXDataset.Dataset.name End If 'Checks to make sure you have something selected If pGxObject Is Nothing Then MsgBox "You need to select the files", vbOKOnly, "Error" Exit Sub End If 'Runs a function to add field Dim pField1 As esriGeoDatabase.IFieldEdit ' Define the first new field. Set pField1 = New Field pField1.Name = "GID1" pField1.Type = esriFieldTypeInteger pField1.Length = 10 pFeatureClass.AddField pField1 'Loops through all selected files and preforms Do Until pGxObject Is Nothing If TypeOf pGxObject Is esriCatalog.IGxDataset Then Set pName = pGxObject.InternalObjectName Set pDS = pName.Open Set pGDSE = pDS With pGDSE If .CanAlterSpatialReference Then .AlterSpatialReference pFieldEdit End If End With End If pStatusBar.Message(0) = "Done: " & pGxObject.Name Set pGxObject = plist.Next Loop CleanUp: Set pFieldEdit = Nothing Set pGDSE = Nothing pStatusBar.Message(0) = "Done" End Sub

    Read the article

  • VBA Public Function to Excel

    - by Sugih
    Dear sir , I have create below function Option Explicit Public Function fyi(x As Double, f As String) As String Application.Volatile Dim data As Double Dim post(5) post(1) = "Ribu " post(2) = "Juta " post(3) = "Milyar " post(4) = "Trilyun " post(5) = "Ribu Trilyun " Dim part As String Dim text As String Dim cond As Boolean Dim i As Integer If (x < 0) Then fyi = " " Exit Function End If If (x = 0) Then fyi = "Nol" Exit Function End If If (x < 2000) Then cond = True End If text = " " If (x >= 1E+15) Then fyi = "Nilai Terlalu Besar" Exit Function End If For i = 4 To 1 Step -1 data = Int(x / (10 ^ (3 * i))) If (data 0) Then part = fyis(data, cond) text = text & part & post(i) End If x = x - data * (10 ^ (3 * i)) Next text = text & fyis(x, False) fyi = text & f End Function Function fyis(ByVal y As Double, ByVal conds As Boolean) As String Dim datas As Double Dim posts(2) posts(1) = "Puluh" posts(2) = "Ratus" Dim parts As String Dim texts As String 'Dim conds As Boolean Dim j As Integer Dim value(9) value(1) = "Se" value(2) = "Dua " value(3) = "Tiga " value(4) = "Empat " value(5) = "Lima " value(6) = "Enam " value(7) = "Tujuh " value(8) = "Delapan " value(9) = "Sembilan " texts = " " For j = 2 To 1 Step -1 datas = Int(y / 10 ^ j) If (datas 0) Then parts = value(datas) If (j = 1 And datas = 1) Then y = y - datas * 10 ^ j If (y = 1) Then posts(j) = "belas" Else value(y) = "Se" End If texts = texts & value(y) & posts(j) fyis = texts Exit Function Else texts = texts & parts & posts(j) End If End If y = y - datas * 10 ^ j Next If (conds = False) Then value(1) = "Satu " End If texts = texts & value(y) fyis = texts End Function but when I return to Excel and type '=fyi(500,"USD") it return to #name? please do me favor to inform me how to solve Rgds, Sugih

    Read the article

  • Check mail attachment

    - by comii
    Hi! I am using vb.net to display email from outlook express! Everything work fine but when some message has attachment, i can not display message that email has attachment! This is my code: Private Sub LoginButton_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles LoginButton.Click Dim oItem Dim i As Integer Dim Message As MAPI.Message Dim items As String() = New String(6) {} ' Items are the sender name,subject and date and read/unread value Dim PrSenderEmail, PrBodyEmail Session = CreateObject("MAPI.Session") ' we use a session object of MAPI Component Session.Logon(ProfileName:=Me.UserId.Text, ProfilePassword:=Me.Password.Text) Session.MAPIOBJECT = Session.MAPIOBJECT ' Folder = CObj(Session.Inbox) ' choose the folder Application = CreateObject("Outlook.Application") Namespace1 = Application.GetNamespace("MAPI") Namespace1.Logon() ' for getting the sender name and avoid security validation of Outlook/Exchange server 2003 ' we are using the "Redemption" component sItem = CreateObject("Redemption.SafeMailItem") Cursor.Current = Cursors.WaitCursor ' show we're busy doing the sort ListInbox.BeginUpdate() ' Notify that update begins ListInbox.Items.Clear() i = 0 ' first email message is 0 For Each Message In Folder.Messages Try i = i + 1 ' increment to the next email message 'get e-mail from the Inbox, can be any other item oItem = Application.Session.GetDefaultFolder(6).Items(i) ' GetDefaultFolder(6) refers to Inbox sItem.Item = oItem 'sItem is an object of Redemption COM and is used to get the senders name items(0) = sItem.SenderName() Catch items(0) = "error" End Try Dim objApp As Outlook.Application = New Outlook.Application 'Get Mapi NameSpace Dim objNS As Outlook.NameSpace = objApp.GetNamespace("MAPI") Dim oMsg As Outlook.MailItem Dim pp As String Dim b As Integer Dim objAttachment As Outlook.Attachment pp = Message.StoreID items(1) = Message.Subject items(2) = Message.TimeReceived items(4) = Message.Subject items(5) = Message.Size Dim objInbox As Outlook.MAPIFolder = objNS.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderInbox) Dim objItems As Outlook.Items = objInbox.Items items(5) = Message.Size.ToString / 1000 & "kb" If Message.Unread = True Then items(3) = "unread" Else items(3) = "read" End If ListInbox.Items.Add(New ListViewItem(items)) Next ListInbox.EndUpdate() ' Notify that update ends Cursor.Current = Cursors.Default End If End Sub How I can display message that email has attachment?

    Read the article

  • VB.NET handling data between different forms

    - by niuchu
    Hi, I'm writing a simple application - address book. User enters new addresses and they are added as an entry to a list visible on the main form (frmStart). I use one form to add and edit (AddContForm). Add button on the frmStart works fine, however I experience some problems with the edit button as when I press it and enter new data they are added as new entry however the previous entry is still there. Logic is handled by Contact.vb class. Please let me know how to fix this problem. Here is the code: Contact.vb Public Class Contact Public Contact As String Public Title As String Public Fname As String Public Surname As String Public Address As String Private myCont As String Public Property Cont() Get Return myCont End Get Set(ByVal value) myCont = Value End Set End Property Public Overrides Function ToString() As String Return Me.Cont End Function Public Sub Display() Dim C As New Contact C.Cont = frmAddCont.txtTitle.Text C.Fname = frmAddCont.txtFName.Text C.Surname = frmAddCont.txtSName.Text C.Address = frmAddCont.txtAddress.Text frmStart.lstContact.Items.Add(C) End Sub End Class Here is frmStart.vb Public Class frmStart Public Button As String Private Sub btnAdd_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnAdd.Click Button = "" Button = "Add" frmAddCont.ShowDialog() End Sub Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnDel.Click Button = "" Button = "Del" Dim DelCont As Contact DelCont = Me.lstContact.SelectedItem() lstContact.Items.Remove(DelCont) End Sub Private Sub lstContact_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles lstContact.SelectedIndexChanged End Sub Private Sub btnEdit_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnEdit.Click Button = "" Button = "Edit" Dim C As Contact If lstContact.SelectedItem IsNot Nothing Then C = DirectCast(lstContact.SelectedItem, Contact) frmAddCont.ShowDialog() End If End Sub End Class Here is AddContFrm.vb Public Class frmAddCont Public Class ControlObject Dim Title As String Dim FName As String Dim SName As String Dim Address As String Dim TelephoneNumber As Integer Dim emailAddress As String Dim Website As String Dim Photograph As String End Class Private Sub btnConfirmAdd_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnConfirmAdd.Click Dim B As String B = frmStart.Button Dim C As New Contact C.Display() Me.Hide() If B = "Edit" Then C = DirectCast(frmStart.lstContact.SelectedItem, Contact) frmStart.lstContact.SelectedItems.Remove(C) End If End Sub Private Sub frmAddCont_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load End Sub End Class

    Read the article

  • Using AesCryptoServiceProvider in VB.NET

    - by Collegeman
    My problem is actually a bit more complicated than just how to use AES in VB.NET, since what I'm really trying to do is use AES in VB.NET from within a Java application across JACOB. But for now, what I need to focus on is the AES implementation itself. Here's my encryption code Public Function EncryptAES(ByVal toEncrypt As String, ByVal key As String) As Byte() Dim keyArray = Convert.FromBase64String(key) Dim toEncryptArray = Encoding.Unicode.GetBytes(toEncrypt) Dim aes = New AesCryptoServiceProvider aes.Key = keyArray aes.Mode = CipherMode.ECB aes.Padding = PaddingMode.ISO10126 Dim encryptor = aes.CreateEncryptor() Dim encrypted = encryptor.TransformFinalBlock(toEncryptArray, 0, toEncryptArray.Length) aes.Clear() Return encrypted End Function Once back in the Java code, I turn the byte array into a hexadecimal String. Now, to reverse the process, here's my decryption code Public Function DecryptAES(ByVal toDecrypt As String, ByVal key As String) As Byte() Dim keyArray = Convert.FromBase64String(key) Dim toDecryptArray = Convert.FromBase64String(toDecrypt) Dim aes = New AesCryptoServiceProvider aes.Key = keyArray aes.Mode = CipherMode.ECB aes.Padding = PaddingMode.ISO10126 Dim decryptor = aes.CreateDecryptor() Dim decrypted = decryptor.TransformFinalBlock(toDecryptArray, 0, toDecryptArray.Length) aes.Clear() Return decrypted End Function When I run the decryption code, I get the following error message Padding is invalid and cannot be removed.

    Read the article

  • vbscript xml problem

    - by user181421
    Hello Friends, I have this vbscript that calls a web service written in .net 2010. I'm getting an error at the last line. Can't figure it out. This is the webservice: http://www.kollelbaaleibatim.com/services/getinfo.asmx/GetFronpageInfo Dim xmlDOC Dim bOK Dim J Dim HTTP Dim ImagePathLeftCar, ImagePathRightCar Dim CarIDLeft, CarIDRight Dim ShortTitleLeftCar, ShortTitleRightCar Dim DescriptionLeftCar, DescriptionRightCar Dim PriceLeftCar, PriceRightCar Set HTTP = CreateObject("MSXML2.XMLHTTP") Set xmlDOC =CreateObject("MSXML.DOMDocument") xmlDOC.Async=False HTTP.Open "GET","http://www.kollelbaaleibatim.com/services/getinfo.asmx/GetFronpageInfo", false HTTP.setRequestHeader "Content-Type", "application/x-www-form-urlencoded" HTTP.Send() dim xmldoc2 set xmldoc2 = Server.CreateObject("Microsoft.XMLDOM") xmldoc2.async = False bOK = xmldoc2.load(HTTP.responseXML) if Not bOK then response.write( "Error loading XML from HTTP") end if response.write( xmldoc2.documentElement.xml)'Prints a good looking xml ShortTitleLeftCar = xmldoc2.documentElement.selectSingleNode("LeftCarShortTitle").text 'ERROR HERE

    Read the article

  • How do I tie a cmbBox that selects all drives (local and network) into a treeNode VB

    - by jpavlov
    How do i tie in a selected item from a cmbBox with a treeView? I am looking to just obtain the value of the one selected drive Thanks. Imports System Imports System.IO Imports System.IO.File Imports System.Windows.Forms Public Class F_Treeview_Demo Private Sub F_Treeview_Demo_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load ' Initialize the local directory treeview Dim nodeText As String = "" Dim sb As New C_StringBuilder With My.Computer.FileSystem 'Read in the number of drives For i As Integer = 0 To .Drives.Count - 1 '** Build the drive's node text sb.ClearText() sb.AppendText(.Drives(i).Name) cmbDrives.Items.Add(sb.FullText) Next End With ListRootNodes() End Sub Private Sub btnExit_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnExit.Click Application.Exit() End Sub Private Sub tvwLocalFolders_AfterSelect(ByVal sender As Object, ByVal e As System.Windows.Forms.TreeViewEventArgs) _ Handles tvwLocalFolders.AfterSelect ' Display the path for the selected node Dim folder As String = tvwLocalFolders.SelectedNode.Tag lblLocalPath.Text = folder ListView1.Items.Clear() Dim childNode As TreeNode = e.Node.FirstNode Dim parentPath As String = AddChar(e.Node.Tag) End Sub Private Sub AddToList(ByVal nodes As TreeNodeCollection) For Each node As TreeNode In nodes If node.Checked Then ListView1.Items.Add(node.Text) ListView1.Items.Add(Chr(13)) AddToList(node.Nodes) End If Next End Sub Private Sub tvwLocalFolders_BeforeExpand(ByVal sender As Object, ByVal e As System.Windows.Forms.TreeViewCancelEventArgs) _ Handles tvwLocalFolders.BeforeExpand ' Display the path for the selected node lblLocalPath.Text = e.Node.Tag ' Populate all child nodes below the selected node Dim parentPath As String = AddChar(e.Node.Tag) tvwLocalFolders.BeginUpdate() Dim childNode As TreeNode = e.Node.FirstNode 'this i added Dim smallNode As TreeNode = e.Node.FirstNode Do While childNode IsNot Nothing ListLocalSubFolders(childNode, parentPath & childNode.Text) childNode = childNode.NextNode ''this i added ListLocalFiles(smallNode, parentPath & smallNode.Text) Loop tvwLocalFolders.EndUpdate() tvwLocalFolders.Refresh() ' Select the node being expanded tvwLocalFolders.SelectedNode = e.Node ListView1.Items.Clear() AddToList(tvwLocalFolders.Nodes) ListView1.Items.Add(Environment.NewLine) End Sub Private Sub ListRootNodes() ' Add all local drives to the Local treeview Dim nodeText As String = "" Dim sb As New C_StringBuilder With My.Computer.FileSystem For i As Integer = 0 To .Drives.Count - 1 '** Build the drive's node text sb.ClearText() sb.AppendText(.Drives(i).Name) nodeText = sb.FullText nodeText = Me.cmbDrives.SelectedItem '** Add the drive to the treeview Dim driveNode As TreeNode driveNode = tvwLocalFolders.Nodes.Add(nodeText) 'driveNode.Tag = .Drives(i).Name '** Add the next level of subfolders 'ListLocalSubFolders(driveNode, .Drives(i).Name) ListLocalSubFolders(driveNode, nodeText) 'driveNode = Nothing Next End With End Sub Private Sub ListLocalFiles(ByVal ParentNode As TreeNode, ByVal PParentPath As String) Dim FileNode As String = "" Try For Each FileNode In Directory.GetFiles(PParentPath) Dim smallNode As TreeNode smallNode = ParentNode.Nodes.Add(FilenameFromPath(FileNode)) With smallNode .ImageIndex = 0 .SelectedImageIndex = 1 .Tag = FileNode End With smallNode = Nothing Next Catch ex As Exception End Try End Sub Private Sub ListLocalSubFolders(ByVal ParentNode As TreeNode, _ ByVal ParentPath As String) ' Add all local subfolders below the passed Local treeview node Dim FolderNode As String = "" Try For Each FolderNode In Directory.GetDirectories(ParentPath) Dim childNode As TreeNode childNode = ParentNode.Nodes.Add(FilenameFromPath(FolderNode)) With childNode .ImageIndex = 0 .SelectedImageIndex = 1 .Tag = FolderNode End With childNode = Nothing Next Catch ex As Exception End Try End Sub Private Sub ComboBox1_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmbDrives.SelectedIndexChanged End Sub Private Sub lblLocalPath_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles lblLocalPath.Click End Sub Private Sub grpLocalFileSystem_Enter(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles grpLocalFileSystem.Enter End Sub Private Sub btn1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btn1.Click ' lbl1.Text = End Sub Private Sub ListView1_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ListView1.SelectedIndexChanged End Sub End Class

    Read the article

  • Why does my screen dim on a desktop installation of Windows 7?

    - by Robert Cartaino
    Periodically, while using my Windows 7 Pro desktop installation, the screen suddenly dims. The brightness is about 75% normal (estimate). It's as if I am in a power-saving mode on a laptop running on batteries. But this is a full desktop installation. I know it is not a hardware glitch or monitor adjustment issue because the Windows cursor is still bright white while everything else goes dim. The Control Panel Power Options have not been changed. They are set to "Balanced [active]" and I have tried restoring the default settings. Flipping through the power and display settings, everything looks "normal." There is no screen saver or power-off-after settings apparent. Rebooting the system resets everything to full brightness but I can't find a way to restore it in Windows or to keep it from happening in the first place. Suggestions?

    Read the article

  • Code that Worked with MultiView fails with Wizard ASP.NET

    - by davemackey
    I originally created a process that occurred by transitioning between views in a multiview and it worked fine. Now, I've moved this same code into a ASP.NET Wizard and it keeps throwing an error at the second step. The error is: Method 'System.Object AndObject(System.Object, System.Object)' has no supported translation to SQL. Any ideas why this would occur when moving the code into the wizard? I'm sure its something stupid, but I've checked over the code 3-4 times now and it appears identical operationally. Here is the code: ' Make sure we have the LDAP portion of the .NET Framework available. Imports System.DirectoryServices ' Allows us to interface with LDAP. Imports System.Data.Linq.SqlClient ' Allows us to use LINQ SQL Methods. Partial Public Class buildit Inherits System.Web.UI.Page Protected Sub Page_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load ' ******* Grab the LDAP info. for current user. Dim ID As FormsIdentity = DirectCast(User.Identity, FormsIdentity) Dim ticket As FormsAuthenticationTicket = ID.Ticket Dim adDirectory As New DirectoryEntry("LDAP://OU=[info],DC=[info],DC=[info],DC=[info]") ' We need to strip off @email.address from the ticket name, so we'll use substring to grab the first ' five characters. Dim adTicketID As String = ticket.Name.Substring(0, 5) Dim adEmployeeID As String adEmployeeID = adDirectory.Children.Find("CN=" & adTicketID).Properties("employeeID").Value ' ******* Lets make sure they have signed the housing contract and the community covenant. Dim dbContractSigs As New pcRoomOccupantsDataContext Dim pcContractSigs = From p In dbContractSigs.webContractSigs _ Where p.people_id = adEmployeeID _ Select p.res_contract, p.comm_life If pcContractSigs.Count.Equals(0) Then Response.Redirect("signcontract.aspx") Else Dim cs As String = pcContractSigs.First.res_contract.ToString Dim cos As String = pcContractSigs.First.comm_life.ToString If cs = "Y" And cos = "Y" Then ' We don't need to do anything. ' We use the else statement b/c there are multiple conditions that could occur besides "N" ' that would cause us to redirect to the signature page, whereas there is only one valid response - "Y". Else ' Redirect the individual to our contracts page. Response.Redirect("signcontract.aspx") End If End If ' ******* Now lets find out what gender that individual is. Dim dbIndividual As New pcPeopleDataContext Dim pcIndividual = From p In dbIndividual.PEOPLEs _ Join d In dbIndividual.DEMOGRAPHICs On p.PEOPLE_CODE_ID Equals d.PEOPLE_CODE_ID _ Where p.PEOPLE_ID = adEmployeeID _ Select p, d ' Make a session variable that will carry with the user throughout the session delineating gender. Session("sgender") = pcIndividual.First.d.GENDER.ToString ' Debug Code. ' Put a stop at end sub to get these values. ' Response.Write(adEmployeeID) End Sub Sub LinqDataSource1_Selecting(ByVal sender As Object, ByVal e As LinqDataSourceSelectEventArgs) ' Lets get a list of the dorms that are available for user's gender. Dim pcDorms As New pcDormsDataContext Dim selectedDorms = (From sd In pcDorms.PBU_WEB_DORMs _ Where IIf(Session("sgender").ToString = "M", sd.description = "Male", sd.description = "Female") _ Select sd.dorm_building).Distinct() e.Result = selectedDorms End Sub Public Sub Button_ItemCommand(ByVal Sender As Object, ByVal e As RepeaterCommandEventArgs) ' ******** Lets pass on the results of our query in LinqDataSource1_Selecting. Session("sdorm") = RTrim(e.CommandName) ' ******** Debug code. ' Response.Write(sDorm) End Sub Sub LinqDataSource2_Selecting(ByVal sender As Object, ByVal e As LinqDataSourceSelectEventArgs) ' ******** Get a list of rooms available in the dorm for user's gender. Dim pcDorms As New pcDormsDataContext Dim selectedDorm = (From sd In pcDorms.PBU_WEB_DORMs _ Where IIf(Session("sgender").ToString = "M", sd.description = "Male", sd.description = "Female") _ And sd.dorm_building = CStr(Session("sdorm")) _ Select sd.dorm_room) e.Result = selectedDorm End Sub Public Sub Button2_ItemCommand(ByVal Sender As Object, ByVal e As RepeaterCommandEventArgs) ' ******** Lets pass on the results of our query in LinqDataSource2_Selecting. Session("sroom") = RTrim(e.CommandName) End Sub Sub LinqDataSource3_Selecting(ByVal sender As Object, ByVal e As LinqDataSourceSelectEventArgs) ' ******** Grabs the individuals currently listed as residing in this room and displays them. Note the use of SqlMethods.Like ' for dorm_building, this is due to legacy issues where dorms sometimes have leading or trailing blank spaces. We could have ' also used Trim. Dim pcOccupants As New pcRoomOccupantsDataContext Dim roomOccupants = (From ro In pcOccupants.webResidents _ Where SqlMethods.Like(ro.dorm_building, "%" & CStr(Session("sdorm")) & "%") _ And ro.dorm_room = CStr(Session("sroom")) _ Select ro.person_name) e.Result = roomOccupants ' ******** Debug code. 'Response.Write(CStr(Session("sdorm"))) 'Response.Write(CStr(Session("sroom"))) End Sub Protected Sub Button4_Click(ByVal sender As Object, ByVal e As EventArgs) Handles Button4.Click ' ******** Reserve the room for a student. End Sub End Class

    Read the article

  • Is it safe to assert a functions return type?

    - by wb
    This question is related to this question. I have several models stored in a collection. I loop through the collection and validate each field. Based on the input, a field can either be successful, have an error or a warning. Is it safe to unit test each decorator and assert that the type of object returned is what you would expect based on the given input? I could perhaps see this being an issue for a language with function return types since my validation function can return one of 3 types. This is the code I'm fiddling with: <!-- #include file = "../lib/Collection.asp" --> <style type="text/css"> td { padding: 4px; } td.error { background: #F00F00; } td.warning { background: #FC0; } </style> <% Class UserModel Private m_Name Private m_Age Private m_Height Public Property Let Name(value) m_Name = value End Property Public Property Get Name() Name = m_Name End Property Public Property Let Age(value) m_Age = value End Property Public Property Get Age() Age = m_Age End Property Public Property Let Height(value) m_Height = value End Property Public Property Get Height() Height = m_Height End Property End Class Class NameValidation Private m_Name Public Function Init(name) m_Name = name End Function Public Function Validate() Dim validationObject If Len(m_Name) < 5 Then Set validationObject = New ValidationError Else Set validationObject = New ValidationSuccess End If validationObject.CellValue = m_Name Set Validate = validationObject End Function End Class Class AgeValidation Private m_Age Public Function Init(age) m_Age = age End Function Public Function Validate() Dim validationObject If m_Age < 18 Then Set validationObject = New ValidationError ElseIf m_Age = 18 Then Set validationObject = New ValidationWarning Else Set validationObject = New ValidationSuccess End If validationObject.CellValue = m_Age Set Validate = validationObject End Function End Class Class HeightValidation Private m_Height Public Function Init(height) m_Height = height End Function Public Function Validate() Dim validationObject If m_Height > 400 Then Set validationObject = New ValidationError ElseIf m_Height = 324 Then Set validationObject = New ValidationWarning Else Set validationObject = New ValidationSuccess End If validationObject.CellValue = m_Height Set Validate = validationObject End Function End Class Class ValidationError Private m_CSSClass Private m_CellValue Public Property Get CSSClass() CSSClass = "error" End Property Public Property Let CellValue(value) m_CellValue = value End Property Public Property Get CellValue() CellValue = m_CellValue End Property End Class Class ValidationWarning Private m_CSSClass Private m_CellValue Public Property Get CSSClass() CSSClass = "warning" End Property Public Property Let CellValue(value) m_CellValue = value End Property Public Property Get CellValue() CellValue = m_CellValue End Property End Class Class ValidationSuccess Private m_CSSClass Private m_CellValue Public Property Get CSSClass() CSSClass = "" End Property Public Property Let CellValue(value) m_CellValue = value End Property Public Property Get CellValue() CellValue = m_CellValue End Property End Class Class ModelValidator Public Function ValidateModel(model) Dim modelValidation : Set modelValidation = New CollectionClass ' Validate name Dim name : Set name = New NameValidation name.Init model.Name modelValidation.Add name ' Validate age Dim age : Set age = New AgeValidation age.Init model.Age modelValidation.Add age ' Validate height Dim height : Set height = New HeightValidation height.Init model.Height modelValidation.Add height Dim validatedProperties : Set validatedProperties = New CollectionClass Dim modelVal For Each modelVal In modelValidation.Items() validatedProperties.Add modelVal.Validate() Next Set ValidateModel = validatedProperties End Function End Class Dim modelCollection : Set modelCollection = New CollectionClass Dim user1 : Set user1 = New UserModel user1.Name = "Mike" user1.Age = 12 user1.Height = 32 modelCollection.Add user1 Dim user2 : Set user2 = New UserModel user2.Name = "Phil" user2.Age = 18 user2.Height = 432 modelCollection.Add user2 Dim user3 : Set user3 = New UserModel user3.Name = "Michele" user3.Age = 32 user3.Height = 324 modelCollection.Add user3 ' Validate all models in the collection Dim modelValue Dim validatedModels : Set validatedModels = New CollectionClass For Each modelValue In modelCollection.Items() Dim objModelValidator : Set objModelValidator = New ModelValidator validatedModels.Add objModelValidator.ValidateModel(modelValue) Next %> <table> <tr> <td>Name</td> <td>Age</td> <td>Height</td> </tr> <% Dim r, c For Each r In validatedModels.Items() %><tr><% For Each c In r.Items() %><td class="<%= c.CSSClass %>"><%= c.CellValue %></td><% Next %></tr><% Next %> </table> Thank you.

    Read the article

  • Excel VBA - export to UTF-8

    - by Tom
    The macro I created works fine, I just need to sort out the saving business. Now I get a popup asking me where to save it, but I would like it to save it under a default name and path AND encoded in UTF-8. This is my full code I use, the bottom part saves the document I presume. Public Sub ExportToTextFile(FName As String, Sep As String, SelectionOnly As Boolean, AppendData As Boolean) Dim WholeLine As String Dim fnum As Integer Dim RowNdx As Long Dim ColNdx As Integer Dim StartRow As Long Dim EndRow As Long Dim StartCol As Integer Dim EndCol As Integer Dim CellValue As String Dim teller As Integer 'Teller aangemaakt ter controle voor het aantal velden 'teller = 1 Application.ScreenUpdating = False On Error GoTo EndMacro: fnum = FreeFile If SelectionOnly = True Then With Selection StartRow = .Cells(1).Row StartCol = .Cells(26).Column EndRow = .Cells(.Cells.Count).Row EndCol = .Cells(.Cells.Count).Column End With Else With ActiveSheet.UsedRange StartRow = .Cells(1).Row StartCol = .Cells(26).Column EndRow = .Cells(.Cells.Count).Row EndCol = .Cells(26).Column End With End If If AppendData = True Then Open FName For Append Access Write As #fnum Else Open FName For Output Access Write As #fnum End If For RowNdx = StartRow To EndRow WholeLine = "" For ColNdx = StartCol To EndCol If Cells(RowNdx, ColNdx).Value = "" Then CellValue = "" Else CellValue = Cells(RowNdx, ColNdx).Value End If WholeLine = WholeLine & CellValue & Sep Next ColNdx WholeLine = Left(WholeLine, Len(WholeLine) - Len(Sep)) Print #fnum, WholeLine, "" 'Print #fnum, teller, WholeLine, "" 'teller = teller + 1 Next RowNdx EndMacro: On Error GoTo 0 Application.ScreenUpdating = True Close #fnum End Sub Sub Dump4Mini() Dim FileName As Variant Dim Sep As String FileName = Application.GetSaveAsFilename(InitialFileName:=Blank, filefilter:="Text (*.txt),*.txt") If FileName = False Then Exit Sub End If Sep = "|" If Sep = vbNullString Then Exit Sub End If Debug.Print "FileName: " & FileName, "Separator: " & Sep ExportToTextFile FName:=CStr(FileName), Sep:=CStr(Sep), SelectionOnly:=False, AppendData:=False End Sub

    Read the article

  • Trying to use HttpWebRequest to load a page in a file.

    - by Malcolm
    Hi, I have a ASP.NET MVC app that works fine in the browser. I am using the following code to be able to write the html of a retrieved page to a file. (This is to use in a PDF conversion component) But this code errors out continually but not in the browser. I get timeout errors sometimes asn 500 errors. Public Function GetPage(ByVal url As String, ByVal filename As String) As Boolean Dim request As HttpWebRequest Dim username As String Dim password As String Dim docid As String Dim poststring As String Dim bytedata() As Byte Dim requestStream As Stream Try username = "pdfuser" password = "pdfuser" docid = "docid=inv12154" poststring = String.Format("username={0}&password={1}&{2}", username, password, docid) bytedata = Encoding.UTF8.GetBytes(poststring) request = WebRequest.Create(url) request.Method = "Post" request.ContentLength = bytedata.Length request.ContentType = "application/x-www-form-urlencoded" requestStream = request.GetRequestStream() requestStream.Write(bytedata, 0, bytedata.Length) requestStream.Close() request.Timeout = 60000 Dim response As HttpWebResponse Dim responseStream As Stream Dim reader As StreamReader Dim sb As New StringBuilder() Dim line As String = String.Empty response = request.GetResponse() responseStream = response.GetResponseStream() reader = New StreamReader(responseStream, System.Text.Encoding.ASCII) line = reader.ReadLine() While (Not line Is Nothing) sb.Append(line) line = reader.ReadLine() End While File.WriteAllText(filename, sb.ToString()) Catch ex As Exception MsgBox(ex.Message) End Try Return True End Function

    Read the article

  • VB.NET editing existing that with a form

    - by user127147
    Hi there, I have a simple questions that puzzles me. I need a little bit of refreashment with VB as I have been away for a while. I have a form that adds new contacts. New contacts are added by pressing an appropriate button and they appear as an entry in the list on the form. I try now to add an edit button that will edit existing entries. User will select a given entry on the list and press edit button and will be presented with an appropriate form (AddContFrm). Right now it simply adds another entry with the same title. Logic is handled in a class called Contact.vb Here is my code. Public Class Contact Public Contact As String Public Title As String Public Fname As String Public Surname As String Public Address As String Private myCont As String Public Property Cont() Get Return myCont End Get Set(ByVal value) myCont = Value End Set End Property Public Overrides Function ToString() As String Return Me.Cont End Function Sub NewContact() FName = frmAddCont.txtFName.ToString frmStart.lstContact.Items.Add(FName) frmAddCont.Hide() End Sub Public Sub Display() Dim C As New Contact 'C.Cont = InputBox("Enter a title for this contact.") C.Cont = frmAddCont.txtTitle.Text C.Fname = frmAddCont.txtFName.Text C.Surname = frmAddCont.txtSName.Text C.Address = frmAddCont.txtAddress.Text 'frmStart.lstContact.Items.Add(C.Cont.ToString) frmStart.lstContact.Items.Add(C) End Sub End Class AddContFrm Public Class frmAddCont Public Class ControlObject Dim Title As String Dim FName As String Dim SName As String Dim Address As String Dim TelephoneNumber As Integer Dim emailAddress As String Dim Website As String Dim Photograph As String End Class Private Sub btnConfirmAdd_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnConfirmAdd.Click Dim C As New Contact C.Display() Me.Hide() End Sub Private Sub frmAddCont_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load End Sub End Class and frmStart.vb Public Class frmStart Private Sub btnAdd_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnAdd.Click frmAddCont.Show() End Sub Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnDel.Click Dim DelCont As Contact DelCont = Me.lstContact.SelectedItem() lstContact.Items.Remove(DelCont) End Sub Private Sub lstContact_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles lstContact.SelectedIndexChanged End Sub Private Sub btnEdit_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnEdit.Click Dim C As Contact If lstContact.SelectedItem IsNot Nothing Then C = DirectCast(lstContact.SelectedItem, Contact) C.Display() End If End Sub End Class

    Read the article

  • help date format in vb.net

    - by bachchan
    Dim Con As OleDb.OleDbConnection Dim Sql As String = Nothing Dim Reader As OleDb.OleDbDataReader Dim ComboRow As Integer = -1 Dim Columns As Integer = 0 Dim Category As String = Nothing Dim oDatumMin As Date Dim column As String column = Replace(TxtDateMax.Text, "'", "''") 'oDatumMin = Convert.ToDateTime(TxtDateMin.Text) oDatumMin = DtpMin.Value Dim oPath As String oPath = Application.StartupPath ' Select records. Con = New OleDb.OleDbConnection("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & oPath & "\trb.accdb;") Dim cmd As New OleDb.OleDbCommand 'Dim data_reader As OleDbDataReader = cmd.ExecuteReader() Sql = ("SELECT * FROM " & cmbvalue & " WHERE Datum>='" & oDatumMin & "'") cmd = New OleDb.OleDbCommand(Sql, Con) Con.Open() Reader = cmd.ExecuteReader() Do While Reader.Read() Dim new_item As New ListViewItem(Reader.Item("Datum").ToString) new_item.SubItems.Add(Reader.Item("Steleks i krpe za cišcenje-toal papir-ubrusi-domestos").ToString) new_item.SubItems.Add(Reader.Item("TEKUCINA ZA CIŠCENJE PLOCICA").ToString) new_item.SubItems.Add(Reader.Item("KESE ZA SMECE").ToString) new_item.SubItems.Add(Reader.Item("OSTALO-džoger-spužva za laminat").ToString) new_item.SubItems.Add(Reader.Item("PAPIR").ToString) LvIzvjestaj.Items.Add(new_item) Loop ' Close the connection.strong text Con.Close()`` when i select table,(cmbvalue) from combobox and when i select date from datetime picker (dtp) or in last case from texbox converted to date and time sql looks like this "SELECT * FROM Uprava WHERE Datum='2.6.2010 10:28:14'" and all query looks ok but am geting Data type mismatch in criteria expression. error for date (oDatumMin) when excute column in access is also set to date i have no idea what else to try

    Read the article

  • Make datalist into 3 x 3

    - by unknown
    This is my code behind for products page. The prodblem is that my datalist will fill in new items whenever I add a new object in the website. So may I know how to add the codes in so that I can make the datalist into 3x3. Thanks. Code behind Protected Sub Page_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load Dim Product As New Product Dim DataSet As New DataSet Dim pds As New PagedDataSource DataSet = Product.GetProduct Session("Dataset") = DataSet pds.PageSize = 4 pds.AllowPaging = True pds.CurrentPageIndex = 1 Session("Page") = pds If Not Page.IsPostBack Then UpdateDatabind() End If End Sub Sub UpdateDatabind() Dim DataSet As DataSet = Session("DataSet") If DataSet.Tables(0).Rows.Count > 0 Then pds.DataSource = DataSet.Tables(0).DefaultView Session("Page") = pds dlProducts.DataSource = DataSet.Tables(0).DefaultView dlProducts.DataBind() lblCount.Text = DataSet.Tables(0).Rows.Count End If End Sub Private Sub dlProducts_UpdateCommand(source As Object, e As System.Web.UI.WebControls.DataListCommandEventArgs) Handles dlProducts.UpdateCommand dlProducts.DataBind() End Sub Public Sub PrevNext_Command(source As Object, e As CommandEventArgs) Dim pds As PagedDataSource = Session("Page") Dim CurrentPage = pds.CurrentPageIndex If e.CommandName = "Previous" Then If CurrentPage < 1 Or CurrentPage = pds.IsFirstPage Then CurrentPage = 1 Else CurrentPage -= 1 End If UpdateDatabind() ElseIf e.CommandName = "Next" Then If CurrentPage > pds.PageCount Or CurrentPage = pds.IsLastPage Then CurrentPage = CurrentPage Else CurrentPage += 1 End If UpdateDatabind() End If Response.Redirect("Products.aspx?PageIndex=" & CurrentPage) End Sub this is my code for product.vb Public Function GetProduct() As DataSet Dim strConn As String strConn = ConfigurationManager.ConnectionStrings("HomeFurnitureConnectionString").ToString Dim conn As New SqlConnection(strConn) Dim strSql As String 'strSql = "SELECT * FROM Product p INNER JOIN ProductDetail pd ON p.ProdID = pd.ProdID " & _ ' "WHERE pd.PdColor = (SELECT min(PdColor) FROM ProductDetail as pd1 WHERE pd1.ProdID = p.ProdID)" Dim cmd As New SqlCommand(strSql, conn) Dim ds As New DataSet Dim da As New SqlDataAdapter(cmd) conn.Open() da.Fill(ds) conn.Close() Return ds End Function

    Read the article

  • Why is my arrow texture being drawn in odd places?

    - by tyjkenn
    This is a script I wrote that places an arrow on the screen, pointing to an enemy off-screen, or, if the enemy is on-screen, it places an arrow hovering above the enemy. Everything seems to work, except for some odd reason, I see random arrows floating around, often skewed and resized (which I really don't understand, because I only rotate and place in this script). Even when I only have one enemy in the scene, I still see these random arrows. It should only be drawing one per enemy. Note: when all enemies are removed, no arrows appear. var arrow : Texture; var cam : Camera; var dim : int = 30; function OnGUI() { var objects = GameObject.FindGameObjectsWithTag("Enemy"); for(var ob : GameObject in objects) { var pos = cam.WorldToViewportPoint(ob.transform.position); if(gameObject.GetComponent(FollowCamera).target != null){ var tar = gameObject.GetComponent(FollowCamera).target.parent; } if(pos.z>1 && ob.transform != tar){ var xDiff = (pos.x*cam.pixelWidth)-(cam.pixelWidth/2); var yDiff = (pos.y*cam.pixelHeight)-(cam.pixelHeight/2); var angle = Mathf.Rad2Deg*Mathf.Atan(yDiff/xDiff)+180; if(xDiff>0) angle += 180; var dist = Mathf.Sqrt(xDiff*xDiff + yDiff*yDiff); var slope = yDiff/xDiff; var camSlope = cam.pixelHeight/cam.pixelWidth; var theX = -1000.0; var theY = -1000.0; var mult = 0; var temp; if(Mathf.Abs(xDiff)>(cam.pixelWidth/2)||Mathf.Abs(yDiff)>(cam.pixelHeight/2)){ //touching right if(slope<camSlope && slope>-camSlope) { if(xDiff>(cam.pixelWidth/2)) { theX = cam.pixelWidth - (dim/2); mult = -1; }else if(xDiff<-(cam.pixelWidth/2)) { theX = (dim/2); mult = 1; } temp = ((cam.pixelWidth/2)*yDiff)/xDiff; theY =(cam.pixelHeight/2)+(mult*temp); } else{ if(yDiff>(cam.pixelHeight/2)) { theY = (dim/2); mult = 1; }else if(yDiff<-(cam.pixelHeight/2)) { theY = cam.pixelHeight - (dim/2); mult = -1; } temp = ((cam.pixelHeight/2)*xDiff)/yDiff; theX =(cam.pixelWidth/2)+(mult*temp); } } else { angle = -90; theX = (cam.pixelWidth/2)+xDiff; theY = (cam.pixelHeight/2)-yDiff-dim; } GUIUtility.RotateAroundPivot(-angle, Vector2(theX, theY)); Graphics.DrawTexture(Rect(theX-(dim/2),theY-(dim/2),dim,dim),arrow,null); GUIUtility.RotateAroundPivot(angle, Vector2(theX, theY)); } } }

    Read the article

  • How do I remove the time from printpreview dialog?

    - by Albo Best
    Here is my code: Imports System.Data.OleDb Imports System.Drawing.Printing Namespace Print Public Class Form1 Inherits System.Windows.Forms.Form Dim PrintC As PrinterClass Dim conn As OleDb.OleDbConnection Dim connectionString As String = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=..\\db1.mdb" Dim sql As String = String.Empty Dim ds As DataSet Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load FillDataGrid() '//create printerclass object PrintC = New PrinterClass(PrintDocument1, dataGrid) End Sub Private Sub FillDataGrid() Try Dim dt As New DataTable Dim ds As New DataSet ds.Tables.Add(dt) Dim da As New OleDbDataAdapter con.Open() da = New OleDbDataAdapter("SELECT * from klient ", con) da.Fill(dt) con.Close() dataGrid.DataSource = dt.DefaultView Dim dTable As DataTable For Each dTable In ds.Tables Dim dgStyle As DataGridTableStyle = New DataGridTableStyle dgStyle.MappingName = dTable.TableName dataGrid.TableStyles.Add(dgStyle) Next ' DataGrid settings dataGrid.CaptionText = "TE GJITHE KLIENTET" dataGrid.HeaderFont = New Font("Verdana", 12) dataGrid.TableStyles(0).GridColumnStyles(0).Width = 60 dataGrid.TableStyles(0).GridColumnStyles(1).Width = 140 dataGrid.TableStyles(0).GridColumnStyles(2).Width = 140 dataGrid.TableStyles(0).GridColumnStyles(3).Width = 140 dataGrid.TableStyles(0).GridColumnStyles(4).Width = 140 dataGrid.TableStyles(0).GridColumnStyles(5).HeaderText = "" dataGrid.TableStyles(0).GridColumnStyles(5).Width = -1 Catch ex As Exception MessageBox.Show(ex.Message) End Try End Sub Private Sub btnPrint_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnPrint.Click 'create printerclass object PrintC = New PrinterClass(PrintDocument1, dataGrid) PrintDocument1.Print() End Sub Private Sub btnPreview_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnPreview.Click 'create printerclass object PrintC = New PrinterClass(PrintDocument1, dataGrid) ''preview Dim ps As New PaperSize("A4", 840, 1150) ps.PaperName = PaperKind.A4 PrintDocument1.DefaultPageSettings.PaperSize = ps PrintPreviewDialog1.WindowState = FormWindowState.Normal PrintPreviewDialog1.StartPosition = FormStartPosition.CenterScreen PrintPreviewDialog1.ClientSize = New Size(600, 600) PrintPreviewDialog1.ShowDialog() End Sub Private Sub PrintDocument1_PrintPage(ByVal sender As System.Object, ByVal e As System.Drawing.Printing.PrintPageEventArgs) Handles PrintDocument1.PrintPage 'print grid Dim morepages As Boolean = PrintC.Print(e.Graphics) If (morepages) Then e.HasMorePages = True End If End Sub End Class End Namespace This is how data looks in DataGrid (that's perfect)... and here is how it looks when I click PrintPreview. (I don't want the time to appear there, the "12:00:00" part. in database the date is stored as Short Date (10-Dec-12) Can somebody suggest a way around that? Imports System Imports System.Windows.Forms Imports System.Drawing Imports System.Drawing.Printing Imports System.Collections Imports System.Data Namespace Print Public Class PrinterClass '//clone of Datagrid Dim PrintGrid As Grid '//printdocument for initial printer settings Private PrintDoc As PrintDocument '//defines whether the grid is ordered right to left Private bRightToLeft As Boolean '//Current Top Private CurrentY As Single = 0 '//Current Left Private CurrentX As Single = 0 '//CurrentRow to print Private CurrentRow As Integer = 0 '//Page Counter Public PageCounter As Integer = 0 '/// <summary> '/// Constructor Class '/// </summary> '/// <param name="pdocument"></param> '/// <param name="dgrid"></param> Public Sub New(ByVal pdocument As PrintDocument, ByVal dgrid As DataGrid) 'MyBase.new() PrintGrid = New Grid(dgrid) PrintDoc = pdocument '//The grid columns are right to left bRightToLeft = dgrid.RightToLeft = RightToLeft.Yes '//init CurrentX and CurrentY CurrentY = pdocument.DefaultPageSettings.Margins.Top CurrentX = pdocument.DefaultPageSettings.Margins.Left End Sub Public Function Print(ByVal g As Graphics, ByRef currentX As Single, ByRef currentY As Single) As Boolean '//use predefined area currentX = currentX currentY = currentY PrintHeaders(g) Dim Morepages As Boolean = PrintDataGrid(g) currentY = currentY currentX = currentX Return Morepages End Function Public Function Print(ByVal g As Graphics) As Boolean CurrentX = PrintDoc.DefaultPageSettings.Margins.Left CurrentY = PrintDoc.DefaultPageSettings.Margins.Top PrintHeaders(g) Return PrintDataGrid(g) End Function '/// <summary> '/// Print the Grid Headers '/// </summary> '/// <param name="g"></param> Private Sub PrintHeaders(ByVal g As Graphics) Dim sf As StringFormat = New StringFormat '//if we want to print the grid right to left If (bRightToLeft) Then CurrentX = PrintDoc.DefaultPageSettings.PaperSize.Width - PrintDoc.DefaultPageSettings.Margins.Right sf.FormatFlags = StringFormatFlags.DirectionRightToLeft Else CurrentX = PrintDoc.DefaultPageSettings.Margins.Left End If Dim i As Integer For i = 0 To PrintGrid.Columns - 1 '//set header alignment Select Case (CType(PrintGrid.Headers.GetValue(i), Header).Alignment) Case HorizontalAlignment.Left 'left sf.Alignment = StringAlignment.Near Case HorizontalAlignment.Center sf.Alignment = StringAlignment.Center Case HorizontalAlignment.Right sf.Alignment = StringAlignment.Far End Select '//advance X according to order If (bRightToLeft) Then '//draw the cell bounds (lines) and back color g.FillRectangle(New SolidBrush(PrintGrid.HeaderBackColor), CurrentX - PrintGrid.Headers(i).Width, CurrentY, PrintGrid.Headers(i).Width, PrintGrid.Headers(i).Height) g.DrawRectangle(New Pen(PrintGrid.LineColor), CurrentX - PrintGrid.Headers(i).Width, CurrentY, PrintGrid.Headers(i).Width, PrintGrid.Headers(i).Height) '//draw the cell text g.DrawString(PrintGrid.Headers(i).CText, PrintGrid.Headers(i).Font, New SolidBrush(PrintGrid.HeaderForeColor), New RectangleF(CurrentX - PrintGrid.Headers(i).Width, CurrentY, PrintGrid.Headers(i).Width, PrintGrid.Headers(i).Height), sf) '//next cell CurrentX -= PrintGrid.Headers(i).Width Else '//draw the cell bounds (lines) and back color g.FillRectangle(New SolidBrush(PrintGrid.HeaderBackColor), CurrentX, CurrentY, PrintGrid.Headers(i).Width, PrintGrid.Headers(i).Height) g.DrawRectangle(New Pen(PrintGrid.LineColor), CurrentX, CurrentY, PrintGrid.Headers(i).Width, PrintGrid.Headers(i).Height) '//draw the cell text g.DrawString(PrintGrid.Headers(i).CText, PrintGrid.Headers(i).Font, New SolidBrush(PrintGrid.HeaderForeColor), New RectangleF(CurrentX, CurrentY, PrintGrid.Headers(i).Width, PrintGrid.Headers(i).Height), sf) '//next cell CurrentX += PrintGrid.Headers(i).Width End If Next '//reset to beginning If (bRightToLeft) Then '//right align CurrentX = PrintDoc.DefaultPageSettings.PaperSize.Width - PrintDoc.DefaultPageSettings.Margins.Right Else '//left align CurrentX = PrintDoc.DefaultPageSettings.Margins.Left End If '//advance to next row CurrentY = CurrentY + CType(PrintGrid.Headers.GetValue(0), Header).Height End Sub Private Function PrintDataGrid(ByVal g As Graphics) As Boolean Dim sf As StringFormat = New StringFormat PageCounter = PageCounter + 1 '//if we want to print the grid right to left If (bRightToLeft) Then CurrentX = PrintDoc.DefaultPageSettings.PaperSize.Width - PrintDoc.DefaultPageSettings.Margins.Right sf.FormatFlags = StringFormatFlags.DirectionRightToLeft Else CurrentX = PrintDoc.DefaultPageSettings.Margins.Left End If Dim i As Integer For i = CurrentRow To PrintGrid.Rows - 1 Dim j As Integer For j = 0 To PrintGrid.Columns - 1 '//set cell alignment Select Case (PrintGrid.Cell(i, j).Alignment) '//left Case HorizontalAlignment.Left sf.Alignment = StringAlignment.Near Case HorizontalAlignment.Center sf.Alignment = StringAlignment.Center '//right Case HorizontalAlignment.Right sf.Alignment = StringAlignment.Far End Select '//advance X according to order If (bRightToLeft) Then '//draw the cell bounds (lines) and back color g.FillRectangle(New SolidBrush(PrintGrid.BackColor), CurrentX - PrintGrid.Cell(i, j).Width, CurrentY, PrintGrid.Cell(i, j).Width, PrintGrid.Cell(i, j).Height) g.DrawRectangle(New Pen(PrintGrid.LineColor), CurrentX - PrintGrid.Cell(i, j).Width, CurrentY, PrintGrid.Cell(i, j).Width, PrintGrid.Cell(i, j).Height) '//draw the cell text g.DrawString(PrintGrid.Cell(i, j).CText, PrintGrid.Cell(i, j).Font, New SolidBrush(PrintGrid.ForeColor), New RectangleF(CurrentX - PrintGrid.Cell(i, j).Width, CurrentY, PrintGrid.Cell(i, j).Width, PrintGrid.Cell(i, j).Height), sf) '//next cell CurrentX -= PrintGrid.Cell(i, j).Width Else '//draw the cell bounds (lines) and back color g.FillRectangle(New SolidBrush(PrintGrid.BackColor), CurrentX, CurrentY, PrintGrid.Cell(i, j).Width, PrintGrid.Cell(i, j).Height) g.DrawRectangle(New Pen(PrintGrid.LineColor), CurrentX, CurrentY, PrintGrid.Cell(i, j).Width, PrintGrid.Cell(i, j).Height) '//draw the cell text '//Draw text by alignment g.DrawString(PrintGrid.Cell(i, j).CText, PrintGrid.Cell(i, j).Font, New SolidBrush(PrintGrid.ForeColor), New RectangleF(CurrentX, CurrentY, PrintGrid.Cell(i, j).Width, PrintGrid.Cell(i, j).Height), sf) '//next cell CurrentX += PrintGrid.Cell(i, j).Width End If Next '//reset to beginning If (bRightToLeft) Then '//right align CurrentX = PrintDoc.DefaultPageSettings.PaperSize.Width - PrintDoc.DefaultPageSettings.Margins.Right Else '//left align CurrentX = PrintDoc.DefaultPageSettings.Margins.Left End If '//advance to next row CurrentY += PrintGrid.Cell(i, 0).Height CurrentRow += 1 '//if we are beyond the page margin (bottom) then we need another page, '//return true If (CurrentY > PrintDoc.DefaultPageSettings.PaperSize.Height - PrintDoc.DefaultPageSettings.Margins.Bottom) Then Return True End If Next Return False End Function End Class End Namespace

    Read the article

  • How can I load style resources from a dynamically loaded Silverlight application (XAP)?

    - by Tom
    I've followed Tim Heuer's video for dynamically loading other XAP's (into a 'master' Silverlight application), as well as some other links to tweak the loading of resources and am stuck on the particular issue of loading style resources from within the dynamically loaded XAP (i.e. the contents of Assets\Styles.xaml). When I run the master/hosting applcation, it successfully streams the dynamic XAP and I can read the deployment info etc. and load the assembly parts. However, when I actuall try to create an instance of a form from the Dynamic XAP, it fails with Cannot find a Resource with the Name/Key LayoutRootGridStyle which is in it's Assets\Styles.xaml file (it works if I run it directly so I know it's OK). For some reason these don't show up as application resources - not sure if I've totally got the wrong end of the stick, or am just missing something? Code snippet below (apologies it's a bit messy - just trying to get it working first) ... '' # Here's the code that reads the dynamic XAP from the web server ... '' #... wCli = New WebClient AddHandler wCli.OpenReadCompleted, AddressOf OpenXAPCompleted wCli.OpenReadAsync(New Uri("MyTest.xap", UriKind.Relative)) '' #... '' #Here's the sub that's called when openread is completed '' #... Private Sub OpenXAPCompleted(ByVal sender As Object, ByVal e As System.Net.OpenReadCompletedEventArgs) Dim sManifest As String = New StreamReader(Application.GetResourceStream(New StreamResourceInfo(e.Result, Nothing), New Uri("AppManifest.xaml", UriKind.Relative)).Stream).ReadToEnd Dim deploymentRoot As XElement = XDocument.Parse(sManifest).Root Dim deploymentParts As List(Of XElement) = _ (From assemblyParts In deploymentRoot.Elements().Elements() Select assemblyParts).ToList() Dim oAssembly As Assembly = Nothing For Each xElement As XElement In deploymentParts Dim asmPart As AssemblyPart = New AssemblyPart() Dim source As String = xElement.Attribute("Source").Value Dim sInfo As StreamResourceInfo = Application.GetResourceStream(New StreamResourceInfo(e.Result, "application/binary"), New Uri(source, UriKind.Relative)) If source = "MyTest.dll" Then oAssembly = asmPart.Load(sInfo.Stream) Else asmPart.Load(sInfo.Stream) End If Next Dim t As Type() = oAssembly.GetTypes() Dim AppClass = (From parts In t Where parts.FullName.EndsWith(".App") Select parts).SingleOrDefault() Dim mykeys As Array If Not AppClass Is Nothing Then Dim a As Application = DirectCast(oAssembly.CreateInstance(AppClass.FullName), Application) For Each strKey As String In a.Resources.Keys If Not Application.Current.Resources.Contains(strKey) Then Application.Current.Resources.Add(strKey, a.Resources(strKey)) End If Next End If Dim objectType As Type = oAssembly.GetType("MyTest.MainPage") Dim ouiel = Activator.CreateInstance(objectType) Dim myData As UIElement = DirectCast(ouiel, UIElement) Me.splMain.Children.Add(myData) Me.splMain.UpdateLayout() End Sub '' #... '' # And here's the line that fails with "Cannot find a Resource with the Name/Key LayoutRootGridStyle" '' # ... System.Windows.Application.LoadComponent(Me, New System.Uri("/MyTest;component/MainPage.xaml", System.UriKind.Relative)) '' #... any thoughts?

    Read the article

  • Handling Errors from HttpWebRequest.GetResponse

    - by Jason
    Hey experts - I'm having a ridiculous time trying to get an SMS API working (ZeepMobile, if you're interested) with .NET... I've been around .NET for a few years, but with all this social networking and API stuff, I need to get into the HttpWebRequest a bit. I'm new at it, but not completely new; I was able to hook up my site to Twitter without too much fuss (ie, I was able to modify someone's code to work for me). Anyways, the way their API works is to send an SMS message, you send them a POST and they respond back to you. I can send it just fine, but every time I do, rather than echo back something helpful to figure out what the error is, I get the Yellow Error Page Of Death (YEPOD) saying something to the effect of "The remote server returned an error: (400) Bad Request." This occurs on my line: '...creation of httpwebrequest here...' Dim myWebResponse As WebResponse myWebResponse = request.GetResponse() '<--- error line Is there any way to simply receive the error from the server rather than have the webserver throw an exception and give me the YEPOD? Or better yet, can anyone post a working example of their Zeep code? :) Thanks! EDIT: Here's my whole code block: Public Shared Function SendTextMessage(ByVal username As String, _ ByVal txt As String) As String Dim content As String = "user_id=" + _ username + "&body=" + Current.Server.UrlEncode(txt) Dim httpDate As String = DateTime.Now.ToString("r") Dim canonicalString As String = API_KEY & httpDate & content Dim encoding As New System.Text.UTF8Encoding Dim hmacSha As New HMACSHA1(encoding.GetBytes(SECRET_ACCESS_KEY)) Dim hash() As Byte = hmacSha.ComputeHash(encoding.GetBytes(canonicalString)) Dim b64 As String = Convert.ToBase64String(hash) 'connect with zeep' Dim request As HttpWebRequest = CType(WebRequest.Create(_ "https://api.zeepmobile.com/messaging/2008-07-14/send_message"), HttpWebRequest) request.Method = "POST" request.ServicePoint.Expect100Continue = False ' set the authorization levels' request.Headers.Add("Authorization", "Zeep " & API_KEY & ":" & b64) request.ContentType = "application/x-www-form-urlencoded" request.ContentLength = content.Length ' set up and write to stream' Dim reqStream As New StreamWriter(request.GetRequestStream()) reqStream.Write(content) reqStream.Close() Dim msg As String = "" msg = reqStream.ToString Dim myWebResponse As WebResponse Dim myResponseStream As Stream Dim myStreamReader As StreamReader myWebResponse = request.GetResponse() myResponseStream = myWebResponse.GetResponseStream() myStreamReader = New StreamReader(myResponseStream) msg = myStreamReader.ReadToEnd() myStreamReader.Close() myResponseStream.Close() ' Close the WebResponse' myWebResponse.Close() Return msg End Function

    Read the article

  • How to autostart this slide

    - by lchales
    Hello there: first of all i have no idea on coding or anything related, simple question: is there any simple way to tell this code to autostart the slide? at the current moment the images change on click. currently the index page only have one image, what i want is to add a few but without the need to click to see the next one here is the code from my index: <script type="text/javascript"> //<![CDATA[ /* the images preload plugin */ (function($) { $.fn.preload = function(options) { var opts = $.extend({}, $.fn.preload.defaults, options), o = $.meta ? $.extend({}, opts, this.data()) : opts; var c = this.length, l = 0; return this.each(function() { var $i = $(this); $('<img/>').load(function(i){ ++l; if(l == c) o.onComplete(); }).attr('src',$i.attr('src')); }); }; $.fn.preload.defaults = { onComplete : function(){return false;} }; })(jQuery); //]]> </script><script type="text/javascript"> //<![CDATA[ $(function() { var $tf_bg = $('#tf_bg'), $tf_bg_images = $tf_bg.find('img'), $tf_bg_img = $tf_bg_images.eq(0), $tf_thumbs = $('#tf_thumbs'), total = $tf_bg_images.length, current = 0, $tf_content_wrapper = $('#tf_content_wrapper'), $tf_next = $('#tf_next'), $tf_prev = $('#tf_prev'), $tf_loading = $('#tf_loading'); //preload the images $tf_bg_images.preload({ onComplete : function(){ $tf_loading.hide(); init(); } }); //shows the first image and initializes events function init(){ //get dimentions for the image, based on the windows size var dim = getImageDim($tf_bg_img); //set the returned values and show the image $tf_bg_img.css({ width : dim.width, height : dim.height, left : dim.left, top : dim.top }).fadeIn(); //resizing the window resizes the $tf_bg_img $(window).bind('resize',function(){ var dim = getImageDim($tf_bg_img); $tf_bg_img.css({ width : dim.width, height : dim.height, left : dim.left, top : dim.top }); }); //expand and fit the image to the screen $('#tf_zoom').live('click', function(){ if($tf_bg_img.is(':animated')) return false; var $this = $(this); if($this.hasClass('tf_zoom')){ resize($tf_bg_img); $this.addClass('tf_fullscreen') .removeClass('tf_zoom'); } else{ var dim = getImageDim($tf_bg_img); $tf_bg_img.animate({ width : dim.width, height : dim.height, top : dim.top, left : dim.left },350); $this.addClass('tf_zoom') .removeClass('tf_fullscreen'); } } ); //click the arrow down, scrolls down $tf_next.bind('click',function(){ if($tf_bg_img.is(':animated')) return false; scroll('tb'); }); //click the arrow up, scrolls up $tf_prev.bind('click',function(){ if($tf_bg_img.is(':animated')) return false; scroll('bt'); }); //mousewheel events - down / up button trigger the scroll down / up $(document).mousewheel(function(e, delta) { if($tf_bg_img.is(':animated')) return false; if(delta > 0) scroll('bt'); else scroll('tb'); return false; }); //key events - down / up button trigger the scroll down / up $(document).keydown(function(e){ if($tf_bg_img.is(':animated')) return false; switch(e.which){ case 38: scroll('bt'); break; case 40: scroll('tb'); break; } }); } //show next / prev image function scroll(dir){ //if dir is "tb" (top -> bottom) increment current, //else if "bt" decrement it current = (dir == 'tb')?current + 1:current - 1; //we want a circular slideshow, //so we need to check the limits of current if(current == total) current = 0; else if(current < 0) current = total - 1; //flip the thumb $tf_thumbs.flip({ direction : dir, speed : 400, onBefore : function(){ //the new thumb is set here var content = '<span id="tf_zoom" class="tf_zoom"><\/span>'; content +='<img src="' + $tf_bg_images.eq(current).attr('longdesc') + '" alt="Thumb' + (current+1) + '"/>'; $tf_thumbs.html(content); } }); //we get the next image var $tf_bg_img_next = $tf_bg_images.eq(current), //its dimentions dim = getImageDim($tf_bg_img_next), //the top should be one that makes the image out of the viewport //the image should be positioned up or down depending on the direction top = (dir == 'tb')?$(window).height() + 'px':-parseFloat(dim.height,10) + 'px'; //set the returned values and show the next image $tf_bg_img_next.css({ width : dim.width, height : dim.height, left : dim.left, top : top }).show(); //now slide it to the viewport $tf_bg_img_next.stop().animate({ top : dim.top },700); //we want the old image to slide in the same direction, out of the viewport var slideTo = (dir == 'tb')?-$tf_bg_img.height() + 'px':$(window).height() + 'px'; $tf_bg_img.stop().animate({ top : slideTo },700,function(){ //hide it $(this).hide(); //the $tf_bg_img is now the shown image $tf_bg_img = $tf_bg_img_next; //show the description for the new image $tf_content_wrapper.children() .eq(current) .show(); }); //hide the current description $tf_content_wrapper.children(':visible') .hide() } //animate the image to fit in the viewport function resize($img){ var w_w = $(window).width(), w_h = $(window).height(), i_w = $img.width(), i_h = $img.height(), r_i = i_h / i_w, new_w,new_h; if(i_w > i_h){ new_w = w_w; new_h = w_w * r_i; if(new_h > w_h){ new_h = w_h; new_w = w_h / r_i; } } else{ new_h = w_w * r_i; new_w = w_w; } $img.animate({ width : new_w + 'px', height : new_h + 'px', top : '0px', left : '0px' },350); } //get dimentions of the image, //in order to make it full size and centered function getImageDim($img){ var w_w = $(window).width(), w_h = $(window).height(), r_w = w_h / w_w, i_w = $img.width(), i_h = $img.height(), r_i = i_h / i_w, new_w,new_h, new_left,new_top; if(r_w > r_i){ new_h = w_h; new_w = w_h / r_i; } else{ new_h = w_w * r_i; new_w = w_w; } return { width : new_w + 'px', height : new_h + 'px', left : (w_w - new_w) / 2 + 'px', top : (w_h - new_h) / 2 + 'px' }; } }); //]]> </script>

    Read the article

  • Why does vbkeyup produce different results than vbkeydown does in this Code.

    - by Joshua Rhoads
    I have a VB6 app. It consists of a flexgrid. I have code to allow the user to press the up or down arrow key to switch rows in the grid. When the down arrow key is pressed the cursor is placed at the end of the text in the next row, but when the Up arrow key is pressed the cursor is placed in the middle of the text of the previous row. Anybody have any explantion for this. Private Sub Command1_Click() With MSFlexGrid1 .Cols = 4 .Rows = 5 .FixedCols = 1 .FixedRows = 1 MSFlexGrid1.TextMatrix(0, 1) = "FROM" MSFlexGrid1.TextMatrix(0, 2) = "THRU" MSFlexGrid1.TextMatrix(0, 3) = "PAGE" MSFlexGrid1.TextMatrix(1, 1) = "Aa" MSFlexGrid1.TextMatrix(1, 2) = "Az" MSFlexGrid1.TextMatrix(1, 3) = "-" MSFlexGrid1.TextMatrix(2, 1) = "Ba" MSFlexGrid1.TextMatrix(2, 2) = "Bz" MSFlexGrid1.TextMatrix(2, 3) = "-" MSFlexGrid1.TextMatrix(3, 1) = "Ca" MSFlexGrid1.TextMatrix(3, 2) = "Cz" MSFlexGrid1.TextMatrix(3, 3) = "-" MSFlexGrid1.TextMatrix(4, 1) = "Da" MSFlexGrid1.TextMatrix(4, 2) = "Dz" MSFlexGrid1.TextMatrix(4, 3) = "-" End With End Sub Private Sub Command2_Click() End End Sub Private Sub Form_Load() Text1.Visible = False End Sub Private Sub MSFlexGrid1_DblClick() FlexGridEdit Asc(" ") Exit Sub End Sub Private Sub FlexGridEdit(KeyAscii As Integer) Text1.Left = MSFlexGrid1.CellLeft + MSFlexGrid1.Left Text1.Top = MSFlexGrid1.CellTop + MSFlexGrid1.Top Text1.Width = MSFlexGrid1.ColWidth(MSFlexGrid1.Col) - 2 * (MSFlexGrid1.ColWidth (MSFlexGrid1.Col) - MSFlexGrid1.CellWidth) Text1.Height = MSFlexGrid1.RowHeight(MSFlexGrid1.Row) - 2 * (MSFlexGrid1.RowHeight(MSFlexGrid1.Row) - MSFlexGrid1.CellHeight) Text1.MaxLength = 2 Text1.Visible = True Text1.SetFocus Select Case KeyAscii Case 0 To Asc(" ") Text1.Text = MSFlexGrid1.Text Text1.SelStart = Len(Text1.Text) Case Else Text1.Text = Chr$(KeyAscii) Text1.SelStart = 1 End Select Exit Sub End Sub Function ValidateFlexGrid1() As Boolean Dim llCntrRow As Integer Dim llCntrCol As Integer Dim max_len As Single Dim new_len As Single Dim liCntr As Integer Dim lsCheck As String With MSFlexGrid1 If Text1.Visible Then .Text = Text1.Text If .Rows = .FixedRows Then ValidateFlexGrid1 = False End If For llCntrCol = .FixedCols To MSFlexGrid1.Cols - 1 For llCntrRow = .FixedRows To MSFlexGrid1.Rows - 1 If .TextMatrix(llCntrRow, llCntrCol) = "" Then ValidateFlexGrid1 = False Exit Function End If Next llCntrRow Next llCntrCol End With ValidateFlexGrid1 = True Exit Function End Function Private Sub Text1_Keydown(KeyCode As Integer, Shift As Integer) Select Case KeyCode Case vbKeyRight, vbKeyLeft, vbKeyReturn If Text1.Visible = True Then If Text1.Text = "/" Then If MSFlexGrid1.Row > 1 Then Text1.Text = MSFlexGrid1.TextMatrix(MSFlexGrid1.Row - 1, MSFlexGrid1.Col) Text1.SelStart = Len(Text1.Text) End If End If MSFlexGrid1.Text = Text1.Text If KeyCode = vbKeyRight Or KeyCode = vbKeyReturn Then If Text1.SelStart = Len(Text1.Text) Then FlexGridChkPos KeyCode FlexGridEdit Asc(" ") End If Else If Text1.SelStart = 0 Then FlexGridChkPos KeyCode FlexGridEdit Asc(" ") End If End If End If Case vbKeyDown, vbKeyUp If Text1.Visible = True Then MSFlexGrid1.Text = Text1.Text FlexGridChkPos KeyCode FlexGridEdit Asc(" ") End If End Select Exit Sub End Sub Function FlexGridChkPos(KeyCode As Integer) As Boolean Dim llNextRow As Long Dim llNextCol As Long Dim llCurrCol As Long Dim llCurrRow As Long Dim llTotCols As Long Dim llTotRows As Long Dim llBegRow As Long Dim llBegCol As Long Dim llCntrCol As Long Dim lsText As String With MSFlexGrid1 llCurrRow = .Row + 1 llCurrCol = .Col + 1 llTotRows = .Rows llTotCols = .Cols llBegRow = .FixedRows llBegCol = .FixedCols If KeyCode = vbKeyRight Or KeyCode = vbKeyReturn Then llNextCol = llCurrCol + 1 If llNextCol > llTotCols Then llNextRow = llCurrRow + 1 If llNextRow > llTotRows Then .Rows = .Rows + 1 llCurrRow = llCurrRow + 1 llCurrCol = 1 + llBegCol Else llCurrRow = llNextRow llCurrCol = 1 + llBegCol End If Else llCurrCol = llNextCol End If End If If KeyCode = vbKeyLeft Then llNextCol = llCurrCol - 1 If llNextCol = llBegCol Then llNextRow = llCurrRow - 1 If llNextRow = llBegRow Then llCurrRow = llTotRows Else llCurrRow = llNextRow End If llCurrCol = llTotCols Else llCurrCol = llNextCol End If End If If KeyCode = vbKeyUp Then llNextRow = llCurrRow - 1 If llNextRow = llBegRow Then llCurrRow = llTotRows Else llCurrRow = llNextRow End If End If If KeyCode = vbKeyDown Then llNextRow = llCurrRow + 1 If llNextRow > llTotRows Then llCurrRow = llBegRow + 1 Else llCurrRow = llNextRow End If End If .Col = llCurrCol - 1 .Row = llCurrRow - 1 End With Exit Function End Function

    Read the article

  • 3D Triangle - WPF

    - by user300423
    I am trying to apply an image brush to a Triangle in WPF without success. What am i doing wrong? This is my attempt: Dim ModelTri As New MeshGeometry3D ModelTri.Positions.Add(New Point3D(0, 0, 0)) ModelTri.Positions.Add(New Point3D(100, 0, 0)) ModelTri.Positions.Add(New Point3D(100, 100, 0)) Dim MeshTri As New MeshGeometry3D MeshTri.TriangleIndices.Add(0) MeshTri.TriangleIndices.Add(1) MeshTri.TriangleIndices.Add(2) 'Texture Dim TexturePoints As New PointCollection TexturePoints.Add(New Point(100, 0)) TexturePoints.Add(New Point(0, 100)) TexturePoints.Add(New Point(100, 100)) MeshTri.TextureCoordinates = TexturePoints 'Image Brush Dim imgBrush As New ImageBrush() imgBrush.ImageSource = New BitmapImage(New Uri("Mercury.jpg", UriKind.Relative)) imgBrush.Stretch = Stretch.Fill imgBrush.TileMode = TileMode.Tile imgBrush.SetValue(NameProperty, "imgBrush") Dim Mat As Material Dim DMaterial As New DiffuseMaterial DMaterial.Brush = imgBrush Dim Bind As New Binding("imgBrush") Bind.Source = imgBrush BindingOperations.SetBinding(DMaterial, BindingGroupProperty, Bind) 'This doesnt work Mat = DMaterial 'This works 'Mat = New DiffuseMaterial(New SolidColorBrush(Colors.Khaki)) Dim triangleModel As GeometryModel3D = New GeometryModel3D(ModelTri, Mat) Dim model As New ModelVisual3D() model.Content = triangleModel Viewport.Children.Add(model)

    Read the article

  • Google Street View API v3 : how can I avoid having "fish-eye" effect on Firefox?

    - by Benj
    I'm using google maps API V3 and I'm having trouble displaying correctly the street view within Firefox. I always get the "fish-eye" view (does not happen with Google chrome). So I assumed that the problem came from Firefox. I took a look to the street view options but found nothing. I would like to know if there is an option to have a flatten street view or if it is because Firefox does not support this kind of feature. If someone could explain it to me, I would be grateful. Below, what it looks in Firefox : And what it looks in Chrome :

    Read the article

  • Vba to Access record Insert Issue

    - by raam
    I want to insert Values to access table by using VBA control is there is any simple way to do this. i try this code but it does not work properly if i run this code it give the error 'variable not set' can anyone help me. thanks in advance Private Sub CommandButton1_Click() Dim cn As ADODB.Connection Dim strSql As String Dim lngKt As Long Dim dbConnectStr As String Dim Catalog As Object Dim cnt As ADODB.Connection Dim dbPath As String Dim myRecordset As New ADODB.Recordset Dim SQL As String, SQL2 As String dbPath = "table.accdb" dbConnectStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbPath & ";" SQL = "INSERT INTO Jun_pre (ProductName,DESCRIPTION,SKU,MT,(mt),MRP,Remark,no_of_units_in_a_case) VALUES (""aa"",""bb"",""test"",""testUnit"",""1"",""2"",,""3"",,""4"");" With cnt .Open dbConnectStr 'some other string was there .Execute (SQL) .Close End With End Sub

    Read the article

< Previous Page | 1 2 3 4 5 6 7 8 9 10 11 12  | Next Page >