home *** CD-ROM | disk | FTP | other *** search
/ CD Actual Thematic 25: Programming / pc_actual_25.iso / Delphi / PolarDraw / data1.cab / Samples / Visual_Basic / PicViewer / Form1.frm (.txt) next >
Encoding:
Visual Basic Form  |  2001-08-31  |  6.6 KB  |  193 lines
  1. VERSION 5.00
  2. Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX"
  3. Object = "{52DE3A21-0A3F-11D4-B9D2-008048FD54E6}#2.0#0"; "POLARDraw20.ocx"
  4. Begin VB.Form Form1 
  5.    AutoRedraw      =   -1  'True
  6.    BorderStyle     =   1  'Fixed Single
  7.    Caption         =   "Picture Viewer"
  8.    ClientHeight    =   4785
  9.    ClientLeft      =   45
  10.    ClientTop       =   330
  11.    ClientWidth     =   7575
  12.    LinkTopic       =   "Form1"
  13.    MaxButton       =   0   'False
  14.    MinButton       =   0   'False
  15.    ScaleHeight     =   4785
  16.    ScaleWidth      =   7575
  17.    StartUpPosition =   3  'Windows Default
  18.    Begin POLARDRAW20Lib.POLARDraw POLARDraw1 
  19.       Height          =   4260
  20.       Left            =   75
  21.       TabIndex        =   6
  22.       Top             =   75
  23.       Width           =   5340
  24.       _Version        =   131072
  25.       _ExtentX        =   9419
  26.       _ExtentY        =   7514
  27.       _StockProps     =   224
  28.       BorderStyle     =   1
  29.       Appearance      =   1
  30.       PaperShadowColor=   0
  31.       PaperOutlinecolor=   22910804
  32.       DrawPaper       =   0   'False
  33.       DrawPaperOutline=   -1  'True
  34.       DrawPaperShadow =   -1  'True
  35.       PaperShadowOffset=   0
  36.       ViewportOriginX =   22910804
  37.       ViewportOriginY =   22881044
  38.       PageOriginX     =   1
  39.       PageOriginY     =   103421157
  40.       HorizontalGrid  =   567
  41.       VerticalGrid    =   567
  42.       ShowVerticalRuler=   0   'False
  43.       ShowHorizontalRuler=   0   'False
  44.       SelectionCount  =   22740992
  45.       ShapeCount      =   22742704
  46.       CanvasWidth     =   536873485
  47.       CanvasHeight    =   0
  48.    End
  49.    Begin ComctlLib.Slider Slider1 
  50.       Height          =   225
  51.       Left            =   6480
  52.       TabIndex        =   4
  53.       Top             =   4425
  54.       Width           =   990
  55.       _ExtentX        =   1746
  56.       _ExtentY        =   397
  57.       _Version        =   327682
  58.       Min             =   10
  59.       Max             =   400
  60.       SelStart        =   50
  61.       TickFrequency   =   50
  62.       Value           =   50
  63.    End
  64.    Begin VB.FileListBox File1 
  65.       Height          =   2430
  66.       Left            =   5505
  67.       Pattern         =   "*.bmp;*.gif;*.jpg;*.wmf;*.emf"
  68.       TabIndex        =   2
  69.       Top             =   1920
  70.       Width           =   1965
  71.    End
  72.    Begin VB.DirListBox Dir1 
  73.       Height          =   1440
  74.       Left            =   5520
  75.       TabIndex        =   1
  76.       Top             =   450
  77.       Width           =   1965
  78.    End
  79.    Begin VB.DriveListBox Drive1 
  80.       Height          =   315
  81.       Left            =   5520
  82.       TabIndex        =   0
  83.       Top             =   105
  84.       Width           =   1965
  85.    End
  86.    Begin VB.Label lblZoom 
  87.       Caption         =   "Zoom:"
  88.       Height          =   255
  89.       Left            =   5505
  90.       TabIndex        =   5
  91.       Top             =   4425
  92.       Width           =   1035
  93.    End
  94.    Begin VB.Label Label1 
  95.       Caption         =   "Label1"
  96.       Height          =   255
  97.       Left            =   120
  98.       TabIndex        =   3
  99.       Top             =   4425
  100.       Width           =   5280
  101.    End
  102. Attribute VB_Name = "Form1"
  103. Attribute VB_GlobalNameSpace = False
  104. Attribute VB_Creatable = False
  105. Attribute VB_PredeclaredId = True
  106. Attribute VB_Exposed = False
  107. Dim Shape As POLARDRAW20Lib.Shape
  108. Dim lID As Long
  109. Private Sub Drive1_Change()
  110.     Dir1.Path = Drive1.Drive
  111. End Sub
  112. Private Sub File1_Click()
  113. 'Selection of picture in File1 FileListBox causes viewing that picture
  114. 'in POLARDraw window.
  115.    Dim string1 As String
  116.    Let string1 = Dir1.Path
  117.    If Len(string1) > 3 Then
  118.       Let string1 = string1 & "\"
  119.    End If
  120.    Label1.Caption = "Picture: " & string1 & File1.FileName
  121.    On Error GoTo res
  122.    Set Pic = LoadPicture(string1 & File1.FileName)
  123.    POLARDraw1.EnableRendering = False
  124.    'Positions of Shape borders are set to dimensions of selected picure.
  125.    'Top and Left borders of shape are fixed.
  126.    Shape.Right = Shape.Left + Pic.Width
  127.    Shape.Bottom = Shape.Top + Pic.Height
  128.    Shape.Select
  129.    'Active window is set to fit to selection. Zoom is also updated by FitTo method.
  130.    POLARDraw1.ActiveWindow.FitTo polFitToSelection
  131.     'Shape object will still exists after Clear method.
  132.    POLARDraw1.ActivePage.Selection.Clear
  133.    UpdateZoom
  134.    Shape.IsFilled = True
  135.    Shape.Fill.SetPictureFromObject Pic
  136.    POLARDraw1.EnableRendering = True
  137.    POLARDraw1.Render
  138.    Exit Sub
  139.    POLARDraw1.EnableRendering = True
  140.    Shape.IsFilled = False
  141. End Sub
  142. Private Sub File1_PathChange()
  143.     ' Shows path in Label1.
  144.     Label1.Caption = "Picture: " & Dir1.Path
  145. End Sub
  146. Private Sub Dir1_Change()
  147.     ' Sets file path.
  148.     File1.Path = Dir1.Path
  149. End Sub
  150. Private Sub Form_Load()
  151.     Label1.Caption = "Please select a picture"
  152.     POLARDraw1.EnableRendering = False
  153.     POLARDraw1.MeasurementUnits = polUnitsTwips
  154.     POLARDraw1.ActiveWindow.Environment.RulerMeasurementUnits = polUnitsPixel
  155.     'Object Shape is set to rectangular shape whose up left vertex has
  156.     'coordinates (0,0) and down right vertex has coordinates (100,100).
  157.     Set Shape = POLARDraw1.ActivePage.Shapes.Add(1, 0, 0, 100, 100)
  158.     Shape.HasLine = False
  159.     Shape.IsFilled = False
  160.     'That shape is selected.
  161.     Shape.Select
  162.     'Active window is set to fit to selection (in this case Shape's area).
  163.     'Zoom is also updated by FitTo method.
  164.      POLARDraw1.ActiveWindow.FitTo polFitToSelection
  165.     'Selection is cleared (Shape is removed from selection).Shape object will still exists after Clear method.
  166.     POLARDraw1.ActivePage.Selection.Clear
  167.     UpdateZoom
  168.     Slider1.Value = POLARDraw1.Zoom
  169.     POLARDraw1.EnableRendering = True
  170.     POLARDraw1.Render
  171. End Sub
  172. Private Sub Form_Unload(Cancel As Integer)
  173.    Set Shape = Nothing
  174. End Sub
  175. Private Sub Slider1_Scroll()
  176.     'Zoom is set to value specified by Slider.
  177.     POLARDraw1.ActiveWindow.Environment.Zoom = Slider1.Value
  178.     lblZoom.Caption = "Zoom: " & Slider1.Value & "%"
  179. End Sub
  180. Private Sub UpdateZoom()
  181.     'Zoom has to be between 10 and 400,
  182.     'because Slider min and max values are set to 10 and 400.
  183.     If POLARDraw1.ActiveWindow.Environment.Zoom < 10 Then
  184.         POLARDraw1.ActiveWindow.Environment.Zoom = 10
  185.     End If
  186.     If POLARDraw1.ActiveWindow.Environment.Zoom > 400 Then
  187.         POLARDraw1.ActiveWindow.Environment.Zoom = 400
  188.     End If
  189.     'Slider value is updated to be equal to right zoom for chosen picture.
  190.     Slider1.Value = POLARDraw1.ActiveWindow.Environment.Zoom
  191.     lblZoom.Caption = "Zoom: " & Slider1.Value & "%"
  192. End Sub
  193.