romfast/roaregistratura
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
main
roaregistratura/Clase/outlook2003bar.vc2
Marius Mutu 6769eb61d1 Registratura: adaugare/editare fara erori la partener NULL, lista doar ultimul document, fonturi Arial 10 (M1-M5) 
M1 modifica_reg_dg: garda id_part NULL/empty (mesaj + Return .F.), NVL pe id_part/nr_pag, functia intoarce succes.
M2 validare partener in toate cele 3 puncte de salvare, INAINTE de blocarea campurilor (Command2.Click salveaza inainte sa blocheze; bara laterala si Page3.Deactivate nu mai salveaza/prompteaza cu partener NULL).
M3 do_adauga: documentul nou intra direct in editare (llock=.F., focus cmdDenumire); eliminat mesajul fals "Toate modificarile au efect imediat!".
M4 viz_registratura + do_cauta: filtru initial "doar ultimul document" (subquery max(id_reg)); fara criterii de cautare se pastreaza filtrul, nu se incarca toata baza.
M5 fonturi: eliminate 154 suprascrieri "Arial Narrow" si rebazate 96 controale baseclass pe COMUN _baza.vcx (textbox/label/checkbox/commandbutton/optiongroup); Init de grid propaga fontul la coloane si headere (fara asta raman Arial 9 - verificat empiric).

Teste: harness headless (init env dedicat, form, adaugare+editare cu verificare in baza) + test UI vizual cu screenshots pe fluxul real (19 PASS / 0 FAIL). Diff-uri de audit in docs/diff_runda1_*.patch.

M6 (build EXE) BLOCAT headless: roaRegistratura.pjx refera 48 fisiere hardcodate pe "c:\program files\...\vfp 9" (masina 32-bit din 2021) + COMUN\utile\hpdf\ReportOutput\ctl32_progressbar.vcx redenumit _old; necesita repathing o data in VFP9 IDE.

Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>
Claude-Session: https://claude.ai/code/session_018H9za5A9Tk6wcLFof6seds
2026-07-23 18:53:12 +03:00

1566 lines
46 KiB
Plaintext
Raw Permalink Blame History

