1
module ParasitemiaUI.GUI
7 open System.Windows.Media
8 open System.Windows.Controls
9 open Microsoft.Win32 // For the common dialogs.
13 open ParasitemiaUIControls
14 open ParasitemiaCore.Config
15 open ParasitemiaCore.Utils
18 let run (defaultConfig
: Config) (fileToOpen
: string option) =
19 let app = new Application ()
20 let win = MainWindow ()
21 win.Title <- Constants.APPLICATION_NAME
23 let state = State.State defaultConfig
24 let mutable currentScale = 1.
25 let mutable displayHealthy = false
26 let warningBelowNumberOfRBC = 1000
29 let canvasCurrentImageColor = win.canvasCurrentImage
.Background
30 win.menuHightlightRBC
.IsChecked <- displayHealthy
33 let extractRBCPreview (img
: Emgu.CV.Image<Emgu.CV.Structure.Bgr, byte
>) (rbc
: RBC) : Emgu.CV.Image<Emgu.CV.Structure.Bgr, byte
> =
34 let rbcWidth = rbc
.size
.Width
35 let rbcHeight = rbc
.size
.Height
36 let x = rbc
.center
.X - rbcWidth / 2. |> roundInt
37 let y = rbc
.center
.Y - rbcHeight / 2. |> roundInt
38 let w = roundInt
rbcWidth
39 let h = roundInt
rbcHeight
41 System.Drawing.Rectangle (
42 System.Drawing.Point ((if x < 0 then 0 else x), (if y < 0 then 0 else y)),
43 System.Drawing.Size ((if x + w >= img
.Width then img
.Width - x else w), (if y + h >= img
.Height then img
.Height - y else h))
47 let setRBCFrameStyle (srcImg
: SourceImage) (rbc
: RBC) (frame
: RBCFrame) =
48 frame
.Opacity <- if displayHealthy || rbc.setManually
|| rbc.infected
then 1. else 0.
49 let color = if rbc.infected
then srcImg
.InfectedRBCColor else srcImg.HealthyRBCColor
50 frame
.manuallyAdded
.Visibility <- if rbc.setManually
then Visibility.Visible else Visibility.Hidden
51 frame
.manuallyAdded
.Fill <- color
52 frame
.border
.Stroke <- color
54 let frameStrokeThickness () =
55 state.CurrentImage |> Option.map
(fun img
-> max
1. (img
.AverageRBCSize / 100.)) |> Option.defaultValue
1.
57 let frameFontSize () =
58 state.CurrentImage |> Option.map
(fun img
-> max
1. (img
.AverageRBCSize / 6.)) |> Option.defaultValue
1.
60 let createRBCFrameFromExisting (srcImg : SourceImage) (rbc : RBC) (frame
: RBCFrame) (frameThickness
: float) (fontSize
: float) (isTextBelow
: bool) : RBCFrame =
61 frame
.Visibility <- Visibility.Visible
62 frame
.Width <- rbc.size
.Width
63 frame
.Height <- rbc.size
.Height
65 frame
.IsTextBelow <- isTextBelow
66 setRBCFrameStyle srcImg rbc frame
67 frame
.border
.StrokeThickness <- frameThickness
68 frame
.txtRBCNumber
.Text <- string rbc.num
69 frame
.txtRBCNumber
.FontSize <- fontSize
72 let updateDocumentStatus () =
73 win.txtDocumentStatus
.Text <- if state.FilePath = "" then "<New document>" else state.FilePath
75 let statusMessageTimer = Threading.DispatcherTimer ()
76 statusMessageTimer.Tick.AddHandler (fun obj args
-> statusMessageTimer.Stop (); win.txtMessageStatus
.Text <- "")
77 statusMessageTimer.Interval <- TimeSpan (0, 0, 2)
79 // To show a use message while a short period of time.
80 let displayStatusMessage (message : string) =
81 win.txtMessageStatus
.Text <- message
82 statusMessageTimer.Stop ()
83 statusMessageTimer.Start ()
85 let highlightRBC (rbc : RBC) (highlight
: bool) =
86 let highlightRBCFrame (rbcFrame
: RBCFrame) (strokeThickness
: float) =
88 rbcFrame
.border
.StrokeThickness <- 2. * strokeThickness
89 if not
rbc.infected
&& not
rbc.setManually
&& not
displayHealthy then rbcFrame
.Opacity <- 1.
91 rbcFrame
.border
.StrokeThickness <- strokeThickness
92 if not
rbc.infected
&& not
rbc.setManually
&& not
displayHealthy then rbcFrame
.Opacity <- 0.
94 for rbcFrame
in win.stackRBC
.Children |> Seq.cast
<RBCFrame> do
95 if (rbcFrame
.Tag :?> RBC) = rbc then
96 highlightRBCFrame rbcFrame 1.
98 let strokeThicknessCanvas = frameStrokeThickness ()
100 for rbcFrame in win.canvasCurrentImage
.Children |> Seq.cast
<RBCFrame> do
101 if (rbcFrame.Tag :?> RBC) = rbc then
102 highlightRBCFrame rbcFrame strokeThicknessCanvas
104 let zoomToRBC (rbc : RBC) =
105 win.scrollViewCurrentImage
.ScrollToHorizontalOffset (rbc.center
.X * currentScale - win.scrollViewCurrentImage
.ViewportWidth / 2. + win.borderCurrentImage
.BorderThickness.Left)
106 win.scrollViewCurrentImage
.ScrollToVerticalOffset (rbc.center
.Y * currentScale - win.scrollViewCurrentImage
.ViewportHeight / 2. + win.borderCurrentImage
.BorderThickness.Top)
108 let txtImageName_TextChanged =
109 TextChangedEventHandler (fun obj args
-> state.CurrentImage |> Option.iter
(fun srcImg -> state.SetName srcImg win.txtImageName
.Text))
111 let updateCurrentImageInformation () =
112 win.txtImageName
.TextChanged.RemoveHandler (txtImageName_TextChanged)
113 win.txtImageInformation1
.Inlines.Clear ()
114 win.txtImageInformation2
.Inlines.Clear ()
115 win.txtImageName
.Text <- ""
117 match state.CurrentImage with
119 win.gridImageInformation
.Visibility <- Visibility.Visible
120 win.txtImageName
.Text <- srcImg.Name
121 win.txtImageName
.TextChanged.AddHandler txtImageName_TextChanged
124 let parasitemiaStr = Utils.percentText
srcImg.ImageParasitemia
125 win.txtImageInformation1
.Inlines.Add (Documents.Run ("Parasitemia: ", FontWeight = FontWeights.Bold))
126 win.txtImageInformation1
.Inlines.Add parasitemiaStr
127 win.txtImageInformation1
.Inlines.Add (Documents.LineBreak ())
129 win.txtImageInformation1
.Inlines.Add (Documents.Run ("Last analysis: ", FontWeight = FontWeights.Bold))
130 win.txtImageInformation1
.Inlines.Add (Documents.Run (if srcImg.DateLastAnalysis.Ticks = 0L then "<Never>" else string (srcImg.DateLastAnalysis.ToLocalTime())))
132 // The right part part.
133 win.txtImageInformation2
.Inlines.Add (Documents.Run ("Added infected erythrocyte: ", FontWeight = FontWeights.Bold))
134 win.txtImageInformation2
.Inlines.Add (Documents.Run ((srcImg.ImageNbManuallyChangedRBCStr true) + " " + (srcImg.ImageManuallyChangedRBCStr true)))
135 win.txtImageInformation2
.Inlines.Add (Documents.LineBreak ())
136 win.txtImageInformation2
.Inlines.Add (Documents.Run ("Removed infected erythrocyte: ", FontWeight = FontWeights.Bold))
137 win.txtImageInformation2
.Inlines.Add (Documents.Run ((srcImg.ImageNbManuallyChangedRBCStr false) + " " + (srcImg.ImageManuallyChangedRBCStr false)))
140 win.gridImageInformation
.Visibility <- Visibility.Hidden
142 let updateGlobalParasitemia () =
143 win.txtGlobalParasitemia
.Inlines.Clear ()
144 let total, infected
= state.GlobalParasitemia
145 win.txtGlobalParasitemia
.Inlines.Add (Documents.Run (Utils.percentText
(total, infected
), FontWeight = FontWeights.Bold))
146 if total > 0 && total < warningBelowNumberOfRBC then
147 win.txtGlobalParasitemia
.Inlines.Add (
149 sprintf
" Warning: the number of erythrocytes should be above %d" warningBelowNumberOfRBC,
150 FontWeight = FontWeights.Bold,
151 Foreground = Brushes.Red
155 let updateViewportPreview () =
156 for preview
in win.stackPreviews
.Children |> Seq.cast
<ImageSourcePreview> do
157 let srcImg = preview
.Tag :?> SourceImage
158 if Some srcImg = state.CurrentImage then
159 preview
.viewport
.Visibility <- Visibility.Visible
161 let canvasWidth = win.canvasCurrentImage
.ActualWidth * currentScale
162 let canvasHeight = win.canvasCurrentImage
.ActualHeight * currentScale
163 let previewWidth = (preview
.ActualWidth - preview
.BorderThickness.Left - preview
.BorderThickness.Right)
164 let previewHeight = (preview
.ActualHeight - preview
.BorderThickness.Top - preview
.BorderThickness.Bottom)
166 let marginLeft = previewWidth * (win.scrollViewCurrentImage
.HorizontalOffset - win.borderCurrentImage
.BorderThickness.Left) / canvasWidth - 2.
167 let marginRight = previewWidth * (canvasWidth - (win.scrollViewCurrentImage
.HorizontalOffset - win.borderCurrentImage
.BorderThickness.Right) - win.scrollViewCurrentImage
.ViewportWidth) / canvasWidth - 2.
168 let marginTop = previewHeight * (win.scrollViewCurrentImage
.VerticalOffset - win.borderCurrentImage
.BorderThickness.Top) / canvasHeight - 2.
169 let marginBottom = previewHeight * (canvasHeight - (win.scrollViewCurrentImage
.VerticalOffset - win.borderCurrentImage
.BorderThickness.Bottom) - win.scrollViewCurrentImage
.ViewportHeight) / canvasHeight - 2.
171 preview
.viewport
.Margin <-
179 preview
.viewport
.Visibility <- Visibility.Hidden
181 let rec setAsInfected
(srcImg : SourceImage) (rbc : RBC) (infected
: bool) =
182 state.SetAsInfected rbc infected
183 win.canvasCurrentImage
.Children
184 |> Seq.cast
<RBCFrame>
187 if (frame
.Tag :?> RBC) = rbc then
188 setRBCFrameStyle srcImg rbc frame
190 updateRBCFramesPreview
()
191 updateCurrentImageInformation ()
192 updateGlobalParasitemia ()
194 and createRBCFrame
(srcImg : SourceImage) (rbc : RBC) (frameThickness
: float) (fontSize
: float) (isTextBelow
: bool) : RBCFrame =
195 let frame = createRBCFrameFromExisting srcImg rbc (RBCFrame ()) frameThickness
fontSize isTextBelow
196 frame.SetValue (Panel.ZIndexProperty, Int32.MaxValue - rbc.num
) // To be sure the
197 frame.menuRBCSetAsHealthy
.Click.AddHandler (fun obj args
-> setAsInfected
srcImg (frame.Tag :?> RBC) false)
198 frame.menuRBCSetAsInfected
.Click.AddHandler (fun obj args
-> setAsInfected
srcImg (frame.Tag :?> RBC) true)
199 frame.ContextMenuOpening.AddHandler (
201 if (frame.Tag :?> RBC).infected
then
202 frame.menuRBCSetAsHealthy
.Visibility <- Visibility.Visible
203 frame.menuRBCSetAsInfected
.Visibility <- Visibility.Collapsed
205 frame.menuRBCSetAsHealthy
.Visibility <- Visibility.Collapsed
206 frame.menuRBCSetAsInfected
.Visibility <- Visibility.Visible
208 frame.ContextMenuClosing.AddHandler (fun obj args
-> if not
frame.IsMouseOver then highlightRBC (frame.Tag :?> RBC) false )
209 frame.MouseEnter.AddHandler (fun obj args
-> highlightRBC (frame.Tag :?> RBC) true)
210 frame.MouseLeave.AddHandler (fun obj args
-> if not
frame.grid
.ContextMenu.IsOpen then highlightRBC (frame.Tag :?> RBC) false)
213 and updateRBCFramesPreview
() =
214 match state.CurrentImage with
216 let mutable currentPreview = 0
217 for rbc in srcImg.RBCs |> List.filter
(fun rbc -> displayHealthy || rbc.infected
) do
218 let previewInfected =
219 if currentPreview < win.stackRBC
.Children.Count then
220 createRBCFrameFromExisting srcImg rbc (win.stackRBC
.Children.[currentPreview] :?> RBCFrame) 1. 12. false
222 let f = createRBCFrame
srcImg rbc 1. 12. false
223 f.MouseLeftButtonUp.AddHandler (fun obj args
-> zoomToRBC (f.Tag :?> RBC))
224 win.stackRBC
.Children.Add f |> ignore
227 currentPreview <- currentPreview + 1
229 previewInfected.Height <- win.stackRBC
.ActualHeight
230 previewInfected.Width <- win.stackRBC
.ActualHeight * rbc.size
.Width / rbc.size
.Height
231 previewInfected.border
.Fill <- ImageBrush (BitmapSourceConvert.ToBitmapSource (extractRBCPreview srcImg.Img rbc))
233 win.stackRBC
.Children.RemoveRange (currentPreview, win.stackRBC
.Children.Count - currentPreview)
236 updateViewportPreview ()
238 let updateRBCFramesCurrent () =
239 match state.CurrentImage with
241 let mutable currentCanvas = 0
242 let strokeThickness = frameStrokeThickness ()
243 let fontSize = frameFontSize ()
244 for rbc in srcImg.RBCs do
246 if currentCanvas < win.canvasCurrentImage
.Children.Count then
247 createRBCFrameFromExisting srcImg rbc (win.canvasCurrentImage
.Children.[currentCanvas] :?> RBCFrame) strokeThickness fontSize true
249 let f = createRBCFrame
srcImg rbc strokeThickness fontSize true
250 win.canvasCurrentImage
.Children.Add f |> ignore
253 currentCanvas <- currentCanvas + 1
255 Canvas.SetLeft (frame, rbc.center
.X - rbc.size
.Width / 2.)
256 Canvas.SetTop (frame, rbc.center
.Y - rbc.size
.Height / 2.)
258 for i
in currentCanvas .. win.canvasCurrentImage
.Children.Count - 1 do
259 win.canvasCurrentImage
.Children.[i
].Visibility <- Visibility.Hidden
262 let askDocumentPathToSave () : string option =
263 let dialog = SaveFileDialog (AddExtension = true, DefaultExt = PiaZ.extension
, Filter = PiaZ.filter
)
265 if state.FilePath <> "" then
266 dialog.FileName <- FileInfo(state.FilePath).Name
267 elif
state.PatientID <> "" then
268 dialog.FileName <- state.PatientID + PiaZ.extension
270 let res = dialog.ShowDialog ()
271 if res.HasValue && res.Value then
276 let saveCurrentDocument () =
278 if state.FilePath = "" then
279 match askDocumentPathToSave () with
281 state.FilePath <- filepath
286 updateDocumentStatus ()
287 displayStatusMessage "Document saved"
289 | :? IOException as ex ->
291 MessageBox.Show (sprintf
"The document cannot be save in \"%s\"" state.FilePath, "Error saving the document", MessageBoxButton.OK, MessageBoxImage.Error) |> ignore
293 let saveCurrentDocumentAsNewFile () =
294 match askDocumentPathToSave () with
296 state.FilePath <- filepath
297 saveCurrentDocument ()
300 // Ask the use to save the current document if neccessary.
301 let askSaveCurrent () =
302 if state.AlteredSinceLastSave then
303 match MessageBox.Show ("Would you like to save the current document?", "Saving the current document", MessageBoxButton.YesNo, MessageBoxImage.Question) with
304 | MessageBoxResult.Yes -> saveCurrentDocument ()
307 let updateCurrentImage () =
308 match state.CurrentImage with
310 win.imgLogos
.Visibility <- Visibility.Collapsed
312 // Highlight the preview.
313 win.stackPreviews
.Children
314 |> Seq.cast
<ImageSourcePreview>
315 |> Seq.iter
(fun preview
-> preview
.border
.BorderThickness <- Thickness (if preview
.Tag = (srcImg :> Object) then 3. else 0.))
317 win.canvasCurrentImage
.Height <- float srcImg.Img.Height
318 win.canvasCurrentImage
.Width <- float srcImg.Img.Width
319 win.canvasCurrentImage
.Background <- ImageBrush (BitmapSourceConvert.ToBitmapSource (srcImg.Img))
321 updateRBCFramesCurrent ()
322 updateRBCFramesPreview
()
325 win.imgLogos
.Visibility <- Visibility.Visible
327 win.stackRBC
.Children.Clear ()
328 win.canvasCurrentImage
.Children.Clear ()
329 win.canvasCurrentImage
.Background <- canvasCurrentImageColor
331 updateCurrentImageInformation ()
333 let setCurrentImage (srcImg : SourceImage) =
334 if state.CurrentImage.IsNone || state.CurrentImage.Value <> srcImg then
335 state.CurrentImage <- Some srcImg
336 updateCurrentImage ()
338 let addPreview (srcImg : SourceImage) =
339 let imgCtrl = ImageSourcePreview (Margin = Thickness 3.)
341 imgCtrl.menuRemoveImage
.Click.AddHandler (
343 win.stackPreviews
.Children.Remove (imgCtrl)
344 let srcImg = imgCtrl.Tag :?> SourceImage
345 let currentRemoved = Some srcImg = state.CurrentImage
346 state.RemoveSourceImage srcImg
347 if currentRemoved then
348 updateCurrentImage ()
350 updateGlobalParasitemia ()
352 // Update image numbers.
353 win.stackPreviews
.Children |> Seq.cast
<ImageSourcePreview> |> Seq.iter
(fun imgPreview
-> imgPreview
.txtImageNumber
.Text <- (imgPreview
.Tag :?> SourceImage).RomanNum)
356 imgCtrl.Tag <- srcImg
357 imgCtrl.txtImageNumber
.Text <- string srcImg.RomanNum
359 let height = srcImg.Img.Height * width / srcImg.Img.Width
360 imgCtrl.imagePreview
.Source <- BitmapSourceConvert.ToBitmapSource (srcImg.Img.Resize (width, height, Emgu.CV.CvEnum.Inter.Cubic))
361 win.stackPreviews
.Children.Add imgCtrl |> ignore
363 // Zoom to a mouse position into the control 'imgCtrl'.
364 let zoomTo (mousePos
: Point) =
365 let canvasW = win.canvasCurrentImage
.ActualWidth * currentScale
366 let canvasH = win.canvasCurrentImage
.ActualHeight * currentScale
367 let centerX = (mousePos
.X - imgCtrl.BorderThickness.Left) / (imgCtrl.ActualWidth - imgCtrl.BorderThickness.Left) * canvasW
368 let centerY = (mousePos
.Y - imgCtrl.BorderThickness.Top) / (imgCtrl.ActualHeight - imgCtrl.BorderThickness.Top) * canvasH
369 win.scrollViewCurrentImage
.ScrollToHorizontalOffset (centerX - win.scrollViewCurrentImage
.ViewportWidth / 2. + win.borderCurrentImage
.BorderThickness.Left)
370 win.scrollViewCurrentImage
.ScrollToVerticalOffset (centerY - win.scrollViewCurrentImage
.ViewportHeight / 2. + win.borderCurrentImage
.BorderThickness.Top)
372 imgCtrl.MouseLeftButtonDown.AddHandler (
374 setCurrentImage (state.SourceImages |> Seq.find
(fun srcImg -> (srcImg :> Object) = imgCtrl.Tag))
375 imgCtrl.UpdateLayout ()
376 zoomTo (args
.GetPosition (imgCtrl))
377 imgCtrl.CaptureMouse () |> ignore
380 imgCtrl.MouseMove.AddHandler (
382 if imgCtrl.IsMouseCaptured then
383 zoomTo (args
.GetPosition imgCtrl)
386 imgCtrl.MouseLeftButtonUp.AddHandler (
388 if imgCtrl.IsMouseCaptured then
389 imgCtrl.ReleaseMouseCapture ()
392 let updatePreviews () =
393 win.stackPreviews
.Children.Clear ()
394 for srcImg in state.SourceImages do
396 updateCurrentImage ()
399 win.txtPatient
.Text <- state.PatientID
401 updateGlobalParasitemia ()
402 updateDocumentStatus ()
404 let loadFile (filepath
: string) =
405 let displayLoadingErrorMessage (message : string) =
406 MessageBox.Show (sprintf
"The document cannot be loaded from \"%s\": %s" filepath
message, "Error loading the document", MessageBoxButton.OK, MessageBoxImage.Error) |> ignore
409 let previousFilePath = state.FilePath
411 state.FilePath <- filepath
415 | PiaZ.VersionFileNewerException fileVersion
->
416 state.FilePath <- previousFilePath
417 displayLoadingErrorMessage $
"File version ({fileVersion}) is newer than supported one ({PiaZ.CURRENT_FILE_VERSION}), you may update Parasitemia to the latest version"
419 | :? IOException as ex ->
421 state.FilePath <- previousFilePath
422 displayLoadingErrorMessage "IO Error"
425 let dialog = OpenFileDialog (Filter = PiaZ.filter
)
426 let res = dialog.ShowDialog ()
427 if res.HasValue && res.Value then
428 loadFile dialog.FileName
435 let exportResults () =
436 let extension = ".txt"
437 let dialog = SaveFileDialog (AddExtension = true, DefaultExt = extension)
439 if state.FilePath <> "" then
440 dialog.FileName <- Path.GetFileNameWithoutExtension state.FilePath + extension
441 elif
state.PatientID <> "" then
442 dialog.FileName <- state.PatientID + extension
444 let res = dialog.ShowDialog ()
445 if res.HasValue && res.Value then
447 Export.exportResults state dialog.FileName
449 | :? IOException as ex ->
451 MessageBox.Show (sprintf
"The results cannot be exported in \"%s\"" state.FilePath, "Error exporting the files", MessageBoxButton.OK, MessageBoxImage.Error) |> ignore
454 let dialog = OpenFileDialog (Filter = "Image Files|*.png;*.jpg;.jpeg;.bmp;*.tif;*.tiff", Multiselect = true)
455 let res = dialog.ShowDialog ()
456 if res.HasValue && res.Value then
457 let noSourceImage = state.SourceImages.Count () = 0
459 for filename
in dialog.FileNames do
461 let srcImg = state.AddSourceImage filename defaultConfig
466 MessageBox.Show (sprintf
"Unable to read the image from \"%s\"" filename, "Error adding an image", MessageBoxButton.OK, MessageBoxImage.Error) |> ignore
468 updateGlobalParasitemia ()
470 if noSourceImage then
471 updateCurrentImage ()
473 let showAnalysisWindow () =
474 if Analysis.showWindow
win state then
475 updateGlobalParasitemia ()
476 updateCurrentImage ()
478 let setHighlightRBC (highlight
: bool) =
479 displayHealthy <- highlight
480 updateRBCFramesPreview
()
481 updateRBCFramesCurrent ()
483 win.txtPatient
.TextChanged.AddHandler (fun obj args
-> state.PatientID <- win.txtPatient
.Text)
485 win.menuExit
.Click.AddHandler (fun obj args
-> win.Close ())
486 win.menuSave
.Click.AddHandler (fun obj args
-> saveCurrentDocument ())
487 win.menuSaveAs
.Click.AddHandler (fun obj args
-> saveCurrentDocumentAsNewFile ())
488 win.menuOpen
.Click.AddHandler (fun obj args
-> askLoadFile ())
489 win.menuNew
.Click.AddHandler (fun obj args
-> newFile ())
490 win.menuExportResults
.Click.AddHandler (fun obj args
-> exportResults ())
492 win.menuAddSourceImage
.Click.AddHandler (fun obj args
-> importImage ())
494 win.menuAnalysis
.SubmenuOpened.AddHandler (fun obj args
-> win.menuStartAnalysis
.IsEnabled <- state.SourceImages.Count () > 0)
496 win.menuStartAnalysis
.Click.AddHandler (fun obj args
-> showAnalysisWindow ())
498 win.menuHightlightRBC
.Click.AddHandler (fun obj args
-> setHighlightRBC win.menuHightlightRBC
.IsChecked)
500 win.menuAbout
.Click.AddHandler (fun obj args
-> About.showWindow
win)
502 win.menuCommandLineArguments
.Click.AddHandler (fun obj args
-> CommandLineArguments.showWindow
win)
504 win.Closing.AddHandler (fun obj args
-> askSaveCurrent ())
506 // Zoom on the current image.
507 let adjustCurrentImageBorders (deltaX
: float) (deltaY
: float) =
508 win.borderCurrentImage
.BorderThickness <-
510 (win.scrollViewCurrentImage
.ViewportWidth + deltaX
) / 2.,
511 (win.scrollViewCurrentImage
.ViewportHeight + deltaY
) / 2.,
512 (win.scrollViewCurrentImage
.ViewportWidth + deltaX
) / 2.,
513 (win.scrollViewCurrentImage
.ViewportHeight + deltaY
) / 2.
516 win.canvasCurrentImage
.SizeChanged.AddHandler (
518 let deltaX = args
.NewSize.Width - args
.PreviousSize.Width
519 let deltaY = args
.NewSize.Height - args
.PreviousSize.Height
520 if deltaX > 0.5 || deltaY > 0.5 then
521 adjustCurrentImageBorders 0.0
0.0
522 // Center the view at the center of the image initialy.
523 win.scrollViewCurrentImage
.UpdateLayout ()
524 win.scrollViewCurrentImage
.ScrollToHorizontalOffset (win.borderCurrentImage
.ActualWidth / 2. - win.scrollViewCurrentImage
.ViewportWidth / 2.)
525 win.scrollViewCurrentImage
.ScrollToVerticalOffset (win.borderCurrentImage
.ActualHeight / 2. - win.scrollViewCurrentImage
.ViewportHeight / 2.)
528 win.scrollViewCurrentImage
.SizeChanged.AddHandler (
530 let deltaX = args
.NewSize.Width - args
.PreviousSize.Width
531 let deltaY = args
.NewSize.Height - args
.PreviousSize.Height
532 adjustCurrentImageBorders deltaX deltaY
533 win.scrollViewCurrentImage
.ScrollToHorizontalOffset (win.scrollViewCurrentImage
.HorizontalOffset + deltaX / 8.)
534 win.scrollViewCurrentImage
.ScrollToVerticalOffset (win.scrollViewCurrentImage
.VerticalOffset + deltaY / 8.)
537 let mutable maxScale = 4.
538 let mutable minScale = 0.25
539 let currentImageScaleTransform = ScaleTransform ()
540 win.canvasCurrentImage
.LayoutTransform <- currentImageScaleTransform
541 win.borderCurrentImage
.PreviewMouseWheel.AddHandler (
543 let scaleFactor = if args
.Delta > 0 then 2.0 else 0.5
544 if scaleFactor > 1. && currentScale < maxScale || scaleFactor < 1. && currentScale > minScale then
545 let previousScale = currentScale
547 let newScale = currentScale * scaleFactor
548 if newScale > maxScale then maxScale elif newScale < minScale then minScale else newScale
549 let realScaleFactor = currentScale / previousScale
551 let centerX = win.scrollViewCurrentImage
.HorizontalOffset + win.scrollViewCurrentImage
.ViewportWidth / 2. - win.borderCurrentImage
.BorderThickness.Left
552 let centerY = win.scrollViewCurrentImage
.VerticalOffset + win.scrollViewCurrentImage
.ViewportHeight / 2. - win.borderCurrentImage
.BorderThickness.Top
554 currentImageScaleTransform.ScaleX <- currentScale
555 currentImageScaleTransform.ScaleY <- currentScale
557 win.scrollViewCurrentImage
.ScrollToHorizontalOffset (centerX * realScaleFactor - win.scrollViewCurrentImage
.ViewportWidth / 2. + win.borderCurrentImage
.BorderThickness.Left)
558 win.scrollViewCurrentImage
.ScrollToVerticalOffset (centerY * realScaleFactor - win.scrollViewCurrentImage
.ViewportHeight / 2. + win.borderCurrentImage
.BorderThickness.Top)
563 // Pan on the current image.
564 let mutable scrollStartPosition = Point (0., 0.)
565 let mutable scrollStartOffsetX = 0.
566 let mutable scrollStartOffsetY = 0.
567 win.borderCurrentImage
.PreviewMouseLeftButtonDown.AddHandler (
569 scrollStartPosition <- args
.GetPosition win.scrollViewCurrentImage
570 scrollStartOffsetX <- win.scrollViewCurrentImage
.HorizontalOffset
571 scrollStartOffsetY <- win.scrollViewCurrentImage
.VerticalOffset
572 win.borderCurrentImage
.Cursor <- Input.Cursors.ScrollAll
573 win.borderCurrentImage
.CaptureMouse () |> ignore
577 win.borderCurrentImage
.PreviewMouseMove.AddHandler (
579 if win.borderCurrentImage
.IsMouseCaptured then
580 let position = args
.GetPosition win.scrollViewCurrentImage
581 let deltaX = scrollStartPosition.X - position.X
582 let deltaY = scrollStartPosition.Y - position.Y
583 win.scrollViewCurrentImage
.ScrollToHorizontalOffset (deltaX + scrollStartOffsetX)
584 win.scrollViewCurrentImage
.ScrollToVerticalOffset (deltaY + scrollStartOffsetY)
589 win.borderCurrentImage
.PreviewMouseLeftButtonUp.AddHandler (
591 if win.borderCurrentImage
.IsMouseCaptured then
592 win.borderCurrentImage
.Cursor <- Input.Cursors.Arrow
593 win.borderCurrentImage
.ReleaseMouseCapture ()
599 win.InputBindings.Add (
601 Utils.FunCommand ((fun obj
-> saveCurrentDocument ()), (fun obj
-> true)),
602 Input.KeyGesture (Input.Key.S, Input.ModifierKeys.Control)
607 win.InputBindings.Add (
609 Utils.FunCommand ((fun obj
-> saveCurrentDocumentAsNewFile ()), (fun obj
-> true)),
610 Input.KeyGesture (Input.Key.S, Input.ModifierKeys.Control ||| Input.ModifierKeys.Shift)
615 win.InputBindings.Add (
617 Utils.FunCommand ((fun obj
-> askLoadFile ()), (fun obj
-> true)),
618 Input.KeyGesture (Input.Key.O, Input.ModifierKeys.Control)
623 win.InputBindings.Add (
625 Utils.FunCommand ((fun obj
-> newFile ()), (fun obj
-> true)),
626 Input.KeyGesture (Input.Key.N, Input.ModifierKeys.Control)
631 win.InputBindings.Add (
633 Utils.FunCommand ((fun obj
-> exportResults ()), (fun obj
-> true)),
634 Input.KeyGesture (Input.Key.E, Input.ModifierKeys.Control)
639 win.InputBindings.Add (
641 Utils.FunCommand ((fun obj
-> importImage ()), (fun obj
-> true)),
642 Input.KeyGesture (Input.Key.A, Input.ModifierKeys.Control)
646 // Show analysis dialog.
647 win.InputBindings.Add (
649 Utils.FunCommand ((fun obj
-> showAnalysisWindow ()), (fun obj
-> state.SourceImages.Count () > 0)),
650 Input.KeyGesture (Input.Key.Y, Input.ModifierKeys.Control)
654 // Toggle RBC highlight.
655 win.InputBindings.Add (
660 win.menuHightlightRBC
.IsChecked <- not
win.menuHightlightRBC
.IsChecked
661 setHighlightRBC win.menuHightlightRBC
.IsChecked
665 Input.KeyGesture (Input.Key.H, Input.ModifierKeys.Control)
670 win.scrollViewCurrentImage
.ScrollChanged.AddHandler (fun obj args
-> updateViewportPreview ())
672 updateDocumentStatus ()
673 win.gridImageInformation
.Visibility <- Visibility.Hidden
677 match fileToOpen
with
678 | Some filepath
-> loadFile filepath