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