*--------------------------------------------------------------------------------------------------------------------------------------------------------
* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!!
*--------------------------------------------------------------------------------------------------------------------------------------------------------
*< FOXBIN2PRG: Version="1.21" SourceFile="outlook2003bar.vcx" CPID="1252" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries)
*
*
DEFINE CLASS outlook2003bar AS container
*< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" />
*-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder
*< OBJECTDATA: ObjPath="Panes" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="OverflowPanel" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="SplitBar" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="SplitBar.imgSplitter" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="Panel" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="Splitter" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="Title" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="Title.lblCaption" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="Title.linBorder" UniqueID="" Timestamp="" />
*<DefinedPropArrayMethod>
*m: addbutton && Internal to the class. Add a new button.
*m: adjustpanelheight && Internal to the class. Adjust the panel height to show the buttons.
*m: adjustsplitterlimits && Internal to the class. Adjust splitter RangeMin and RangeMax limits.
*m: creategradientimage && Create a gradient image.
*m: rearrangebuttons && Internal to the class. Rearrange buttons to show in correctly order and position.
*m: selectedbutton_assign && Internal to the class. Occurs when SelectedButton property is changed.
*m: setcolorscheme && Set color scheme.
*m: showless && Internal to the class. Show less buttons in the panel.
*m: showmore && Internal to the class. Show more buttons in the panel.
*m: themenumber_assign && Internal to the class. Occurs when ThemeNumber property is changed.
*m: themessupport_access && Internal to the class. Occurs when ThemesSupport property is accessed.
*p: imgfocusednotselected && Internal to the class. Name and path of the image to show in the background when button receives the focus and is not selected.
*p: imgfocusedselected && Internal to the class. Name and path of the image to show in the background when button receives the focus and is selected.
*p: imgnotfocusednotselected && Internal to the class. Name and path of the image to show in the background when button does not have focus and is not selected.
*p: imgnotfocusedselected && Internal to the class. Name and path of the image to show in the background when button does not have focus and is selected.
*p: imgsplitbar && Internal to the class. Name and path of the image to show in the background of splitbar.
*p: imgtitle && Internal to the class. Name and path of the image to show in the background of title.
*p: maxshowedbuttons && Maximum number of buttons displayed in the panel.
*p: mnushowlesstext && The text that is displayed in the "Show less" shortcut menu item.
*p: mnushowmoretext && The text that is displayed in the "Show more" shortcut menu item.
*p: rgbborder && RGB color of control borders.
*p: rgbfocusednotselectedend && End RGB color (for gradient effect) of focused and not selected button.
*p: rgbfocusednotselectedstart && Start RGB color (for gradient effect) of focused and not selected button.
*p: rgbfocusedselectedend && End RGB color (for gradient effect) of focused and selected button.
*p: rgbfocusedselectedstart && Start RGB color (for gradient effect) of focused and selected button.
*p: rgbnotfocusednotselectedend && End RGB color (for gradient effect) of not focused and not selected button.
*p: rgbnotfocusednotselectedstart && Start RGB color (for gradient effect) of not focused and not selected button.
*p: rgbnotfocusedselectedend && End RGB color (for gradient effect) of not focused and selected button.
*p: rgbnotfocusedselectedstart && Start RGB color (for gradient effect) of not focused and selected button.
*p: rgbtitleend && End RGB color (for gradient effect) of title.
*p: rgbtitlestart && Start RGB color (for gradient effect) of title.
*p: selectedbutton && Internal to the class. The number of selected button.
*p: showedbuttons && Internal to the class. The number of showed buttons.
*p: themenumber && 0- Automatic, 1- Blue, 2- Silver, 3- Olive and 4- User defined.
*p: themessupport && Specifies if the OS support themes.
*p: version && Outlook2003Bar version.
*</DefinedPropArrayMethod>
HIDDEN themessupport
PROTECTED version
*<PropValue>
Anchor = 15
Height = 362
imgfocusednotselected =
imgfocusedselected =
imgnotfocusednotselected =
imgnotfocusedselected =
imgsplitbar =
imgtitle =
maxshowedbuttons = 7
mnushowlesstext = Show less
mnushowmoretext = Show more
Name = "outlook2003bar"
rgbborder = (Rgb(0,45,150))
rgbfocusednotselectedend = (Rgb(247,192,91))
rgbfocusednotselectedstart = (Rgb(255,255,220))
rgbfocusedselectedend = (Rgb(255,255,220))
rgbfocusedselectedstart = (Rgb(247,192,91))
rgbnotfocusednotselectedend = (Rgb(126,165,224))
rgbnotfocusednotselectedstart = (Rgb(203,225,252))
rgbnotfocusedselectedend = (Rgb(238,149,21))
rgbnotfocusedselectedstart = (Rgb(250,229,147))
rgbtitleend = (Rgb(8,60,161))
rgbtitlestart = (Rgb(85,131,211))
selectedbutton = 0
showedbuttons = 5
themenumber = 0
themessupport = (Null)
version = 1.0.0
Width = 200
*</PropValue>
ADD OBJECT 'OverflowPanel' AS overflowpanel WITH ;
Anchor = 14, ;
Height = 32, ;
Left = 1, ;
Name = "OverflowPanel", ;
Top = 327, ;
Width = 198, ;
MENUBUTTON.imgPicture.Height = 16, ;
MENUBUTTON.imgPicture.Name = "imgPicture", ;
MENUBUTTON.imgPicture.Visible = .F., ;
MENUBUTTON.imgPicture.Width = 16, ;
MENUBUTTON.Name = "MENUBUTTON", ;
MENUBUTTON.Visible = .F.
*< END OBJECT: ClassLib="outlook2003bar.vcx" BaseClass="container" />
ADD OBJECT 'Panel' AS panel WITH ;
Anchor = 14, ;
Left = 0, ;
Name = "Panel", ;
Top = 327
*< END OBJECT: ClassLib="outlook2003bar.vcx" BaseClass="container" />
ADD OBJECT 'Panes' AS pageframe WITH ;
ActivePage = 0, ;
Anchor = 15, ;
BorderWidth = 0, ;
ErasePage = .T., ;
Height = 328, ;
Left = 1, ;
MemberClass = "pane", ;
MemberClassLibrary = outlook2003bar.vcx, ;
Name = "Panes", ;
SpecialEffect = 2, ;
Tabs = .F., ;
Themes = .F., ;
Top = 33, ;
Width = 198
*< END OBJECT: BaseClass="pageframe" />
ADD OBJECT 'SplitBar' AS container WITH ;
Anchor = 14, ;
Height = 7, ;
Left = 0, ;
Name = "SplitBar", ;
Top = 321, ;
Width = 200
*< END OBJECT: BaseClass="container" />
ADD OBJECT 'SplitBar.imgSplitter' AS image WITH ;
Anchor = 768, ;
BackStyle = 0, ;
Height = 3, ;
Left = 81, ;
Name = "imgSplitter", ;
Picture = outlook2003barsplitter.png, ;
Top = 2, ;
Width = 35
*< END OBJECT: BaseClass="image" />
ADD OBJECT 'Splitter' AS splitter2 WITH ;
Anchor = 14, ;
BackStyle = 0, ;
Height = 7, ;
Left = 0, ;
Name = "Splitter", ;
rangemax = 373, ;
rangemin = 365, ;
SpecialEffect = 1, ;
Top = 321, ;
Visible = .F., ;
Width = 200
*< END OBJECT: ClassLib="outlook2003bar.vcx" BaseClass="shape" />
ADD OBJECT 'Title' AS container WITH ;
Anchor = 11, ;
BorderWidth = 0, ;
Height = 35, ;
Left = 1, ;
Name = "Title", ;
Top = 1, ;
Width = 198
*< END OBJECT: BaseClass="container" />
ADD OBJECT 'Title.lblCaption' AS label WITH ;
BackStyle = 0, ;
Caption = "Caption", ;
FontBold = .T., ;
FontSize = 10, ;
ForeColor = 255,255,255, ;
Height = 30, ;
Left = 7, ;
Name = "lblCaption", ;
Top = 0, ;
Width = 190, ;
WordWrap = .T.
*< END OBJECT: BaseClass="label" />
ADD OBJECT 'Title.linBorder' AS line WITH ;
Anchor = 14, ;
Height = 0, ;
Left = 0, ;
Name = "linBorder", ;
Top = 31, ;
Width = 198
*< END OBJECT: BaseClass="line" />
HIDDEN PROCEDURE addbutton && Internal to the class. Add a new button.
Lparameters lcCaption, lcPicture24, lcPicture16
Thisform.LockScreen = .T.
With This
.Panel.AddButton(lcCaption, lcPicture24)
.OverflowPanel.AddButton(lcCaption, lcPicture16)
If .ShowedButtons<.MaxShowedButtons
.ShowMore()
Endif
.AdjustSplitterLimits()
Endwith
Thisform.LockScreen = .F.
ENDPROC
PROCEDURE adjustpanelheight && Internal to the class. Adjust the panel height to show the buttons.
Local lnTopoAtual, lnAlturaDoPainel, lnShowedButtons
With This
With .Splitter
.Anchor = 0
lnTopoAtual = .Top
Local lnResto
Do While .T.
lnAlturaDoPainel = .Parent.OverflowPanel.Top - 6 - lnTopoAtual
lnResto = Mod(lnAlturaDoPainel,32)
If lnResto <> 0
lnTopoAtual = lnTopoAtual - (32 - lnResto)
Else
.Top = lnTopoAtual
Exit
Endif
Enddo
.Anchor = 14
Endwith
With .SplitBar
.Anchor = 0
.Top = lnTopoAtual
.Anchor = 14
Endwith
With .Panes
.Anchor = 0
.Height = lnTopoAtual - .Top
.Anchor = 15
Endwith
With .Panel
.Anchor = 0
.Top = lnTopoAtual + 6
.Height = lnAlturaDoPainel
.Anchor = 14
lnShowedButtons = Int(lnAlturaDoPainel / 32)
Endwith
.ShowedButtons = lnShowedButtons
.ReArrangeButtons()
Endwith
ENDPROC
PROCEDURE adjustsplitterlimits && Internal to the class. Adjust splitter RangeMin and RangeMax limits.
With This
With .Splitter
.RangeMax = This.OverflowPanel.Top + 2
.RangeMin = .RangeMax - .Height - 1 - ;
(Min(This.Panel.ControlCount,This.MaxShowedButtons) * 32)
Endwith
.AdjustPanelHeight()
Endwith
ENDPROC
HIDDEN PROCEDURE creategradientimage && Create a gradient image.
Lparameters lnRGBColor1, lnRGBColor2, lnGradPixels, lcGradFile
Local lnGradMode, lnGradPixels, x1, y1, x2, y2, lnWidth, lnHeight
lnGradMode = 1
Do Case
Case lnGradMode = 1 && Vertical
x1 = 0
y1 = 0
x2 = 1
y2 = lnGradPixels
Case lnGradMode = 2 && Horizontal
x1 = 0
y1 = 0
x2 = lnGradPixels
y2 = 1
Case lnGradMode = 3 && Diagonal TopLeft -> BottomRight
x1 = 0
y1 = 0
x2 = lnGradPixels
y2 = lnGradPixels
Case lnGradMode = 4 && Diagonal BottomLeft -> TopRight
x1 = 0
y1 = lnGradPixels
x2 = lnGradPixels
y2 = 0
Endcase
lnWidth = Iif(lnGradMode = 1, 1, lnGradPixels)
lnHeight = Iif(lnGradMode = 2, 1, lnGradPixels)
* Create Gradient Image
Set Classlib To _gdiplus Additive
* Create a colorObject and store ARGB color values to variables
Local loClr As GpColor Of _gdiplus
Local lnColor1, lnColor2
loClr = Createobject("gpColor")
loClr.FoxRGB = lnRGBColor1
lnColor1 = loClr.ARGB
loClr.FoxRGB = lnRGBColor2
lnColor2 = loClr.ARGB
* Create a bitmap
Local loBmp As GpBitmap Of _gdiplus
loBmp = Createobject("gpBitmap")
loBmp.Create(lnWidth, lnHeight)
* Get a bitmab graphics object
Local loGfx As GpGraphics Of _gdiplus
loGfx = Createobject("gpGraphics")
loGfx.CreateFromImage(loBmp)
* Declare API
Declare Long GdipCreateLineBrushI In GDIPlus ;
String point1, String point2, ;
Long color1, Long color2, ;
Long wrapMode, Long @lineGradient
* Get a gradient brush
Local loBrush As GpBrush Of _gdiplus
Local hBrush && Brush Handle
hBrush = 0
GdipCreateLineBrushI(BinToC(x1,"4rs")+BinToC(y1,"4rs"), ;
BINTOC(x2,"4rs")+BinToC(y2,"4rs"), ;
lnColor1, lnColor2, 0, @hBrush)
loBrush = Createobject("gpBrush")
loBrush.SetHandle(hBrush, .T.)
* Fill the bitmap with our gradient
loGfx.FillRectangle(loBrush,0,0,lnWidth, lnHeight)
loBmp.SaveToFile(lcGradFile,"image/bmp")
Return
ENDPROC
PROCEDURE Destroy
With This
If .ThemesSupport
Unbindevents(0, 0x031A)
Endif
Local laImages[6], lnImage
laImages[1] = .ImgFocusedSelected
laImages[2] = .ImgFocusedNotSelected
laImages[3] = .ImgNotFocusedSelected
laImages[4] = .ImgNotFocusedNotSelected
laImages[5] = .ImgTitle
laImages[6] = .ImgSplitBar
Endwith
For lnImage=1 To Alen(laImages,1)
If Not Empty(laImages[lnImage])
If File(laImages[lnImage])
Clear Resources (laImages[lnImage])
Erase (laImages[lnImage])
Endif
Endif
Endfor
ENDPROC
PROCEDURE Init
With Thisform
.MinHeight = This.Height + 4
.MinWidth = This.Width + 4
.ShowTips = .T.
Endwith
With This
*!* .ImgFocusedSelected = Addbs(Sys(2023))+Sys(2015)+".bmp"
*!* .ImgFocusedNotSelected = Addbs(Sys(2023))+Sys(2015)+".bmp"
*!* .ImgNotFocusedSelected = Addbs(Sys(2023))+Sys(2015)+".bmp"
*!* .ImgNotFocusedNotSelected = Addbs(Sys(2023))+Sys(2015)+".bmp"
*!* .ImgTitle = Addbs(Sys(2023))+Sys(2015)+".bmp"
*!* .ImgSplitBar = Addbs(Sys(2023))+Sys(2015)+".bmp"
.ImgFocusedSelected = "outlook2003bar_1.bmp"
.ImgFocusedNotSelected = "outlook2003bar_2.bmp"
.ImgNotFocusedSelected = "outlook2003bar_3.bmp"
.ImgNotFocusedNotSelected = "outlook2003bar_4.bmp"
.ImgTitle = "outlook2003bar_5.bmp"
.ImgSplitBar = "outlook2003bar_6.bmp"
.SetColorScheme()
With .Panes
Local loPane
For Each loPane In .Pages
This.AddButton(loPane.Caption,loPane.Picture24,loPane.Picture16)
Endfor
loPane = Null
Endwith
If .ThemesSupport
Bindevent(0, 0x031A, This, "SetColorScheme")
Endif
Endwith
ENDPROC
HIDDEN PROCEDURE rearrangebuttons && Internal to the class. Rearrange buttons to show in correctly order and position.
With This.OverflowPanel
Local lnLeft, lnMaxShowedButtons, lnControlCount, lnControl, llVisible
With .Menubutton
lnLeft = .Left
lnMaxShowedButtons = Int(.Left / .Width)
Endwith
lnControlCount = .ControlCount
For lnControl=lnControlCount To 2 Step -1
With .Controls(lnControl)
llVisible = .F.
If .TabIndex > This.ShowedButtons
If lnControl <= (This.ShowedButtons + lnMaxShowedButtons + 1)
lnLeft = lnLeft - .Width
.Anchor = 0
.Left = lnLeft
.Anchor = 9
llVisible = .T.
Endif
Endif
.Visible = llVisible
Endwith
Endfor
Endwith
ENDPROC
HIDDEN PROCEDURE selectedbutton_assign && Internal to the class. Occurs when SelectedButton property is changed.
Lparameters vNewVal
With This
Local lnOldSelectedButton, lcTitle
lnOldSelectedButton = .SelectedButton
.SelectedButton = m.vNewVal
With .Panel
If lnOldSelectedButton>0
.Controls(lnOldSelectedButton).ChangeBackground()
Endif
.Controls(m.vNewVal).ChangeBackground()
lcTitle = .Controls(m.vNewVal).lblCaption.Caption
Endwith
With .OverflowPanel
If lnOldSelectedButton>0
.Controls(lnOldSelectedButton+1).ChangeBackground()
Endif
.Controls(m.vNewVal+1).ChangeBackground()
Endwith
.Title.lblCaption.Caption = lcTitle
.Panes.ActivePage = m.vNewVal
Endwith
ENDPROC
HIDDEN PROCEDURE setcolorscheme && Set color scheme.
Lparameters HWnd As Integer, Msg As Integer, ;
wParam As Integer, Lparam As Integer)
With This
Local lnTheme
If .ThemeNumber==0 && Automatic
lnTheme = 1 && Blue
If .ThemesSupport
Local lnSysColor
Declare Integer GetSysColor In Win32Api Integer
lnSysColor = GetSysColor(2)
Clear Dlls GetSysColor
Do Case
Case lnSysColor == 12632256 && Silver
lnTheme = 2
Case lnSysColor == 6922635 && Olive
lnTheme = 3
Endcase
Endif
Else
lnTheme = .ThemeNumber
Endif
If lnTheme <> 4 && Not user defined
* Focused and selected
.rgbFocusedSelectedStart = Rgb(247,192,91)
.rgbFocusedSelectedEnd = Rgb(255,255,220)
* Focused and not selected
.rgbFocusedNotSelectedStart = Rgb(255,255,220)
.rgbFocusedNotSelectedEnd = Rgb(247,192,91)
* Not Focused and selected
.rgbNotFocusedSelectedStart = Rgb(250,229,147)
.rgbNotFocusedSelectedEnd = Rgb(238,149,21)
Do Case
Case lnTheme = 3 &&6922635 && Olive
* Border
.rgbBorder = Rgb(125,134,118)
* Not Focused and not selected
.rgbNotFocusedNotSelectedStart = Rgb(230,242,200)
.rgbNotFocusedNotSelectedEnd = Rgb(175,191,144)
* Title
.rgbTitleStart = Rgb(174,188,137)
.rgbTitleEnd = Rgb(104,119,74)
Case lnTheme = 2 && 12632256 && Silver
* Border
.rgbBorder = Rgb(132,131,136)
* Not Focused and not selected
.rgbNotFocusedNotSelectedStart = Rgb(220,222,236)
.rgbNotFocusedNotSelectedEnd = Rgb(152,152,177)
* Title
.rgbTitleStart = Rgb(166,167,189)
.rgbTitleEnd = Rgb(118,117,153)
Otherwise && Blue
* Border
.rgbBorder = Rgb(0,45,150)
* Not Focused and not selected
.rgbNotFocusedNotSelectedStart = Rgb(203,225,252)
.rgbNotFocusedNotSelectedEnd = Rgb(126,165,224)
* Title
.rgbTitleStart = Rgb(85,131,211)
.rgbTitleEnd = Rgb(8,60,161)
Endcase
Endif
Local lnRgbBorder, laColors[6,4], loButton, lnImage
lnRgbBorder = .rgbBorder
* Focused and selected
laColors[1,1] = .rgbFocusedSelectedStart
laColors[1,2] = .rgbFocusedSelectedEnd
laColors[1,3] = 32
laColors[1,4] = .ImgFocusedSelected
* Focused and not selected
laColors[2,1] = .rgbFocusedNotSelectedStart
laColors[2,2] = .rgbFocusedNotSelectedEnd
laColors[2,3] = 32
laColors[2,4] = .ImgFocusedNotSelected
* Not Focused and selected
laColors[3,1] = .rgbNotFocusedSelectedStart
laColors[3,2] = .rgbNotFocusedSelectedEnd
laColors[3,3] = 32
laColors[3,4] = .ImgNotFocusedSelected
* Not Focused and not selected
laColors[4,1] = .rgbNotFocusedNotSelectedStart
laColors[4,2] = .rgbNotFocusedNotSelectedEnd
laColors[4,3] = 32
laColors[4,4] = .ImgNotFocusedNotSelected
* Title
laColors[5,1] = .rgbTitleStart
laColors[5,2] = .rgbTitleEnd
laColors[5,3] = 32
laColors[5,4] = .ImgTitle
* SplitBar
laColors[6,1] = .rgbTitleStart
laColors[6,2] = .rgbTitleEnd
laColors[6,3] = 7
laColors[6,4] = .ImgSplitBar
.Title.Picture = ""
.SplitBar.Picture = ""
For Each loButton In .Panel.Controls
loButton.Picture = ""
Endfor
loButton = Null
With .OverflowPanel
.Picture = ""
For Each loButton In .Controls
loButton.Picture = ""
Endfor
Endwith
loButton = Null
For lnImage=Iif(Evl(Msg,0)==0,1,4) To 6
If File(laColors[lnImage,4])
Clear Resources (laColors[lnImage,4])
Erase (laColors[lnImage,4])
Endif
.CreateGradientImage(laColors[lnImage,1], laColors[lnImage,2], ;
laColors[lnImage,3], laColors[lnImage,4])
Endfor
.BorderColor = lnRgbBorder
With .Title
.BorderColor = lnRgbBorder
.Picture = This.ImgTitle
.linBorder.BorderColor = lnRgbBorder
Endwith
.Splitter.BorderColor = lnRgbBorder
With .SplitBar
.Picture = This.ImgSplitBar
.BorderColor = lnRgbBorder
Endwith
With .Panel
.BorderColor = lnRgbBorder
For Each loButton In .Controls
With loButton
.ChangeBackground(.F.)
.BorderColor = lnRgbBorder
.linBorder.BorderColor = lnRgbBorder
Endwith
Endfor
Endwith
loButton = Null
With .OverflowPanel
.Picture = laColors[4,4]
For Each loButton In .Controls
loButton.ChangeBackground(.F.)
Endfor
Endwith
loButton = Null
Endwith
Return .T.
ENDPROC
PROCEDURE showless && Internal to the class. Show less buttons in the panel.
With This
With .Splitter
.Anchor = 0
.Top = .Top + 32
Endwith
.AdjustPanelHeight()
Endwith
ENDPROC
PROCEDURE showmore && Internal to the class. Show more buttons in the panel.
With This
With .Splitter
.Anchor = 0
.Top = .Top - 32
Endwith
.AdjustPanelHeight()
Endwith
ENDPROC
HIDDEN PROCEDURE themenumber_assign && Internal to the class. Occurs when ThemeNumber property is changed.
Lparameters vNewVal
If Between(vNewVal,0,4)
This.ThemeNumber = m.vNewVal
Else
This.ThemeNumber = 1
Endif
ENDPROC
HIDDEN PROCEDURE themessupport_access && Internal to the class. Occurs when ThemesSupport property is accessed.
With This
If Isnull(.ThemesSupport)
Local llThemesSupport
llThemesSupport = .F.
If .ThemeNumber==0 && Automatic
If Os(3)=="5" And Os(4)=="1" && Windows XP
Declare Long IsThemeActive In UXTHEME
llThemesSupport = (IsThemeActive()==1)
Clear Dlls IsThemeActive
Endif
Endif
.ThemesSupport = llThemesSupport
Endif
Endwith
Return This.ThemesSupport
ENDPROC
PROCEDURE Panes.Init
With This
.SetAll("BackColor",.Parent.BackColor,"Page")
Endwith
ENDPROC
PROCEDURE Splitter.Move
Lparameters nLeft, nTop, nWidth, nHeight
DoDefault(nLeft, nTop, nWidth, nHeight)
This.Parent.AdjustSplitterLimits()
ENDPROC
PROCEDURE Splitter.split
This.Parent.AdjustPanelHeight()
ENDPROC
ENDDEFINE
DEFINE CLASS overflowpanel AS container
*< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" />
*-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder
*< OBJECTDATA: ObjPath="MenuButton" UniqueID="" Timestamp="" />
*<DefinedPropArrayMethod>
*m: addbutton && Add a new button to panel.
*</DefinedPropArrayMethod>
*<PropValue>
BorderWidth = 0
Height = 32
Name = "overflowpanel"
Width = 198
*</PropValue>
ADD OBJECT 'MenuButton' AS overflowpanelbutton WITH ;
Anchor = 9, ;
Left = 174, ;
Name = "MenuButton", ;
imgPicture.Height = 16, ;
imgPicture.Name = "imgPicture", ;
imgPicture.Picture = outlook2003bararrow.png, ;
imgPicture.Width = 16
*< END OBJECT: ClassLib="outlook2003bar.vcx" BaseClass="container" />
PROCEDURE addbutton && Add a new button to panel.
Lparameters lcCaption, lcPicture
With This
Local lnControlCount
lnControlCount = .ControlCount + 1
.Newobject("Button"+Alltrim(Str(lnControlCount - 1)),;
"OverflowPanelButton","Outlook2003Bar",,;
lcCaption,lcPicture)
Endwith
ENDPROC
PROCEDURE MenuButton.changeselectedbutton
Local lnButtonCount
lnButtonCount = This.Parent.ControlCount - 1
If lnButtonCount > 0
Private loBar
loBar = This.Parent.Parent
With This.ShortcutMenu
.NewMenu()
Local laMenu[lnButtonCount, 2]
laMenu=""
Local loButton
For Each loButton In This.Parent.Controls
With loButton
If Upper(.Class) == Upper("OverflowPanelButton") And .Name <> This.Name
laMenu[.TabIndex, 1] = .imgPicture.ToolTipText
laMenu[.TabIndex, 2] = .imgPicture.Picture
Endif
Endwith
Endfor
loButton = Null
Local lnMenuItem
For lnMenuItem=1 To Alen(laMenu,1)
.AddMenuBar( laMenu[lnMenuItem, 1], ;
"loBar.Selectedbutton = Bar()", ;
"Picture '" + laMenu[lnMenuItem, 2] + "'",,;
.F.,.F.,(lnMenuItem==loBar.Selectedbutton) )
Endfor
.AddMenuSeparator()
.AddMenuBar(loBar.mnuShowMoreText,;
"loBar.ShowMore()",,,.F.,;
loBar.Showedbuttons=loBar.MaxShowedbuttons,.F.)
.AddMenuBar(loBar.mnuShowLessText,;
"loBar.ShowLess()",,,.F.,;
loBar.Showedbuttons=0,.F.)
.ShowMenu()
.SetMenu()
Endwith
Release loBar
Endif
ENDPROC
PROCEDURE MenuButton.Destroy
With This
.ShortcutMenu.ClearMenu()
.ShortcutMenu = Null
Endwith
ENDPROC
PROCEDURE MenuButton.Init
Nodefault
This.AddProperty("ShortcutMenu",Newobject("_ShortcutMenu","_menu"))
ENDPROC
ENDDEFINE
DEFINE CLASS overflowpanelbutton AS container
*< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" />
*-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder
*< OBJECTDATA: ObjPath="imgPicture" UniqueID="" Timestamp="" />
*<DefinedPropArrayMethod>
*m: changebackground && Change button's background image.
*m: changeselectedbutton && Change selected button.
*</DefinedPropArrayMethod>
*<PropValue>
BorderWidth = 0
Height = 32
MousePointer = 15
Name = "overflowpanelbutton"
Width = 24
*</PropValue>
ADD OBJECT 'imgPicture' AS image WITH ;
BackStyle = 0, ;
Height = 16, ;
Left = 4, ;
MousePointer = 15, ;
Name = "imgPicture", ;
Top = 8, ;
Width = 16
*< END OBJECT: BaseClass="image" />
PROCEDURE changebackground && Change button's background image.
Lparameters llGotFocus
#Define lnFocused 8
#Define lnNotFocused 16
#Define lnSelected 32
#Define lnNotSelected 64
Local lnState, lcImage
With This.Parent.Parent
lnState = (Iif(llGotFocus,lnFocused,lnNotFocused) + ;
Iif(.SelectedButton==This.TabIndex,lnSelected,lnNotSelected))
Do Case
Case lnState = (lnFocused + lnSelected)
lcImage = .ImgFocusedSelected
Case lnState = (lnFocused + lnNotSelected)
lcImage = .ImgFocusedNotSelected
Case lnState = (lnNotFocused + lnSelected)
lcImage = .ImgNotFocusedSelected
Case lnState = (lnNotFocused + lnNotSelected)
lcImage = .ImgNotFocusedNotSelected
Otherwise
lcImage = ""
Endcase
Endwith
This.Picture = lcImage
ENDPROC
PROCEDURE changeselectedbutton && Change selected button.
This.Parent.Parent.SelectedButton = This.TabIndex
ENDPROC
PROCEDURE Click
This.ChangeSelectedButton()
ENDPROC
PROCEDURE Init
Lparameters lcToolTipText, lcPicture
With This
.TabIndex = .TabIndex - 1
.Top = 0
.SetAll("ToolTipText",lcToolTipText)
.imgPicture.Picture = lcPicture
If .TabIndex == 1
.ChangeSelectedButton()
Else
.ChangeBackground(.F.)
Endif
Endwith
ENDPROC
PROCEDURE MouseEnter
Lparameters nButton, nShift, nXCoord, nYCoord
This.ChangeBackground(.T.)
ENDPROC
PROCEDURE MouseLeave
Lparameters nButton, nShift, nXCoord, nYCoord
This.ChangeBackground(.F.)
ENDPROC
PROCEDURE imgPicture.Click
This.Parent.ChangeSelectedButton()
ENDPROC
ENDDEFINE
DEFINE CLASS pane AS page
*< CLASSDATA: Baseclass="page" Timestamp="" Scale="Pixels" Uniqueid="" />
*<DefinedPropArrayMethod>
*p: picture16 && 16x16 image displayed in the panel buttons.
*p: picture24 && 24x24 image displayed in the panel buttons.
*</DefinedPropArrayMethod>
*<PropValue>
BackColor = 255,255,255
Caption = "Page1"
Height = 195
Name = "pane"
picture16 = ("")
picture24 = ("")
Width = 195
*</PropValue>
ENDDEFINE
DEFINE CLASS panel AS container
*< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" />
*<DefinedPropArrayMethod>
*m: addbutton && Add a new button to panel.
*</DefinedPropArrayMethod>
*<PropValue>
BackStyle = 0
Height = 0
Name = "panel"
Width = 200
*</PropValue>
PROCEDURE addbutton && Add a new button to panel.
Lparameters lcCaption, lcPicture
With This
.Newobject("Button"+Alltrim(Str(.ControlCount + 1)),;
"PanelButton","Outlook2003Bar",,;
lcCaption,lcPicture)
Endwith
ENDPROC
ENDDEFINE
DEFINE CLASS panelbutton AS container
*< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" />
*-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder
*< OBJECTDATA: ObjPath="lblCaption" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="linBorder" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="imgPicture" UniqueID="" Timestamp="" />
*<DefinedPropArrayMethod>
*m: changebackground && Change button's background image.
*m: changeselectedbutton && Change selected button.
*m: do_arata_formular
*m: do_date_generale
*m: do_linkuri
*m: do_observatii
*m: do_referinte
*</DefinedPropArrayMethod>
*<PropValue>
Height = 32
MousePointer = 15
Name = "panelbutton"
Width = 198
*</PropValue>
ADD OBJECT 'imgPicture' AS image WITH ;
BackStyle = 0, ;
Height = 24, ;
Left = 4, ;
MousePointer = 15, ;
Name = "imgPicture", ;
Top = 4, ;
Width = 24
*< END OBJECT: BaseClass="image" />
ADD OBJECT 'lblCaption' AS label WITH ;
Anchor = 10, ;
BackStyle = 0, ;
Caption = "", ;
FontBold = .T., ;
FontName = "Arial", ;
Height = 29, ;
Left = 38, ;
MousePointer = 15, ;
Name = "lblCaption", ;
Top = 2, ;
Width = 156, ;
WordWrap = .T.
*< END OBJECT: BaseClass="label" />
ADD OBJECT 'linBorder' AS line WITH ;
Anchor = 14, ;
Height = 0, ;
Left = 0, ;
MousePointer = 15, ;
Name = "linBorder", ;
Top = 31, ;
Width = 198
*< END OBJECT: BaseClass="line" />
PROCEDURE changebackground && Change button's background image.
Lparameters llGotFocus
#Define lnFocused 8
#Define lnNotFocused 16
#Define lnSelected 32
#Define lnNotSelected 64
Local lnState, lcImage
With This.Parent.Parent
lnState = (Iif(llGotFocus,lnFocused,lnNotFocused) + ;
Iif(.SelectedButton==This.TabIndex,lnSelected,lnNotSelected))
Do Case
Case lnState = (lnFocused + lnSelected)
lcImage = .ImgFocusedSelected
Case lnState = (lnFocused + lnNotSelected)
lcImage = .ImgFocusedNotSelected
Case lnState = (lnNotFocused + lnSelected)
lcImage = .ImgNotFocusedSelected
Case lnState = (lnNotFocused + lnNotSelected)
lcImage = .ImgNotFocusedNotSelected
Otherwise
lcImage = ""
ENDCASE
Endwith
This.Picture = lcImage
ENDPROC
PROCEDURE changeselectedbutton && Change selected button.
This.Parent.Parent.SelectedButton = This.TabIndex
ENDPROC
PROCEDURE Click
THIS.ChangeSelectedButton()
this.do_arata_formular()
ENDPROC
PROCEDURE do_arata_formular
LOCAL loPagina
loPagina = goFundal._pgfrmbase1.page3
*!* 23.07.2026 MM - partener NULL: fara prompt/salvare, raman in editare (P1/P2)
IF !loPagina.ct_part_nr_data1.llock AND !(ISNULL(goRegistratura.id_part) OR EMPTY(goRegistratura.id_part))
LOCAL lnRaspuns
loPagina.ct_part_nr_data1.llock = .T.
lnRaspuns = AMESSAGEBOX('Doriti sa salvati modificarile facute?',4+32,'Atentie')
loPagina.ct_part_nr_data1.REFRESH()
IF lnRaspuns = 7
RETURN
ELSE
DO modifica_reg_dg WITH goRegistratura IN oproceduri_roaregistratura.prg
ENDIF
ENDIF
IF TYPE('podg_dg.but_termin1') <> 'U'
podg_dg.but_termin1.CLICK()
ENDIF
IF TYPE('podg_referinte.but_termin1') <> 'U'
podg_referinte.but_termin1.CLICK()
ENDIF
IF TYPE('podg_obs.but_termin1') <> 'U'
podg_obs.but_termin1.CLICK()
ENDIF
IF TYPE('podg_link.but_termin1') <> 'U'
podg_link.but_termin1.CLICK()
ENDIF
IF !EMPTY(goRegistratura.id_reg)
DO CASE
CASE ALLTRIM(UPPER(THIS.lblCaption.CAPTION)) = 'DATE GENERALE'
THIS.do_date_generale()
CASE ALLTRIM(UPPER(THIS.lblCaption.CAPTION)) = 'REFERINTE'
THIS.do_referinte()
CASE ALLTRIM(UPPER(THIS.lblCaption.CAPTION)) = 'OBSERVATII'
THIS.DO_Observatii()
CASE ALLTRIM(UPPER(THIS.lblCaption.CAPTION)) = 'DOCUMENTE ATASATE'
THIS.DO_Linkuri()
OTHERWISE
&& AMESSAGEBOX('Altceva')
ENDCASE
ENDIF
ENDPROC
PROCEDURE do_date_generale
DO FORM 'frm_dg_date_generale' NAME podg_dg
ENDPROC
PROCEDURE do_linkuri
DO FORM 'frm_viz_atasamente' NAME podg_link
ENDPROC
PROCEDURE do_observatii
DO FORM 'frm_dg_observatii' NAME podg_obs
ENDPROC
PROCEDURE do_referinte
DO FORM 'frm_dg_referinte' NAME podg_referinte
ENDPROC
PROCEDURE Init
Lparameters lcCaption, lcPicture
Local lnBorderColor
With This
lnBorderColor = .Parent.Parent.rgbBorder
.Anchor = 0
.BorderColor = lnBorderColor
.Left = 1
.Top = ((.TabIndex*(.Height))-.Height)
.Anchor = 10
.lblCaption.Caption = lcCaption
.imgPicture.Picture = lcPicture
.linBorder.BorderColor = lnBorderColor
.ChangeBackground(.F.)
.Visible = .T.
Endwith
ENDPROC
PROCEDURE MouseEnter
Lparameters nButton, nShift, nXCoord, nYCoord
This.ChangeBackground(.T.)
ENDPROC
PROCEDURE MouseLeave
Lparameters nButton, nShift, nXCoord, nYCoord
This.ChangeBackground(.F.)
ENDPROC
PROCEDURE imgPicture.Click
This.Parent.ChangeSelectedButton()
this.Parent.do_arata_formular()
ENDPROC
PROCEDURE lblCaption.Click
This.Parent.ChangeSelectedButton()
this.Parent.do_arata_formular()
ENDPROC
ENDDEFINE
DEFINE CLASS splitter2 AS shape && Up-Down Splitter class. Support ActiveX controls. Author: gerald.santerre@siteintranet.qc.ca
*< CLASSDATA: Baseclass="shape" Timestamp="" Scale="Pixels" Uniqueid="" />
*<DefinedPropArrayMethod>
*m: hidecontrols && internal use
*m: readme
*m: showcontrols && internal use
*m: split && This method is called at the end of the split operation.
*p: rangemax && The splitter can be dragged to the bottom up to this value. Pixels from the top of the parent. Value < 1 is percent of parent height.
*p: rangemin && The splitter can be dragged to the top down to this value. Value < 1 is percent of parent height.
*a: hiddencontrols[1,1] && Array of controls
*</DefinedPropArrayMethod>
HIDDEN hiddencontrols
PROTECTED Init,mousedown
*<PropValue>
Height = 4
MousePointer = 7
Name = "splitter2"
rangemax = 0.8
rangemin = 0.2
SpecialEffect = 0
Width = 100
*</PropValue>
PROCEDURE Destroy
* decrement instance counter, if 0 release object (this.release Dlls)
If type("_screen.___SplitterApi")="O" AND !ISNULL(_screen.___SplitterApi)
_screen.___SplitterApi.nInstances = _screen.___SplitterApi.nInstances - 1
If _screen.___SplitterApi.nInstances <= 0
_screen.___SplitterApi.nInstances = .Null.
_screen.RemoveObject("___SplitterApi")
Endif
Endif
ENDPROC
HIDDEN PROCEDURE hidecontrols && internal use
* hide all controls include ActiveX with property visible inside container tObject
* without this splitter and form
LPARAMETERS tObject,nIndex
* tObject is root object, if not passed, thisform is used
IF EMPTY(nIndex)
nIndex=2
ENDIF
LOCAL lcObjectBaseClass, lObject, lTempObject
* build collection hidden object for reverse setting in showcontrols
* set valid object
IF VARTYPE(tObject)="O"
lObject= tObject
ELSE
lObject= THISFORM
ENDIF
* ignore this splitter
IF lObject = THIS
RETURN nIndex
ENDIF
* unify
lcObjectBaseClass = LOWER(lObject.BASECLASS)+" " && " " for unique (page # pageframe)
* do not hide form window
IF lcObjectBaseClass # "form " AND PEMSTATUS(lObject,"visible",5)
IF lObject.VISIBLE
DIMENSION this.HiddenControls[nIndex]
this.hiddencontrols[nIndex]=lObject
lObject.VISIBLE = .F.
nIndex=nIndex+1
ENDIF
ENDIF
* recurse for all children
DO CASE
CASE INLIST(lcObjectBaseClass,"pageframe ")
FOR EACH lTempObject IN lObject.PAGES
nIndex=THIS.hidecontrols(lTempObject,nIndex)
ENDFOR
CASE INLIST(lcObjectBaseClass,"form ","container ","page ")
FOR EACH lTempObject IN lObject.CONTROLS
nIndex=THIS.hidecontrols(lTempObject,nIndex)
ENDFOR
CASE INLIST(lcObjectBaseClass,"commandgroup ","optiongroup ")
FOR EACH lTempObject IN lObject.BUTTONS
nIndex=THIS.hidecontrols(lTempObject,nIndex)
ENDFOR
ENDCASE
RETURN nIndex+1
ENDPROC
PROTECTED PROCEDURE Init
* API FUNCTIONS - declare only one for all splitter with this class
IF !VARTYPE(_SCREEN.___SplitterApi)="O"
IF AT(UPPER((this.ClassLibrary)),UPPER(SET("Classlib")))=0
SET CLASSLIB TO (this.ClassLibrary) ADDITIVE
ENDIF
_SCREEN.AddObject("___SplitterApi","SplitterAPI")
ELSE
_SCREEN.___SplitterApi.nInstances = _SCREEN.___SplitterApi.nInstances + 1
ENDIF
RETURN VARTYPE(_SCREEN.___SplitterApi)="O"
ENDPROC
PROTECTED PROCEDURE MouseDown
Lparameters nButton, nShift, nXCoord, nYCoord
Local lcWindowName,lnScaleMode,lnMinRow,lnMaxRow,lnMRow1,lnMRow2
Local lnRows,lnTop,lnOldTop,lnMin,oldMRow2
Local llLockScreen,lnMousePointer
Local lhDC,lhMemDC,lhMemBmp,lHWnd,lnBmpHeight,nLeftOffset,nTopOffset,oContainer,xHeight
Local lcOldFormName,lhMemSplit
If nButton#1
Return
Endif
lcOldFormName = Thisform.Name
Thisform.Name = Sys(2015)
lcWindowName=Thisform.Name
lnScaleMode=Thisform.ScaleMode
Thisform.ScaleMode=3 && pixels
oContainer=This.Parent
nLeftOffset=Objtoclient(This,2)-This.Left
nTopOffset=Objtoclient(This,1)-This.Top
lnMRow1=Mrow(lcWindowName,3)
If Type("lnMRow1")#"N" Or lnMRow1<=0
Thisform.ScaleMode=lnScaleMode
Thisform.Name = lcOldFormName
Return
Endif
lnMRow1=lnMRow1-nTopOffset
If lnMRow1 <> This.Top+1
lnMRow1 = This.Top+1
Mouse At lnMRow1+nTopOffset, Mcol(lcWindowName,3) Pixels Window (lcWindowName)
Endif
* set some vars
llLockScreen=Thisform.LockScreen
lnMousePointer=Thisform.MousePointer
Thisform.MousePointer= 7
lnTop=This.Top
* check two parent level for Height- suppose that parent form always present
If Pemstatus(oContainer,"Height",5)
xHeight = oContainer.Height
Else
If Pemstatus(oContainer.Parent,"PageHeight",5)
xHeight = oContainer.Parent.PageHeight
Else
* if error that oContainer.Height and oContainer.parent.width not exist, something wrong
xHeight = oContainer.Parent.Height
Endif
Endif
* RangeMin (RangeMax) < 1
* RangeMin (RangeMax) are used as coeficient (%/100)
* RangeMin (RangeMax) > 1
* RangeMin (RangeMax) are used as absolute offset in pixels
* RangeMin (RangeMax) =0
* RangeMin (RangeMax) are ignored - no restriction
Do Case
Case This.RangeMin <= 0
lnMinRow=This.Height*2
Case This.RangeMin > 1
lnMinRow=Max(This.Height*2,Int(This.RangeMin))
Case This.RangeMin < 1
lnMinRow=Max(This.Height*2,Int(This.RangeMin*xHeight))
Endcase
Do Case
Case This.RangeMax <= 0
lnMaxRow=xHeight-(This.Height*3)
Case This.RangeMax > 1
lnMaxRow=Min(xHeight-(This.Height*3),This.RangeMax)
Case This.RangeMax < 1
lnMaxRow=Min(xHeight-(This.Height*3),This.RangeMax*xHeight)
Endcase
If lnMinRow>lnMaxRow
* nothing to move!!!
Thisform.ScaleMode=lnScaleMode
Thisform.Name = lcOldFormName
Return
Endif
lnMRow2=lnMRow1
oldMRow2=lnMRow2
#Define SRCCOPY 13369376
* API CALLS
If Thisform.ShowWindow= 2
* workaround, when showwindow=2 the handle is not the right one...
* worst if you have a toolbar!
*#define GW_HWNDFIRST 0
#Define GW_HWNDLAST 1
*#define GW_HWNDNEXT 2
*#define GW_HWNDPREV 3
*#define GW_OWNER 4
#Define GW_CHILD 5
lHWnd=Thisform.HWnd
lHWnd=GS_SplitGetWindow(lHWnd,GW_CHILD)
lHWnd=GS_SplitGetWindow(lHWnd,GW_HWNDLAST)
Else
lHWnd=Thisform.HWnd
Endif
lhDC = GS_SplitGetDC(lHWnd)
lhMemDC = GS_SplitCreateCompatibleDC(lhDC)
* Take a copy of the portion of the form that can be dragged over
lnBmpHeight=This.Height
lhMemBmp = GS_SplitCreateCompatibleBitmap(lhDC, This.Width, lnBmpHeight)
lhMemSplit = GS_SplitCreateCompatibleBitmap(lhDC, This.Width, lnBmpHeight)
= GS_SplitSelectObject(lhMemDC , lhMemBmp)
= GS_SplitBitBlt(lhMemDC, 0, 0, This.Width, lnBmpHeight, ;
lhDC, This.Left+nLeftOffset, lnMRow1-1+nTopOffset, SRCCOPY)
= GS_SplitSelectObject(lhMemDC , lhMemSplit)
= GS_SplitBitBlt(lhMemDC, 0, 0, This.Width, lnBmpHeight, ;
lhDC, This.Left+nLeftOffset, lnMRow1-1+nTopOffset, SRCCOPY)
* Stop fox drawing in the screen
Thisform.LockScreen=.T.
This.hidecontrols(oContainer)
* update the display while dragging
Do While Mdown()
DoEvents
lnMRow2=Mrow(lcWindowName,3)-nTopOffset
If Type("lnMRow2")#"N" Or lnMRow2=0
Loop
Endif
If lnMRow2<=lnMinRow
*force the mouse to stay at this position
Mouse At lnMinRow+nTopOffset, Mcol(lcWindowName,3) Pixels Window (lcWindowName)
lnMRow2=lnMinRow+1
Endif
If lnMRow2>=(lnMaxRow-This.Height)
*force the mouse to stay at this position
Mouse At lnMaxRow-This.Height+nTopOffset, Mcol(lcWindowName,3) Pixels Window (lcWindowName)
lnMRow2=lnMaxRow-This.Height
Endif
lnMRow2=Min(Max(lnMRow2,lnMinRow),lnMaxRow)
If oldMRow2=lnMRow2
Loop
Else
* on mouse move, redraw a part of the screen from the memory copy
* and draw "this" image at the mouse position
* bitblt (dest...source...)
With This
.Top=lnTop+(lnMRow2-lnMRow1)
*restore
= GS_SplitSelectObject(lhMemDC , lhMemBmp)
= GS_SplitBitBlt(lhDC, .Left+nLeftOffset, oldMRow2-1+nTopOffset, .Width, .Height+3,;
lhMemDC, 0, 0, SRCCOPY)
*take a new copy
= GS_SplitBitBlt(lhMemDC, 0, 0, This.Width, lnBmpHeight, ;
lhDC, This.Left+nLeftOffset, lnMRow2-1+nTopOffset, SRCCOPY)
*draw
= GS_SplitSelectObject(lhMemDC , lhMemSplit)
= GS_SplitBitBlt(lhDC, .Left+nLeftOffset, .Top+nTopOffset, .Width, .Height+1,;
lhMemDC, 0, 0, SRCCOPY)
Endwith
oldMRow2=lnMRow2
Endif
Enddo
This.showcontrols()
Thisform.Name = lcOldFormName
If lnMRow2<0
lnMRow2=lnMRow1
Endif
lnRows=lnMRow2-lnMRow1
This.Top=lnTop+lnRows
Thisform.ScaleMode=lnScaleMode
Thisform.MousePointer=lnMousePointer
This.Split()
Thisform.LockScreen=llLockScreen
* free the memory
= GS_SplitReleaseDC(lHWnd, lhDC)
= GS_SplitDeleteObject(lhMemBmp)
= GS_SplitDeleteObject(lhMemSplit)
= GS_SplitDeleteDC(lhMemDC)
ENDPROC
HIDDEN PROCEDURE readme
*!* Splitter class
*!* May 2004
*!* Active-X controls always drive me nuts because they use there own windows handle.
*!* You cannot put a fox native control over them to resize the control visually.
*!* You have to use some tricks like changing the control to
*!* another one for this operation and rechange it back after.
*!* ( See the class browser code )
*!* What I want is a splitter that can handle this in a visual way
*!* while keeping the form (look) unchanged until the end of the split.
*!* After many try and fail, I have finally found a way to do it
*!* by the use of API calls. IT WORK!!!
*!* Days of work to end with only a couple of code lines :)
*!* I am not an API guru, so if you find a way to improve this class
*!* feel free to let me know how :)
*!* Tested with VFP 8-7 on Windows 2000
*!* (no animal other than the usual fox was used in the tests)
*!* Disclaimer: (...) <- put the usual disclaimer here!
*!* G<>rald Santerre
*!* gerald.santerre@siteintranet.qc.ca
*!* USAGE:
*!* Drop this class on a form or a container between the objects that share the container.
*!* New release, complete redesing.
*!* If you already use a previous version of the class, read this carefully.
*!* I have removed a couple of properties and change the way the classes work.
*!* For this reason I have also renamed the classlib to avoid conflicts
*!* with previous version of the class. The new design is cleaner and the control
*!* don't touch anything in the form (except hiding controls during split).
*!* A large part of the new design is from suggestions received
*!* from "Jarom<6F>r Stacha" from Czech Republic.
*!* Thank you Jaromir :).
*!* The new splitter classes don't move or resize controls anymore.
*!* The splitter.split() method is always called after a split operation
*!* and you have to resize/reposition your controls from this (fake)event.
*!* If you don't put code in the split() method, the form.resize() event
*!* of the form will be called. See the resize() and splitter1.split()
*!* method of the demo form for a working sample.
*!* You have only 2 properties to set in the class,
*!* RangeMin and RangeMax.
*!* If you set the value of this properties between 0 and 1,
*!* the value is handled as a % of the splitter's parent container width ot height.
*!* For example, if you enter 0.2 as value for RangeMin,
*!* you will be able to move the splitter down to 20% of the width/height
*!* of the splitter's parent container.
*!* Values greater than 1 will be handle as absolute values.
*!* Don't forget to reset absolute values when the splitter's parent container is resized.
*!* The splitter API is now self contained and you dont have
*!* to worry about releasing the references to API functions.
*!* The splitter now also handle correctly multiple instances
*!* of the same form (or forms with the same name).
*!* The splitter automatically hide every controls that are in
*!* the same parent container (recursive) to avoid side effects
*!* (like mouse cursor beam over text boxes).
*!* Contact: gerald.santerre@siteintranet.qc.ca
ENDPROC
HIDDEN PROCEDURE showcontrols && internal use
* show temporary hidden objects and clear list (collection)
LPARAMETERS toRoot
IF ALEN(THIS.hiddencontrols,1)<2
RETURN
ENDIF
FOR i=2 TO ALEN(THIS.hiddencontrols,1)
IF TYPE("THIS.hiddencontrols[i]")="O"
THIS.hiddencontrols[i].Visible=.T.
ENDIF
ENDFOR
DIMENSION THIS.hiddencontrols[1]
ENDPROC
PROCEDURE split && This method is called at the end of the split operation.
*default behaviour
THISFORM.RESIZE()
ENDPROC
ENDDEFINE
DEFINE CLASS splitterapi AS custom && Splitter API declaration class
*< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" />
*<DefinedPropArrayMethod>
*p: ninstances
*</DefinedPropArrayMethod>
*<PropValue>
Height = 15
Name = "splitterapi"
ninstances = 1
Width = 27
*</PropValue>
PROCEDURE Destroy
Clear Dlls ;
"GS_SplitGetDC",;
"GS_SplitCreateCompatibleDC",;
"GS_SplitCreateCompatibleBitmap",;
"GS_SplitSelectObject",;
"GS_SplitReleaseDC",;
"GS_SplitDeleteDC",;
"GS_SplitBitBlt",;
"GS_SplitGetWindow",;
"GS_SplitDeleteObject"
ENDPROC
PROCEDURE Init
Declare Long GetDC in Win32API as GS_SplitGetDC Long hwnd
Declare Long CreateCompatibleDC in Win32API as GS_SplitCreateCompatibleDC Long hdc
Declare Long CreateCompatibleBitmap in Win32API as GS_SplitCreateCompatibleBitmap Long hdc, Long nWidth, Long nHeight
Declare Long SelectObject in Win32API as GS_SplitSelectObject Long hdc, Long hObject
Declare Long ReleaseDC in Win32API as GS_SplitReleaseDC Long hwnd, Long hdc
Declare Long DeleteDC in Win32API as GS_SplitDeleteDC Long hdc
Declare Long BitBlt in Win32API as GS_SplitBitBlt ;
Long hDestDC, Long x, Long y, Long nWidth, Long nHeight, ;
Long hSrcDC, Long xSrc, Long ySrc, Long dwRop
Declare INTEGER DeleteObject in Win32API as GS_SplitDeleteObject Long hObject
DECLARE INTEGER GetWindow IN user32 as GS_SplitGetWindow ;
INTEGER hwnd,;
INTEGER wFlag
ENDPROC
ENDDEFINE
Reference in New Issue View Git Blame Copy Permalink