00001: VERSION 5.00 00002: Object = "{39F22C0A-9929-11D7-B245-0050228AFF80}#12.0#0"; "SPctlib_SQL.ocx" 00003: Begin VB.UserControl SY_MGZakaz 00004: ClientHeight = 300 00005: ClientLeft = 0 00006: ClientTop = 0 00007: ClientWidth = 2730 00008: ScaleHeight = 300 00009: ScaleWidth = 2730 00010: Begin SPctlib.NumericBoxST fdToOrder 00011: Height = 285 00012: Left = 1395 00013: TabIndex = 3 00014: Top = 0 00015: Width = 975 00016: _ExtentX = 1720 00017: _ExtentY = 503 00018: Text = "" 00019: ForeColor = -2147483640 00020: DecimalPlaces = 0 00021: MaxValue = 1000000 00022: End 00023: Begin VB.CommandButton btRecent 00024: Caption = "•" 00025: Height = 285 00026: Left = 1200 00027: TabIndex = 1 00028: ToolTipText = "Последние" 00029: Top = 0 00030: Width = 195 00031: End 00032: Begin VB.CommandButton btOpenToOrder 00033: Enabled = 0 'False 00034: Height = 285 00035: Left = 2400 00036: Picture = "SY_MGZakaz.ctx":0000 00037: Style = 1 'Graphical 00038: TabIndex = 0 00039: ToolTipText = "Открыть заказ" 00040: Top = 0 00041: Width = 285 00042: End 00043: Begin SPctlib.CheckBoxST chToOrder 00044: Height = 255 00045: Left = 0 00046: TabIndex = 2 00047: Top = 0 00048: Width = 1395 00049: _ExtentX = 2461 00050: _ExtentY = 450 00051: ForeColor = 8388608 00052: BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 00053: Name = "MS Sans Serif" 00054: Size = 8.25 00055: Charset = 204 00056: Weight = 400 00057: Underline = 0 'False 00058: Italic = 0 'False 00059: Strikethrough = 0 'False 00060: EndProperty 00061: Caption = "к заказу №" 00062: End 00063: End 00064: Attribute VB_Name = "SY_MGZakaz" 00065: Attribute VB_GlobalNameSpace = False 00066: Attribute VB_Creatable = True 00067: Attribute VB_PredeclaredId = False 00068: Attribute VB_Exposed = False 00069: Option Explicit 00070: Private Sub btOpenToOrder_Click() 00071: MsgBox ("Sorry, пока эта пимпочка не поддерживается") 00072: End Sub 00073: Private Sub btRecent_Click() 00074: MsgBox ("Sorry, пока эта пимпочка не поддерживается") 00075: End Sub 00076: Private Sub fdToOrder_Changed() 00077: chToOrder.Value = Checked 00078: End Sub 00079: Public Function GetZakazNumber() As Long 00080: GetZakazNumber = fdToOrder.Value 00081: End Function 00082: VERSION 5.00 00083: Object = "{39F22C0A-9929-11D7-B245-0050228AFF80}#12.0#0"; "SPctlib_SQL.ocx" 00084: Begin VB.UserControl SY_MGProfile 00085: ClientHeight = 1665 00086: ClientLeft = 0 00087: ClientTop = 0 00088: ClientWidth = 6405 00089: LockControls = -1 'True 00090: ScaleHeight = 1665 00091: ScaleWidth = 6405 00092: Begin VB.CommandButton btDetete 00093: Caption = "Удалить" 00094: Height = 255 00095: Left = 5520 00096: TabIndex = 17 00097: Top = 0 00098: Width = 855 00099: End 00100: Begin VB.Frame Frame1 00101: Height = 1335 00102: Left = 0 00103: TabIndex = 2 00104: Top = 310 00105: Width = 6375 00106: Begin SPctlib.NumericBoxST txPopUpTime 00107: Height = 285 00108: Left = 1480 00109: TabIndex = 16 00110: Top = 960 00111: Width = 735 00112: _ExtentX = 1296 00113: _ExtentY = 503 00114: Text = " 0" 00115: ForeColor = -2147483640 00116: DecimalPlaces = 0 00117: MaxValue = 60 00118: End 00119: Begin SPctlib.NumericBoxST txLiveTime 00120: Height = 285 00121: Left = 1200 00122: TabIndex = 15 00123: Top = 600 00124: Width = 735 00125: _ExtentX = 1296 00126: _ExtentY = 503 00127: Text = " 0" 00128: ForeColor = -2147483640 00129: DecimalPlaces = 0 00130: MaxValue = 365 00131: End 00132: Begin VB.ComboBox cbPriority 00133: Height = 315 00134: ItemData = "SY_MGProfile.ctx":0000 00135: Left = 1200 00136: List = "SY_MGProfile.ctx":0010 00137: Style = 2 'Dropdown List 00138: TabIndex = 8 00139: Top = 240 00140: Width = 1455 00141: End 00142: Begin VB.CheckBox chTask 00143: Caption = "Это задача" 00144: ForeColor = &H00800000& 00145: Height = 255 00146: Left = 3120 00147: TabIndex = 7 00148: Top = 240 00149: Width = 3135 00150: End 00151: Begin VB.ComboBox cbLiveTimeType 00152: Height = 315 00153: Left = 1920 00154: Style = 2 'Dropdown List 00155: TabIndex = 6 00156: Top = 600 00157: Width = 735 00158: End 00159: Begin VB.CheckBox chTaskReplay 00160: Caption = "Уведомить об исполнении задачи" 00161: ForeColor = &H00800000& 00162: Height = 255 00163: Left = 3120 00164: TabIndex = 5 00165: Top = 480 00166: Width = 3135 00167: End 00168: Begin VB.CheckBox chAccept 00169: Caption = "Уведомление о получении" 00170: ForeColor = &H00800000& 00171: Height = 255 00172: Left = 3120 00173: TabIndex = 4 00174: Top = 960 00175: Width = 3135 00176: End 00177: Begin VB.CheckBox chConfirm 00178: Caption = "Требуется ""Ознакомлен""" 00179: ForeColor = &H00800000& 00180: Height = 255 00181: Left = 3120 00182: TabIndex = 3 00183: Top = 720 00184: Width = 3135 00185: End 00186: Begin VB.Label Label5 00187: Caption = "Приоритет" 00188: ForeColor = &H00800000& 00189: Height = 255 00190: Left = 120 00191: TabIndex = 12 00192: Top = 240 00193: Width = 855 00194: End 00195: Begin VB.Label Label6 00196: Caption = "мин" 00197: ForeColor = &H00800000& 00198: Height = 255 00199: Left = 2280 00200: TabIndex = 11 00201: Top = 960 00202: Width = 375 00203: End 00204: Begin VB.Label Label7 00205: Caption = "Всплывает через" 00206: ForeColor = &H00800000& 00207: Height = 255 00208: Left = 120 00209: TabIndex = 10 00210: Top = 960 00211: Width = 1455 00212: End 00213: Begin VB.Label Label9 00214: Caption = "Время жизни" 00215: ForeColor = &H00800000& 00216: Height = 255 00217: Left = 120 00218: TabIndex = 9 00219: Top = 600 00220: Width = 1335 00221: End 00222: Begin VB.Line Line2 00223: BorderColor = &H00800000& 00224: X1 = 2880 00225: X2 = 2880 00226: Y1 = 240 00227: Y2 = 1200 00228: End 00229: End 00230: Begin VB.ComboBox cbProfile 00231: Height = 315 00232: ItemData = "SY_MGProfile.ctx":0020 00233: Left = 3000 00234: List = "SY_MGProfile.ctx":0022 00235: TabIndex = 1 00236: Top = 0 00237: Width = 1335 00238: End 00239: Begin VB.CommandButton btSave 00240: Caption = "Сохранить" 00241: Height = 255 00242: Left = 4440 00243: TabIndex = 0 00244: Top = 0 00245: Width = 975 00246: End 00247: Begin VB.Label Label8 00248: Caption = "Реквизиты cообщения:" 00249: BeginProperty Font 00250: Name = "MS Sans Serif" 00251: Size = 8.25 00252: Charset = 204 00253: Weight = 700 00254: Underline = 0 'False 00255: Italic = 0 'False 00256: Strikethrough = 0 'False 00257: EndProperty 00258: ForeColor = &H00800000& 00259: Height = 255 00260: Left = 0 00261: TabIndex = 14 00262: Top = 0 00263: Width = 2115 00264: End 00265: Begin VB.Label Label4 00266: Caption = "Профиль" 00267: ForeColor = &H00800000& 00268: Height = 255 00269: Left = 2280 00270: TabIndex = 13 00271: Top = 0 00272: Width = 855 00273: End 00274: End 00275: Attribute VB_Name = "SY_MGProfile" 00276: Attribute VB_GlobalNameSpace = False 00277: Attribute VB_Creatable = True 00278: Attribute VB_PredeclaredId = False 00279: Attribute VB_Exposed = False 00280: ' 00281: 'Режимы работы задаются при инициализации контрола по InitPofile: 00282: 'ChangeEnable=True - можно выбрать профиль и считать его потом из контрола по GetProfile 00283: 'ChangeEnable=False - контрол показывает профиль сообщения, заданный в коллекции Profile 00284: ' 00285: Option Explicit 00286: Dim tm As ADODB.Recordset 00287: Dim tm1 As ADODB.Recordset 00288: Dim IsBlockSet As Boolean 00289: Dim IsBlockCheck As Boolean 00290: Dim User As Integer 00291: Dim replay As Integer 00292: Dim chConfirm_Click_block As Boolean, chTask_Click_block As Boolean, chTaskReplay_Click_block As Boolean 00293: Public Sub InitPofile(CurUser As Integer, ChangeEnable As Boolean, Optional Profile As Collection) 00294: User = CurUser 00295: IsBlockCheck = True 00296: LoadListFromDB cbPriority, FN, NetworkDB, "SY_MG_Priority", "sName", "sID", , , , , 1 00297: LoadListFromDB cbLiveTimeType, FN, NetworkDB, "SY_MG_LiveTimeType", "sName", "sID", , , , , 1 00298: IsBlockCheck = False 00299: IsBlockSet = True 00300: cbProfile.Clear 00301: LoadListFromDB cbProfile, FN, NetworkDB, "SY_MG_Profile", "sName", "sID", "CurrentUser=" & User 00302: If cbProfile.ListCount > 0 Then cbProfile.ListIndex = 0 00303: IsBlockSet = False 00304: Call cbProfile_Click 'реквизиты сообщений по профилю 00305: Dim x As Object 00306: For Each x In Controls 00307: If TypeName(x) <> "Line" Then x.Enabled = ChangeEnable 00308: Next 00309: If Not ChangeEnable Then Call LoadFromMessage(Profile) 00310: End Sub 00311: Private Sub btDetete_Click() 00312: Dim Ret As Integer 00313: Ret = SPi("SY_MG_ProfileDelete", "@sName", cbProfile.Text) 00314: If Ret = 0 Then 00315: Call InitPofile(CurrentUser, True) 00316: Else 00317: MsgBox ("Ошибка удаления профиля") 00318: End If 00319: End Sub 00320: Private Sub btSave_Click() 00321: Dim Ret As Integer 00322: Ret = SPi("SY_MG_ProfileWrite", "@sName", cbProfile.Text, "@CurrentUser", User, "@Priority", cbPriority.ItemData(cbPriority.ListIndex), "@LiveTime", txLiveTime.Text, "@LiveTimeType", cbLiveTimeType.ItemData(cbLiveTimeType.ListIndex), "@PopUP", txPopUpTime.Text, "@IsTask", chTask.Value, "@IsTaskReplay", chTaskReplay.Value, "@IsAccept", chAccept.Value, "@IsConfirm", chConfirm.Value) 00323: If Ret = 0 Then 00324: LoadListFromDB cbProfile, FN, NetworkDB, "SY_MG_Profile", "sName", "sID", "CurrentUser=" & User, , , , 1 00325: Else 00326: MsgBox ("Ошибка сохранения профиля") 00327: End If 00328: End Sub 00329: Private Sub cbProfile_Click() 00330: If IsBlockSet Then Exit Sub 00331: IsBlockCheck = True 00332: Set tm = SPr("SY_MG_ProfileRead", "@sName", cbProfile.Text, "@CurrentUser", User) 00333: If tm.EOF Then Exit Sub 00334: txLiveTime = tm("LiveTime") 00335: txPopUpTime.Text = tm("PopUP") 00336: If tm("IsTask") Then chTask.Value = 1 Else chTask.Value = 0 00337: If tm("IsTaskReplay") Then chTaskReplay.Value = 1 Else chTaskReplay.Value = 0 00338: If tm("IsAccept") Then chAccept.Value = 1 Else chAccept.Value = 0 00339: If tm("IsConfirm") Then chConfirm.Value = 1 Else chConfirm.Value = 0 00340: cbPriority.ListIndex = FindByItem(cbPriority, tm("Priority")) 00341: cbLiveTimeType.ListIndex = FindByItem(cbLiveTimeType, tm("LiveTimeType")) 00342: tm.Close 00343: IsBlockCheck = False 'теперь можно разрешить проверку по кликам комбешников 00344: End Sub 00345: 00346: Public Sub GetProfile(ByRef Priority As Integer, ByRef Livetime As Integer, ByRef LiveTimeType As Integer, ByRef PopUpTime As Integer, ByRef IsTask As Boolean, ByRef IsTaskReplay As Boolean, ByRef IsAccept As Boolean, ByRef IsConfirm As Boolean) 00347: Priority = cbPriority.ItemData(cbPriority.ListIndex) 00348: Livetime = txLiveTime.Text 00349: LiveTimeType = cbLiveTimeType.ItemData(cbLiveTimeType.ListIndex) 00350: PopUpTime = txPopUpTime.Text 00351: IsTask = chTask.Value 00352: IsTaskReplay = chTaskReplay.Value 00353: IsAccept = chAccept.Value 00354: IsConfirm = chConfirm.Value 00355: End Sub 00356: Private Sub ProfileCheck() 00357: If IsBlockCheck Then Exit Sub 00358: Set tm = SPr("SY_MG_ProfileCheck", "@CurrentUser", User, "@Priority", cbPriority.ItemData(cbPriority.ListIndex), "@LiveTime", txLiveTime, "@LiveTimeType", cbLiveTimeType.ItemData(cbLiveTimeType.ListIndex), "@PopUP", txPopUpTime.Text, "@IsTask", chTask.Value, "@IsTaskReplay", chTaskReplay.Value, "@IsAccept", chAccept.Value, "@IsConfirm", chConfirm.Value) 00359: If tm.EOF Then 00360: cbProfile.Text = "NEW" 00361: Else 00362: cbProfile.Text = tm("sName") 00363: End If 00364: tm.Close 00365: End Sub 00366: Private Sub chAccept_Click() 00367: Call ProfileCheck 00368: End Sub 00369: Private Sub chConfirm_Click() 00370: If chConfirm_Click_block Then Exit Sub 00371: chTask_Click_block = True 00372: chTaskReplay_Click_block = True 00373: chTaskReplay.Value = Unchecked 00374: chTask.Value = Unchecked 00375: chTask_Click_block = False 00376: chTaskReplay_Click_block = False 00377: Call ProfileCheck 00378: End Sub 00379: Private Sub chTask_Click() 00380: If chTask_Click_block Then Exit Sub 00381: chConfirm_Click_block = True 00382: chConfirm.Value = Unchecked 00383: chConfirm_Click_block = False 00384: Call ProfileCheck 00385: End Sub 00386: Private Sub chTaskReplay_Click() 00387: If chTaskReplay_Click_block Then Exit Sub 00388: chConfirm_Click_block = True 00389: chTask_Click_block = True 00390: chConfirm.Value = Unchecked 00391: chTask.Value = chTaskReplay.Value 00392: chConfirm_Click_block = False 00393: chTask_Click_block = False 00394: Call ProfileCheck 00395: End Sub 00396: Private Sub txLiveTime_Changed() 00397: Call ProfileCheck 00398: End Sub 00399: Private Sub cbPriority_Click() 00400: Call ProfileCheck 00401: End Sub 00402: Private Sub txPopUpTime_Changed() 00403: Call ProfileCheck 00404: End Sub 00405: Private Sub cbLiveTimeType_Change() 00406: Call ProfileCheck 00407: End Sub 00408: Private Sub cbLiveTimeType_Click() 00409: Call ProfileCheck 00410: End Sub 00411: Public Sub LoadFromMessage(Profile) 00412: Dim x As Collection 00413: Set x = Profile 00414: cbPriority.ListIndex = FindByValue(cbPriority, x(1)) 00415: txLiveTime = x(2) 00416: cbLiveTimeType.ListIndex = FindByValue(cbLiveTimeType, x(3)) 00417: txPopUpTime = x(4) 00418: chTask = IIf(x(5), 1, 0) 00419: chAccept = IIf(x(6), 1, 0) 00420: chConfirm = IIf(x(7), 1, 0) 00421: chTaskReplay = IIf(x(8), 1, 0) 00422: Call ProfileCheck 00423: End Sub 00424: VERSION 5.00 00425: Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx" 00426: Begin VB.UserControl SY_MGFile 00427: ClientHeight = 585 00428: ClientLeft = 0 00429: ClientTop = 0 00430: ClientWidth = 3285 00431: ScaleHeight = 585 00432: ScaleWidth = 3285 00433: Begin VB.TextBox Focus 00434: BackColor = &H8000000B& 00435: BorderStyle = 0 'None 00436: Height = 285 00437: Left = 1680 00438: TabIndex = 3 00439: Top = 360 00440: Width = 135 00441: End 00442: Begin MSComDlg.CommonDialog CommonDialog1 00443: Left = 2640 00444: Top = 0 00445: _ExtentX = 847 00446: _ExtentY = 847 00447: _Version = 393216 00448: End 00449: Begin VB.CommandButton Command1 00450: Caption = "Открыть" 00451: Height = 255 00452: Left = 1680 00453: TabIndex = 1 00454: Top = 60 00455: Width = 855 00456: End 00457: Begin VB.CheckBox CheckBox 00458: Caption = "Прикрепить файл" 00459: ForeColor = &H00800000& 00460: Height = 375 00461: Left = 0 00462: TabIndex = 0 00463: Top = 0 00464: Width = 1695 00465: End 00466: Begin VB.Label LenFile 00467: ForeColor = &H00800000& 00468: Height = 255 00469: Left = 240 00470: TabIndex = 2 00471: Top = 350 00472: Width = 1455 00473: End 00474: Begin VB.Image Image1 00475: BorderStyle = 1 'Fixed Single 00476: Height = 555 00477: Left = 2580 00478: Top = 0 00479: Width = 675 00480: End 00481: End 00482: Attribute VB_Name = "SY_MGFile" 00483: Attribute VB_GlobalNameSpace = False 00484: Attribute VB_Creatable = True 00485: Attribute VB_PredeclaredId = False 00486: Attribute VB_Exposed = False 00487: Option Explicit 00488: Dim FileName1 As String, FileContent1 As String 00489: Public Sub GetFileName(ByRef FileName As String, ByRef FileContent As String) 00490: FileName = FileName1 00491: FileContent = FileContent1 00492: End Sub 00493: Private Sub Command1_Click() 00494: CheckBox.Value = 1 00495: End Sub 00496: Private Sub CheckBox_Click() 00497: If CheckBox.Value = 0 Then 00498: FileName1 = "" 00499: FileContent1 = "" 00500: LenFile = Format(0, "###,###,##0") & " байт" 00501: Else 00502: Focus.SetFocus 00503: Call ReadFile 00504: Command1.SetFocus 00505: End If 00506: End Sub 00507: Private Sub ReadFile() 00508: CommonDialog1.Filter = "*.*" 00509: CommonDialog1.InitDir = "%USERPROFILE%\Рабочий стол" 00510: CommonDialog1.ShowOpen 00511: If CommonDialog1.FileName = "" Then Exit Sub 00512: FileName1 = CommonDialog1.FileName 00513: Image1.Stretch = True 'по хорошему тут надо грузить не в Image, а в браузер 00514: On Error Resume Next 00515: Image1.Picture = LoadPicture(FileName1) 00516: On Error GoTo 0 00517: ' 00518: Dim X As Integer, Str1 As String 00519: X = FreeFile 00520: On Error GoTo NotOpen 00521: Open FileName1 For Binary Access Read Shared As #X 00522: On Error GoTo NotRead 00523: LB_Monitor.MessageOn "Загрузка...", 1, 0 00524: DoEvents 00525: FileContent1 = Input(100000000, #X) 00526: LenFile = Format(Loc(X), "###,###,##0") & " байт" 00527: LB_Monitor.MessageOff 00528: On Error GoTo 0 00529: Close #X 00530: Exit Sub 00531: ' 00532: NotOpen: 00533: MsgBox ("Файл " & FileName1 & " не открывается.") 00534: Exit Sub 00535: ' 00536: NotRead: 00537: MsgBox ("Ошибка чтения файла " & FileName1) 00538: LenFile = Format(Loc(X), "###,###,##0") & " байт" 00539: Close #X 00540: End Sub
Comments (
)
)
Link to this page:
//www.vb-net.com/wanted/message/Ctl.htm
|
|