home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Toolbox / Visual Basic Toolbox (P.I.E.)(1996).ISO / arrays / arrseq / arrseq.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1995-09-29  |  9.1 KB  |  251 lines
  1. VERSION 2.00
  2. Begin Form frm_Main 
  3.    BackColor       =   &H80000004&
  4.    BorderStyle     =   0  'None
  5.    ClientHeight    =   2775
  6.    ClientLeft      =   2250
  7.    ClientTop       =   2250
  8.    ClientWidth     =   3900
  9.    ClipControls    =   0   'False
  10.    ControlBox      =   0   'False
  11.    Height          =   3180
  12.    Icon            =   ARRSEQ.FRX:0000
  13.    Left            =   2190
  14.    LinkTopic       =   "Form1"
  15.    MaxButton       =   0   'False
  16.    MinButton       =   0   'False
  17.    ScaleHeight     =   2775
  18.    ScaleWidth      =   3900
  19.    Top             =   1905
  20.    Width           =   4020
  21.    Begin Timer tim_message 
  22.       Enabled         =   0   'False
  23.       Interval        =   700
  24.       Left            =   1830
  25.       Top             =   0
  26.    End
  27.    Begin PictureBox pic_button 
  28.       AutoSize        =   -1  'True
  29.       BorderStyle     =   0  'None
  30.       ClipControls    =   0   'False
  31.       Height          =   750
  32.       Left            =   0
  33.       ScaleHeight     =   750
  34.       ScaleWidth      =   1275
  35.       TabIndex        =   2
  36.       Top             =   150
  37.       Width           =   1275
  38.       Begin Label lbl_Status 
  39.          Alignment       =   2  'Center
  40.          BackStyle       =   0  'Transparent
  41.          Caption         =   "lbl_Status"
  42.          FontBold        =   0   'False
  43.          FontItalic      =   0   'False
  44.          FontName        =   "MS Sans Serif"
  45.          FontSize        =   8.25
  46.          FontStrikethru  =   0   'False
  47.          FontUnderline   =   0   'False
  48.          Height          =   255
  49.          Left            =   30
  50.          TabIndex        =   5
  51.          Top             =   480
  52.          Width           =   1275
  53.       End
  54.    End
  55.    Begin PictureBox pic_controlbox 
  56.       AutoSize        =   -1  'True
  57.       BorderStyle     =   0  'None
  58.       Height          =   150
  59.       Left            =   0
  60.       Picture         =   ARRSEQ.FRX:0302
  61.       ScaleHeight     =   150
  62.       ScaleWidth      =   165
  63.       TabIndex        =   4
  64.       Top             =   0
  65.       Width           =   165
  66.    End
  67.    Begin PictureBox pic_caption 
  68.       BackColor       =   &H80000002&
  69.       BorderStyle     =   0  'None
  70.       ClipControls    =   0   'False
  71.       Height          =   150
  72.       Left            =   0
  73.       ScaleHeight     =   150
  74.       ScaleWidth      =   1275
  75.       TabIndex        =   3
  76.       Top             =   0
  77.       Width           =   1275
  78.    End
  79.    Begin PictureBox pic_down 
  80.       AutoSize        =   -1  'True
  81.       BorderStyle     =   0  'None
  82.       ClipControls    =   0   'False
  83.       Height          =   750
  84.       Left            =   2580
  85.       Picture         =   ARRSEQ.FRX:07B4
  86.       ScaleHeight     =   750
  87.       ScaleWidth      =   1275
  88.       TabIndex        =   1
  89.       Top             =   180
  90.       Width           =   1275
  91.    End
  92.    Begin PictureBox pic_up 
  93.       AutoSize        =   -1  'True
  94.       BorderStyle     =   0  'None
  95.       ClipControls    =   0   'False
  96.       Height          =   750
  97.       Left            =   1320
  98.       Picture         =   ARRSEQ.FRX:10C6
  99.       ScaleHeight     =   750
  100.       ScaleWidth      =   1275
  101.       TabIndex        =   0
  102.       Top             =   150
  103.       Width           =   1275
  104.    End
  105.    Begin Label lbl_credits 
  106.       BorderStyle     =   1  'Fixed Single
  107.       Caption         =   "This simple program will re-sequence the numbering of an array's code copied to the clipboard and then copy the re-numbered code back to the clipboard.  Limitations: must only copy one array to clipboard.  Freeware, written by Richard Eke          CompuServe 10031,233"
  108.       FontBold        =   0   'False
  109.       FontItalic      =   0   'False
  110.       FontName        =   "MS Sans Serif"
  111.       FontSize        =   8.25
  112.       FontStrikethru  =   0   'False
  113.       FontUnderline   =   0   'False
  114.       Height          =   1635
  115.       Left            =   60
  116.       TabIndex        =   6
  117.       Top             =   1020
  118.       Visible         =   0   'False
  119.       Width           =   3705
  120.    End
  121. Option Explicit
  122. Sub Form_Load ()
  123.     Dim MainTop As Integer, MainLeft As Integer
  124.     Me.Height = pic_button.Height + pic_controlbox.Height
  125.     Me.Width = pic_button.Width
  126.     '*** Get Window last pos from private INI
  127.     Dim INIFile$, SectionName$, KeyWord$
  128.     Dim Def$, tmp$, nSize As Integer, Length%
  129.     INIFile$ = "ARRSEQ.INI" + Chr$(0)
  130.     SectionName$ = "ViewPorts" + Chr$(0)
  131.     KeyWord$ = "Main_Left" + Chr$(0)
  132.     Def$ = "" + Chr$(0)
  133.     tmp$ = String$(255, 0)
  134.     nSize = 255
  135.     Length% = GetPrivateProfileString(SectionName$, KeyWord$, Def$, tmp$, nSize, INIFile$)
  136.     tmp$ = RTrim$(LTrim$(Mid$(tmp$, 1, Length%)))
  137.     MainLeft = Val(tmp$)
  138.     KeyWord$ = "Main_Top" + Chr$(0)
  139.     Def$ = "" + Chr$(0)
  140.     tmp$ = String$(255, 0)
  141.     nSize = 255
  142.     Length% = GetPrivateProfileString(SectionName$, KeyWord$, Def$, tmp$, nSize, INIFile$)
  143.     tmp$ = RTrim$(LTrim$(Mid$(tmp$, 1, Length%)))
  144.     MainTop = Val(tmp$)
  145.     '****
  146.     '*** Move window to last saved position
  147.     If MainTop < 0 Or MainTop > Screen.Height Or MainLeft < 0 Or MainLeft > Screen.Width Then
  148.         'just in case invalid values put just in from top left
  149.         MainTop = 240
  150.         MainLeft = 240
  151.     End If
  152.     Me.Move MainLeft, MainTop
  153.     pic_button.Picture = pic_up.Picture
  154.     lbl_Status = ""
  155. '***************************************************************
  156. '  In many of my programs I have fixed data stored in
  157. 'sequentialy numbered arrays.  This is normally in instances
  158. 'where I wouldn't use a file as I don't want the users
  159. 'changing the data - i.e. simulating BASIC's DATA statement
  160. 'The main instance that I use this method is in my setup
  161. 'program for the lists of files that need to be installed.
  162. 'Over the course of time, items are added and deleted and it
  163. 'is a real pain to re-number the subsequent array elements
  164. 'by hand.  Thus this very simple program.  This program
  165. 'has great scope for improvement but it works well within
  166. 'it's limitations.
  167. 'Use:
  168. '   Copy the code to the clipboard
  169. '   click on 'Array Sequencer'
  170. '   Paste the code back into the code window
  171. 'Limitations:-
  172. '   Only copy one array to the clipboard or it will go wrong
  173. '   Make sure that the first array element is numbered
  174. '       correctly - it uses this as the start index
  175. 'Freeware - I only hope it's usefull to someone <g>
  176. 'Richard Eke, CompuServe 100031,233 - 29th Sept 1995
  177. '*************************************************************
  178. End Sub
  179. Sub Form_Unload (Cancel As Integer)
  180.     '*** Save pos in INI
  181.     Dim INIFile$, SectionName$, KeyWord$
  182.     Dim Def$, tmp$, nSize As Integer, Length%, Done%
  183.     INIFile$ = "ARRSEQ.INI"
  184.     SectionName$ = "ViewPorts" + Chr$(0)
  185.     KeyWord$ = "Main_Left" + Chr$(0)
  186.     tmp$ = Format$(frm_Main.Left) + Chr$(0)
  187.     Done% = WritePrivateProfileString(SectionName$, KeyWord$, tmp$, INIFile$)
  188.     KeyWord$ = "Main_Top" + Chr$(0)
  189.     tmp$ = Format$(frm_Main.Top) + Chr$(0)
  190.     Done% = WritePrivateProfileString(SectionName$, KeyWord$, tmp$, INIFile$)
  191. End Sub
  192. Sub pic_button_Click ()
  193.     Dim OriginalText As String
  194.     Dim FinalText As String
  195.     Dim ThisIndex As Integer
  196.     Dim c As Integer
  197.     ThisIndex = -9999
  198.     ShowMsg "Processing..."
  199.     pic_button.MousePointer = 11'hourglass
  200.     If ClipBoard.GetFormat(1) Then '*** is there text on Clipboard
  201.         OriginalText = ClipBoard.GetText()
  202.         c = 0
  203.         Do
  204.             c = c + 1
  205.             If Mid$(OriginalText, c, 1) <> "(" Then
  206.                 FinalText = FinalText + Mid$(OriginalText, c, 1)
  207.             Else
  208.                 If ThisIndex = -9999 Then '*** Find first index
  209.                     ThisIndex = Val(Mid$(OriginalText, c + 1, InStr(c, OriginalText, ")")))
  210.                 End If
  211.                 FinalText = FinalText + "(" + Format$(ThisIndex) + ")"
  212.                 ThisIndex = ThisIndex + 1
  213.                 c = InStr(c, OriginalText, ")")
  214.             End If
  215.         Loop Until c >= Len(OriginalText)
  216.         ClipBoard.SetText FinalText
  217.         ShowMsg "Processed OK"
  218.     Else
  219.         MsgBox "No text on Clipbard", 16, "Error"
  220.         ShowMsg "No Data"
  221.     End If
  222.     pic_button.MousePointer = 0'default
  223. End Sub
  224. Sub pic_button_MouseDown (button As Integer, Shift As Integer, X As Single, Y As Single)
  225.     pic_button.Picture = pic_down.Picture
  226. End Sub
  227. Sub pic_button_MouseUp (button As Integer, Shift As Integer, X As Single, Y As Single)
  228.     pic_button.Picture = pic_up.Picture
  229. End Sub
  230. Sub pic_caption_MouseDown (button As Integer, Shift As Integer, X As Single, Y As Single)
  231.    Dim ret!
  232.    '*** Trigger the mouse-up event NOW
  233.    ret! = Sendmessage(pic_caption.hWnd, WM_LBUTTONUP, 0, 0)
  234.    '*** Tell Windows were's moving the window
  235.    ret! = Sendmessage(frm_Main.hWnd, WM_SYSCOMMAND, MOUSE_MOVE, 0)
  236. End Sub
  237. Sub pic_controlbox_DblClick ()
  238.     Unload Me
  239. End Sub
  240. Sub ShowMsg (MsgTxt As String)
  241.     '*** Leave message on screen for a short while to give
  242.     '*** users chance to read it
  243.     lbl_Status.Caption = MsgTxt
  244.     lbl_Status.Refresh
  245.     tim_Message.Enabled = True
  246. End Sub
  247. Sub tim_message_Timer ()
  248.     lbl_Status.Caption = ""
  249.     tim_Message.Enabled = False
  250. End Sub
  251.