home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 3_2004-2005.ISO / Data / Zips / A_Zoom__Sc18062510162004.psc / Upload / frmPreview.frm < prev    next >
Text File  |  2004-10-15  |  11KB  |  368 lines
  1. VERSION 5.00
  2. Begin VB.Form frmPreview 
  3.    AutoRedraw      =   -1  'True
  4.    Caption         =   "Print Preview"
  5.    ClientHeight    =   8385
  6.    ClientLeft      =   165
  7.    ClientTop       =   450
  8.    ClientWidth     =   12690
  9.    Icon            =   "frmPreview.frx":0000
  10.    LinkTopic       =   "Form1"
  11.    ScaleHeight     =   8385
  12.    ScaleWidth      =   12690
  13.    Begin VB.PictureBox picControl 
  14.       BorderStyle     =   0  'None
  15.       Height          =   495
  16.       Left            =   0
  17.       ScaleHeight     =   495
  18.       ScaleWidth      =   7815
  19.       TabIndex        =   0
  20.       Top             =   0
  21.       Width           =   7815
  22.       Begin VB.ComboBox cboZoom 
  23.          BeginProperty Font 
  24.             Name            =   "Tahoma"
  25.             Size            =   8.25
  26.             Charset         =   0
  27.             Weight          =   400
  28.             Underline       =   0   'False
  29.             Italic          =   0   'False
  30.             Strikethrough   =   0   'False
  31.          EndProperty
  32.          Height          =   315
  33.          Left            =   600
  34.          TabIndex        =   1
  35.          Text            =   "cboZoom"
  36.          Top             =   60
  37.          Width           =   2175
  38.       End
  39.       Begin VB.CommandButton cmdClose 
  40.          Cancel          =   -1  'True
  41.          Caption         =   "&Close"
  42.          BeginProperty Font 
  43.             Name            =   "Tahoma"
  44.             Size            =   8.25
  45.             Charset         =   0
  46.             Weight          =   400
  47.             Underline       =   0   'False
  48.             Italic          =   0   'False
  49.             Strikethrough   =   0   'False
  50.          EndProperty
  51.          Height          =   315
  52.          Left            =   6840
  53.          TabIndex        =   2
  54.          Top             =   60
  55.          Width           =   855
  56.       End
  57.       Begin VB.Label lblView 
  58.          Caption         =   "Zoom:"
  59.          BeginProperty Font 
  60.             Name            =   "Tahoma"
  61.             Size            =   8.25
  62.             Charset         =   0
  63.             Weight          =   400
  64.             Underline       =   0   'False
  65.             Italic          =   0   'False
  66.             Strikethrough   =   0   'False
  67.          EndProperty
  68.          Height          =   255
  69.          Left            =   60
  70.          TabIndex        =   10
  71.          Top             =   90
  72.          Width           =   495
  73.       End
  74.    End
  75.    Begin VB.PictureBox picScroll 
  76.       Height          =   6735
  77.       Left            =   360
  78.       ScaleHeight     =   6675
  79.       ScaleWidth      =   9435
  80.       TabIndex        =   3
  81.       Top             =   600
  82.       Width           =   9495
  83.       Begin VB.VScrollBar vsPreview 
  84.          Height          =   1215
  85.          Left            =   120
  86.          TabIndex        =   9
  87.          TabStop         =   0   'False
  88.          Top             =   480
  89.          Width           =   255
  90.       End
  91.       Begin VB.HScrollBar hsPreview 
  92.          Height          =   255
  93.          Left            =   480
  94.          TabIndex        =   8
  95.          TabStop         =   0   'False
  96.          Top             =   120
  97.          Width           =   1725
  98.       End
  99.       Begin VB.PictureBox picShow 
  100.          AutoRedraw      =   -1  'True
  101.          BorderStyle     =   0  'None
  102.          Height          =   5415
  103.          Left            =   360
  104.          ScaleHeight     =   5415
  105.          ScaleWidth      =   7020
  106.          TabIndex        =   4
  107.          Top             =   360
  108.          Width           =   7020
  109.          Begin VB.PictureBox picNormal 
  110.             Appearance      =   0  'Flat
  111.             AutoRedraw      =   -1  'True
  112.             BackColor       =   &H80000005&
  113.             BorderStyle     =   0  'None
  114.             ForeColor       =   &H80000008&
  115.             Height          =   9495
  116.             Left            =   -6960
  117.             Picture         =   "frmPreview.frx":0ECA
  118.             ScaleHeight     =   9495
  119.             ScaleWidth      =   12615
  120.             TabIndex        =   5
  121.             Top             =   -5400
  122.             Visible         =   0   'False
  123.             Width           =   12615
  124.          End
  125.          Begin VB.PictureBox picHold 
  126.             BorderStyle     =   0  'None
  127.             Enabled         =   0   'False
  128.             Height          =   1815
  129.             Left            =   0
  130.             ScaleHeight     =   1815
  131.             ScaleWidth      =   2175
  132.             TabIndex        =   6
  133.             Top             =   0
  134.             Width           =   2175
  135.             Begin VB.PictureBox picDoc 
  136.                Appearance      =   0  'Flat
  137.                AutoRedraw      =   -1  'True
  138.                BackColor       =   &H80000005&
  139.                BorderStyle     =   0  'None
  140.                Enabled         =   0   'False
  141.                ForeColor       =   &H80000008&
  142.                Height          =   1215
  143.                Left            =   240
  144.                ScaleHeight     =   1215
  145.                ScaleWidth      =   1695
  146.                TabIndex        =   7
  147.                Top             =   240
  148.                Visible         =   0   'False
  149.                Width           =   1695
  150.             End
  151.          End
  152.       End
  153.       Begin VB.PictureBox Grabber 
  154.          BackColor       =   &H00FFFF00&
  155.          Height          =   255
  156.          Left            =   120
  157.          ScaleHeight     =   195
  158.          ScaleWidth      =   195
  159.          TabIndex        =   11
  160.          Top             =   120
  161.          Width           =   255
  162.       End
  163.    End
  164. End
  165. Attribute VB_Name = "frmPreview"
  166. Attribute VB_GlobalNameSpace = False
  167. Attribute VB_Creatable = False
  168. Attribute VB_PredeclaredId = True
  169. Attribute VB_Exposed = False
  170. Option Explicit
  171. Private bScrollCode As Boolean
  172. Private sZoom As Single
  173. Private lPage As Integer
  174. Private lPageMax As Integer
  175. Private bDisplayPage As Boolean
  176.  
  177. Private Sub cboZoom_Click()
  178.  
  179. Dim iEvents As Integer
  180.  
  181. If Not bScrollCode Then
  182.   If cboZoom.ListIndex >= 0 Then
  183.     iEvents = DoEvents
  184.     If cboZoom.ItemData(cboZoom.ListIndex) <> sZoom Then
  185.       sZoom = cboZoom.ItemData(cboZoom.ListIndex)
  186.       Zoom_Check
  187.     End If
  188.   End If
  189. End If
  190.  
  191. End Sub
  192.  
  193. Private Sub cboZoom_KeyPress(KeyAscii As Integer)
  194.  
  195. Dim sNewZoom As Single
  196.  
  197. If KeyAscii = 13 Then
  198. sNewZoom = Val(cboZoom.Text)
  199. If sNewZoom > 0 And sNewZoom <= 200 Then
  200. cboZoom.Text = sNewZoom & " %"
  201. If sNewZoom = sZoom Then
  202. Exit Sub
  203. End If
  204. sZoom = sNewZoom
  205. Zoom_Check
  206. Else
  207. If cboZoom.ListIndex >= 0 Then
  208. cboZoom.Text = cboZoom.List(cboZoom.ListIndex)
  209. Else
  210. cboZoom.Text = sZoom & " %"
  211. End If
  212. End If
  213. End If
  214. End Sub
  215.  
  216. Private Sub cmdClose_Click()
  217. Unload Me
  218. End Sub
  219.  
  220. Private Sub Form_Activate()
  221. Me.Refresh
  222. bDisplayPage = True
  223. Preview_Display 1
  224. End Sub
  225.  
  226. Private Sub Form_Load()
  227. sZoom = 100
  228. With cboZoom
  229.   .AddItem "100 %"
  230.   .ItemData(.ListCount - 1) = 100
  231.   .AddItem "75 %"
  232.   .ItemData(.ListCount - 1) = 75
  233.   .AddItem "50 %"
  234.   .ItemData(.ListCount - 1) = 50
  235.   .AddItem "25 %"
  236.   .ItemData(.ListCount - 1) = 25
  237.   .AddItem "Full Page"
  238.   .ItemData(.ListCount - 1) = 0
  239.   .AddItem "Full Width"
  240.   .ItemData(.ListCount - 1) = -1
  241.   bScrollCode = True
  242.   .ListIndex = 0
  243.   bScrollCode = False
  244. End With
  245. sZoom = 100
  246. picScroll.Move 0, picControl.Height, Me.ScaleWidth, Me.ScaleHeight - picControl.Height
  247. vsPreview.Move picScroll.ScaleWidth - vsPreview.Width, 0, vsPreview.Width, picScroll.ScaleHeight - hsPreview.Height
  248. hsPreview.Move 0, picScroll.ScaleHeight - hsPreview.Height, picScroll.ScaleWidth - vsPreview.Width
  249. picShow.Move 0, 0, picScroll.ScaleWidth, picScroll.ScaleHeight
  250. picDoc.Move -picDoc.Width, -picDoc.Height
  251. End Sub
  252.  
  253. Public Sub Preview_Display(ByVal iPage As Integer)
  254.  
  255. Dim iMin As Integer
  256. Dim iMax As Integer
  257. Screen.MousePointer = vbHourglass
  258. picNormal.Cls
  259. Zoom_Check
  260. Screen.MousePointer = vbDefault
  261. End Sub
  262. Private Sub Zoom_Check()
  263.  
  264. Dim sSizeX As Single
  265. Dim sSizeY As Single
  266. Dim sRatio As Single
  267. Dim spImage As StdPicture
  268. Dim sWidth As Single
  269. Dim sHeight As Single
  270. Dim bScroll As Byte
  271. Dim bOldScroll As Byte
  272. Screen.MousePointer = vbHourglass
  273.  
  274. sWidth = picScroll.ScaleWidth
  275. sHeight = picScroll.ScaleHeight
  276. Do
  277.   bOldScroll = bScroll
  278.   If sZoom = 0 Then
  279.     sRatio = (sHeight - 480) / picNormal.Height
  280.   ElseIf sZoom = -1 Then
  281.     sRatio = (sWidth - 480) / picNormal.Width
  282.   Else
  283.     sRatio = sZoom / 100
  284.   End If
  285.   sSizeX = picNormal.Width * sRatio
  286.   sSizeY = picNormal.Height * sRatio
  287.   If sSizeX > sWidth And (bScroll And 1) <> 1 Then
  288.     sHeight = sHeight - hsPreview.Height
  289.     bScroll = bScroll + 1
  290.   End If
  291.   If sSizeY > sHeight And (bScroll And 2) <> 2 Then
  292.     sWidth = sWidth - vsPreview.Width
  293.     bScroll = bScroll + 2
  294.   End If
  295. Loop While bOldScroll <> bScroll
  296.  
  297. vsPreview.Height = sHeight
  298. hsPreview.Width = sWidth
  299.  
  300. picShow.Move 0, 0, sWidth, sHeight
  301. picDoc.Move 240, 240, sSizeX, sSizeY
  302. picDoc.Cls
  303. picDoc.PaintPicture picNormal.Image, 0, 0, sSizeX, sSizeY
  304.  
  305.  
  306. ' Laat scroll bars zien als dat nodig is
  307. bScrollCode = True
  308. picHold.Move 0, 0, sSizeX + 480, sSizeY + 480
  309. If (bScroll And 2) = 2 Then
  310.   vsPreview.Visible = True
  311.   vsPreview.Max = (picHold.ScaleHeight - picShow.ScaleHeight) / 14.4 + 1
  312.   vsPreview.Min = 0
  313.   vsPreview.SmallChange = 14
  314.   vsPreview.LargeChange = picShow.ScaleHeight / 14.4
  315.   vsPreview.Value = vsPreview.Min
  316. Else
  317.   vsPreview.Visible = False
  318. End If
  319.  
  320. If (bScroll And 1) = 1 Then
  321.   hsPreview.Visible = True
  322.   hsPreview.Max = (picHold.ScaleWidth - picShow.ScaleWidth) / 14.4 + 1
  323.   hsPreview.Min = 0
  324.   hsPreview.SmallChange = 14
  325.   hsPreview.LargeChange = picShow.ScaleWidth / 14.4
  326.   hsPreview.Value = hsPreview.Min
  327. Else
  328.   hsPreview.Visible = False
  329. End If
  330. bScrollCode = False
  331. Screen.MousePointer = vbDefault
  332. If bDisplayPage Then
  333. picDoc.Visible = True
  334. End If
  335. End Sub
  336.  
  337. Private Sub Form_Resize()
  338. If Me.WindowState = vbMinimized Then
  339. Exit Sub
  340. End If
  341. If Me.ScaleHeight > 600 Then
  342. picScroll.Move 0, 500, Me.ScaleWidth, Me.ScaleHeight - 500
  343. End If
  344. End Sub
  345.  
  346. Private Sub hsPreview_Change()
  347.  
  348. If Not bScrollCode Then
  349.   picHold.Left = -hsPreview.Value * 14.4
  350. End If
  351. End Sub
  352.  
  353. Private Sub picScroll_Resize()
  354. vsPreview.Left = picScroll.ScaleWidth - vsPreview.Width
  355. vsPreview.Height = picScroll.ScaleHeight
  356. hsPreview.Top = picScroll.ScaleHeight - hsPreview.Height
  357. hsPreview.Width = picScroll.ScaleWidth
  358. Zoom_Check
  359. End Sub
  360.  
  361. Private Sub vsPreview_Change()
  362. If Not bScrollCode Then
  363.   picHold.Top = -vsPreview.Value * 14.4
  364. End If
  365. End Sub
  366.  
  367.  
  368.