tomboy-ng_0.39-1/0000755000175000017500000000000014551457755013442 5ustar dbannondbannontomboy-ng_0.39-1/glyphs/0000755000175000017500000000000014551457755014750 5ustar dbannondbannontomboy-ng_0.39-1/glyphs/install-local.bash0000644000175000017500000000367614551457644020356 0ustar dbannondbannon#!/usr/bin/bash # A quick and dirty script playing with where icons go. # Definitly not for production use. APPNAME=tomboy-ng DEST="$HOME"/.icons/hicolor function WriteDesktop () { # we need write a new one cos need to mention user's user name. DT_FILE="$HOME"/.local/share/applications/"$APPNAME".desktop echo "--- DT_FILE is $DT_FILE" echo "[Desktop Entry]" > "$DT_FILE" echo "Name=tomboy-ng" >> "$DT_FILE" echo "Name[de]=tomboy-ng" >> "$DT_FILE" echo "Name[es]=tomboy-ng" >> "$DT_FILE" echo "Name[fr]=tomboy-ng" >> "$DT_FILE" echo "Comment=Cross Platform Notes" >> "$DT_FILE" echo "Comment[de]=Notizen Plattformübergreifend" >> "$DT_FILE" echo "Comment[es]=Notas Multiplatforma" >> "$DT_FILE" echo "Comment[fr]=Notes Multiplateforme" >> "$DT_FILE" echo "GenericName=Note Taker" >> "$DT_FILE" echo "GenericName[de]=Notizanwendung" >> "$DT_FILE" echo "GenericName[es]=Tomador de apuntes" >> "$DT_FILE" echo "GenericName[fr]=Application de prise de notes" >> "$DT_FILE" echo "Exec=$HOME/bin/tomboy-ng %f" >> "$DT_FILE" echo "Icon=$DEST/256x256/apps/tomboy-ng.png" >> "$DT_FILE" echo "Terminal=false" >> "$DT_FILE" echo "Type=Application" >> "$DT_FILE" echo "Categories=GNOME;Utility" >> "$DT_FILE" } function InstallStuff () { if [ "$1" = "remove" ]; then echo "Remove Mode" else echo "Install Mode" fi if [ "$1" = "remove" ]; then rm /home/"$USER"/.local/share/applications/"$APPNAME".desktop rm "$HOME"/bin/"$APPNAME" else WriteDesktop # cp "$APPNAME".desktop "$HOME"/.local/share/applications/"$APPNAME".desktop mkdir -p "$HOME"/bin cp "$APPNAME" "$HOME"/bin/"$APPNAME" fi # --------- Icons ----------- mkdir -p "$DEST" for i in 16x16 22x22 24x24 32x32 48x48 256x256 ; do if [ "$1" = "remove" ]; then rm "$DEST/$i/apps/$APPNAME.png" else mkdir -p "$DEST"/"$i"/apps cp "$i.png" "$DEST/$i/apps/$APPNAME.png" fi # echo "$DEST/$i/apps/$APPNAME.png" done; gtk-update-icon-cache -t "$DEST" } InstallStuff "$1" tomboy-ng_0.39-1/glyphs/tomboy-ng.desktop0000644000175000017500000000116414551457644020255 0ustar dbannondbannon[Desktop Entry] Name=tomboy-ng Name[de]=tomboy-ng Name[es]=tomboy-ng Name[fr]=tomboy-ng Name[nl]=tomboy-ng Comment=Cross Platform Notes Comment[de]=Notizen Plattformübergreifend Comment[es]=Notas Multiplatforma Comment[fr]=Notes Multiplateforme Comment[nl]=Platformoverschrijdend notities GenericName=Note Taker GenericName[de]=Notizanwendung GenericName[es]=Tomador de apuntes GenericName[fr]=Application de prise de notes GenericName[nl]=Notities maken Exec=env QT_QPA_PLATFORM=xcb tomboy-ng %f Icon=/usr/share/icons/hicolor/256x256/apps/tomboy-ng.png Terminal=false Type=Application Categories=GNOME;Utility Keywords=notes; tomboy-ng_0.39-1/glyphs/uninstall.sh0000644000175000017500000000046414551457644017316 0ustar dbannondbannon#!/usr/bin/bash # A quick and dirty script playing with where icons go. # Definitly not for production use. APPNAME=tomboy-ng DEST=/usr/share/icons/hicolor for i in 16x16 22x22 24x24 32x32 48x48 256x256 ; do # for i in 256x256 ; do rm "$DEST/$i/apps/$APPNAME.png" # rm -Rf "$DEST/$i/apps/$APPNAME" done; tomboy-ng_0.39-1/glyphs/icons/0000755000175000017500000000000014551457644016060 5ustar dbannondbannontomboy-ng_0.39-1/glyphs/icons/hicolor/0000755000175000017500000000000014551457644017517 5ustar dbannondbannontomboy-ng_0.39-1/glyphs/icons/hicolor/256x256/0000755000175000017500000000000014551457644020460 5ustar dbannondbannontomboy-ng_0.39-1/glyphs/icons/hicolor/256x256/apps/0000755000175000017500000000000014551457644021423 5ustar dbannondbannontomboy-ng_0.39-1/glyphs/icons/hicolor/256x256/apps/tomboy-ng.png0000644000175000017500000020746014551457644024055 0ustar dbannondbannonPNG  IHDR\rfiTXtXML:com.adobe.xmp þ-%iCCPxypd_sRGB default i1 DisplayPro, ColorMunki Display _[2018-11-14_18 35]x| |En䂈CAɵ אf# *n1$ $ 23:ㆢ>:긏Ό "2#n(﫮S`IUN:ۚڻz>vix!ޮhlS\SS%? st+6涷B~f"?[pf|'~t7vOzK[:\R^_yzOڱ'?/efeFܶn5K[5.tutVΝ}t TEaXP<:u7[˫&y<Z^7k .^ux / ^% jhPyZR^_"/52̓W7uY:sVw/linimSR\̇ow\VRY|ZgnwK_>??٠-+&tt 8/-d}7kgVb߸}}z{oWv׫v=yoMA4s%Ia7 1]=}k^~/ݫWGszs>=7}P{3O]gE}+k7culvf (*~]n~߱ggs~nAo؀ 8u[[ŚAG za˽}N/jVg3dPo识ohܵm 1.~0cDX_,Y: j ޿QcG}.ͻ'cv؉}{71>:Xʖ+¨5*'(G~!{ ػ>/W? ޾/kz] n77o};[|sП=裏/~O_%]/^^mo<_/jY~yՊcV^ѣ|+ל~-֯˒r2٘~]3ecPEяXndbp={z{#޾uN8dAi{Y'UL.-gu@X1U[WUv'K^z.>薃ov!za~4}ٍL?KZq̻g=;'۟dSs9οvqs;-=>8q/?:Ӆ9S<},urgת=}_r궵'=]ۧ{_})oqW\?D4fS;`Əv#s#vzŝuv9gǴvvsآ/1 b)-:0OU[zw|ny=sgOh*9l➓}_}吪}Y3w^v#{?mӇ͙zdzF9]c.{aE%Kwl h+*wu5Y뾽޸{<薑X}kmn?shw]uKnOw?caOt3㟝皞{^z_Yg}~o }sǿ+ޙnҩ/~JWpG_}?]jg'}޴kYc֖=믾˷W~^rgQPUE۠|q'[:`V[fE^b;5Ž#o7'=jCvucG>l/Z_#2谸\ R0=ɽ}D%5e|INPޫWg).;qK>?dC8l~<#lȏWN_Ѵye˧3G:w[>tl61A]Cǎ?vAp\|'/4ma㯎:O=OEg^ߝuwso> ^{K޿te/_~ŲE]eW/fŵ?aՍ_ܴ?ݒ?θ.;zq;~OV?&>^DÓmO\?? ǗzM|oGfOi#g@˼%W<,ʱ} _,0NSBǑ2@ Üu^\/a> >@X  .1k gp epP\BDBepDB L c8AY$ sLEȌ~#X$/ǿWy簛scXR&jiJ9xQd{"66 &\(}I=-$#"aMXP!c3Aa BBC3> TZtes >gy-LQ 1q3gR03\caOd^r!1iδc2K'1U |,C qCJp8LYd/B!Vb E!pGb(y`9# "4.j0B$g}9Ƈ=ܫ$2BcYJ_wmB't!05ĒFHF+84> b"x&h,0UQ s=+/bB cT&r4ˇaO`l}W*Iɜ9:#=@<z)ilPzE0\ pl!1󑎸Ql;$7 I2-9Ø.mԲƥ7f?F :j nhf_4/: /j~QIMx"(H00! 7/:WNllom[ȉ-ӑA6Y j%6A *I~D(ސE`Lt8Tah4(+ #}C<*k]S:dBn FIFPha!jD`dX45X"$E]t1N",d fV+Iڍ-DDxXP0%iaq@CR&8&&X"Pҁ'0LE"Ahl1CY cP+I.^Jm%Aaĭw0:$HTlm0Y#$]%]4 0IH,\dnl'#,R _Z]c} ˆ$5!&n-hKw]]x"+ҕbuep1Ft>@EAi$(+RAsMa:6naIWZ]mVFh$rI>ǬX]aVJ 3Ods8] O!AtR B8;6)d"0lҩviZi$X`j;Me;P.Vf9 Gu0Ս~H7'IW-`*AlH׬L9wq7,LNjRՕhҕI46i#vR-. +*ENAf-vPA8IצD :CIMcJ#Bl6$.¤tnaP S@2qgco۔yna8r`Du2IʼnnaZ5&] BP1!2tU9ݔ ";)"GnaxF8ȓKKīyax AZC&f,Nsv3Ψ,z ҁk70(-!wpK2 ]w I70@SLG4*:0|7be;M9 n&uUHk(0-R]:fF z渃*tk(0&m)-!J ÀޅxٖkqݔF@)397q Ƅ7%US@5Ť9]BD)Tm"jj8T EaCN&Ff ʭ!@A)Lir)C[o"0x3IT/Da4- &fߌ-FEaD8L%(&EaXI9x8 挹ěuna=3.GFsqۨ0H[70BROmr3gdr*2 89_tx}8 fAEcuAVd4U9s#!na6Rz8ݔ`2snzaNrda.*P(q(1wpQD$8L"S( छr(D)sQcKGAB]Dna,$Dΐ P9"ݔD&3cZ@b"{3r y݌Dfza2L=#HfQT/na"M!k709ո-70Ec("bM9LdҮ rm8L?w< !Qa"D8p]Qa0؅D1Kq$tb{p-y\)17L8bq0AEna"mqBE1qЅBKna5%1BF RN{(0MNΨI2F9@QPk殜)1!q3a>Az ͞tS4LK!ʼqabs~`!ak!T:ݔLTB6v]1w0gSt< P3cR,a<-8L, '%hEq4Mt809!$kZAСS;JqiOS%3br86'qPQ}Q"ݔ&ǑkIc8 2t);5 80b C"0D"tZC_ mItSc?D]D(~rqX#t 䳌 J*ؖݦ80xjѠIi Airsb%Øe6Q!<)3P3qZqn,$AˌÀ2rҨq\fFJ(wVM9d2`!OMq87r <"z IٛqHs>Z0H70>wӂ& ˌØ}/66^Qxda$足4-sriuS#zCR?M9 vK3;h[݌è MrqA\'ׂ scS1;cd:ݔ(B%<⤛r${Lge.e q͐Zjj>J|ReF2;*' M92G4x8V7B'sOqlݳ|e݆A"ihE9)8yD|.;8aS] H70:9K#t݌`ҙ`}Py8Fr6naGU@ʩhzZm{ c%)n.@:?J:1E`3B_[4 D{5ش(x8 *Kޤ9tә8?ps!6'tS\ w^fd:0=ØM.N53cr6ata ( _rX41-n1^n٧wfw=%inmroNVo p]뭸Q:pq5`gmH39T^躄/|6ץt=w^Hq-!k_gm}߶0kfpmo67 A./|K@`Wi7̷ۛ@f\'`{_z}^N?~ڳ9m^jy cpOM {xɷǴz2+o/* *z\ bΛWUxϼS$qg CVI7)'{ &WBfZof& o5f/"cߑ|#NixVjvFҒx#H)ZcvWmԖ[E6Of&-k=*M/ 4ed17{x@uX)}caϱ,zc :?tҢOmh<̆pd̝I'>l=.W&Mh#qfCfҔk3?CvUmN5XhխlH:1OcH%F=G+f̯InG6+ kJ"+S ͬVSI?S^c^w2ffO׮&n;ixa춫9oЅ;5%v4QOӁS035YռYՔ~gUY#lؾz"FՌq81=ƷܓOօ=f]ԏLz2OnC% ͖$D,`WQy4fǠ&nI:"g91w{[1scT s޺ pHYs   IDATxyGu~Y5m}Œe-68$6@&77MnO &,7HM!lWlY6FHI?KwUTUw3#c694Owuuws~wNUCG:ґt#HG:ґt#HG:ґt#HG:ґt#HG:ґt#HG:ґt#HG:ґt#HG:ґt#HG:ґt#HG:ґt#HG:ґt#HG:ґt#HG:ґ']݁|yO%%B!V#F5I'ou_et#SiED=7 Y{{v/X&,5Q35ejYƀ9n{L:YSM=ԑ'_:H#"J/C Y1cAtc8 & 9y@dYY !+ˡĠg'Mc:9[K}iĎ<1rIƾcwқ%zA&I'rW1&遲wQ" ٽŘ1N EVY{zyR)7y/lzI(c ED)T?-KW~$&ZVVĽƤvc oi7 jiF^Lu{K~42`GE?uBv6c&1Y-z7|SկgtJOT~ac ㇊m; Ƹˎa5"'x!TV͢e[Ztm@|ɓn~zvJ-ld@5vecW]L$A|4Gt|ޮN3e+Srh hEP^4&~myO|)yI5~ϭ:1vOXh@pg1"ot@`ŋG_z|jj3g_u+~0Ʌ5v]0d+3wzv+Xd摂WExolkҥou'Q5Wэ5`qKʛ6/< a1ʡEO/.48giDih Jw%7~ nSG粫=*oZk=ʹs~J%.]… B`14''=|/\t t9ws-d(*?kt2Ñ7u  E}]y?ԑ'Q7O !Df X+ׯvYV fɡC񿔒!Qic̑U:D :AC0gmP AWo ;84cCCc+k/R}迖} {lBZȟR"  R[^յ;hŊt022Ge|PVYf ju6 N>$Gmo{V3^.d.5yOÜnp=o#=a?!)~JaJ!pǚBߋ2т *Ƅ,,aܟmH$<ןW!obDeh4IYz[i+g/Vv ExK\;r)BxBJ"(Q$i .gOa+br̿s=M%/%$& QN:mXtU4:zWa:蛐_MǮh;Ɲ7տ.P0ks7V,~m ()w EŪIY7.nߨ9m3͟{#&e%Air='D:/ `r|MOt/]J z+rZ//m6>iHӔÇ3==m;,K.esPBZO6O|'~}W"Qu_Lk`sL1|p?3!Xv'.!##am>V|/ .f϶xOrLC(OОn;g;0_<$"&0XDih% KwKKn8{qw#*loG)4b!<7/SVezzzk_Zk\wu/F)͛9|02.qzRĚ5k.Z29%d\[_r s{+uFJGƿ hc;v56x=}(zZ1aիLÚ5k8닔k+&$2qth_}Z9Ϛ=ѿww&ED>šLNZllqL2{\1m^yΌP)C3gA("!0D}Gn=}99[6gR"D#D=lnx(T*۷/S!^GOO7n _J)zzzx^OI$z^XLQ RlA1>]>tk;>iwnuy{rKzfo?CBѥӧNr!J)Wjlv˯lSvi< *b`4<e b$re*ܵZ$]{Vfyr]WQ\5²N5 ~g>wַZ-R9r#GP*keŊH)~BpM7k.z9rNt^z_@+Qv !m=B)F1Q)FBJd{907gc_5cO;'? O0) A 3hBJR1-]ǺoT˽f",m dl+9!CTV 7<LG\wmH"5AiR !ՆTiuwLLM顫 Ri͛Z3::ʹs^O|iZ֭>N(ŒŋٯW\ѭ(`,5ZSISTbRe)ŖS/<~ ]Omt>қLIJr'U/΂@=Ig"vEr.KR*;9}w9G BZAD@dFta"vmG8_ "BH{8l >cS~Hy Ǐ$C&9j~j␎\\0-9!˄/ YȰ7y˦Bp}1<<1e˖n:j===TU* > ###!زe 7|3SSS l2>L}iٶfʔ*)QDG8"s$ dGzh›ozϵN>P|7=bO +(| M[,X ;oҽ#P!ϑB Ab;ih#'C%~啄y>ehHޝȮ ~O#^.׭ϹW.W:@  o<==Mdll(ZsUW!̲ZGra,^W,_!CCC:ul)G)2.qLPbi8F)&*!]8F A3{w/E׾󶋽jvxn}$_~BiL~ *?v[!J tc ٨E70CwO1l6*fR2wAomA!p[EW)ψ=O(- Z||^vbB.l{S⡷t0)$[~ٴ}s9Bog߾}i˹Kh6$IR1ٓ\zTU*r5=UIL@#+5tjkF($x ;bPDEE"@J*G^7j0/~Oz355ydL-$7xg$/,?o|1pt '޾A6 ׺ @KϟE0 8'#x0ٞmw1*hWs_]dYoQc7bG}(c{8>cF(ڡxddj֚uR\veTUǩT*DQ>~=5j!&[:fbݢh͢[ (^%xbqe?G>p-?)si4=/n}}io^~ϕWȒNatV^ &X FRz&-LMKV{.܄UŅqR_?(ȇAJ7d#|2?.;{> n*KaEp7; ^Lhlk++4Xϭ#sI y*ϴqPugϞ--_>Ve*Z.z{{9}4V*]]]LLLp)j3Vƴ)s,jcLjHf15F,k`\-S'~bkW3gLF?~irV{=_d$oeXBz|gc `bM#}w3{l6~8l'l"בE)oFƖ8D d) r27;Λ߼CpA_DtuW`Z#։1,爙$G 믽{+(W^ɧ8uir 7PT00>>ΩS>G̼___VwUWYOg&Ѝ=Q HWz*Qh)E>qUWl6al[@OC7fi cf' /t1k佈"dQW,?`lQoAɬ~f0\iLN3{|v\F<=%8%iYHe-/Jآ%2e88g bnF%"- :R*.{CWCkVB'Y/~ʇzX'76p~n0YsBS[õaB]qϯIG+j v-th6Z-de,YBVcxx(+J` &mb\Fԕd65}i(B74jQJ#^yH 60mj3xo?77y4OZeC#Duc=n)|k 2YJ0̫gȠDY!P}Qfɲ5|.٬gAښvapnYrĀ…!4$f!}6,YA|H8Gap$ a<3p<9:ŒiyI6͋.fEwY?e_LldN>u/~;rfff(TU֭[ǒ%KXr%ݬ] n8kocD̢=-Dqy{tt+E7 J3g٬Npx2NW2+z,#04Ԁea0Szxpȸ1{@+Ie%B2(ŀaCu},"X\K`)ʜϽ_>|G@6)pJrFHWP aQoN|>wAA}{-!' 1y=~"N~y/u#1Կ%//];Zsln1Pӓ)eÇi6T*֮]KСa@p?N\s5 Q.;%'PiHZI"20'dJZsvES*I*%>3tQ)}bZ f"(D d!q,dlvRzqV}wxHNDh&ma dU =߶[+HSS9(c7v[zwwΰ]ݷB Qƅ!ɑMNdcvMu8$lQ/3ӑL.{[5z6u?}Kw׿u,YK/p췾u7 .gffYY a{ Tc 4@K?9ífP?7t3(۾^rݰ0n D\B*Z7c lXa.GJFG;U ORetbK^C7Ux=|=qn脭Aݬg&LFY93/gQ;fp?b)Xq5S]RЛJl>?Q&-X< vPT<9G { ;v^Њ(%ڻ{mɠ c°`bZОӇ)X2$ &<'[ɻyFo| ߀JmΥV'ϳ{8&hm@;;{1Uo#]ÂBF<0<ƁIV/-mmCܵ4'&8((LҴ5g%>(1&7\XL1P@ d}3ޫ\l(ƽaǖȸؾytu25qyk+iyI9Dp`TB&ߗpbhShAQh;-iƿ^3Sny;ֿI}.ESEQj~4`"e Kdb ؼvpAt3w"$#c|=?15pk4 LPIUu 3<%MT^zC+<І4/g6d r1l% R,議tI$|䋏rwN0>0YOxFJ nNϰYc}=峙*'`d"Y'Ty˥@\;ޣ%31Khx6l#"Ny;qWkj+XJ}&r=2*(j”e>= A!B*ØP_i c#<,w}r޽~)\ln:VZmR6[|iZ81x# hb:&mNJ+|wTYldۚGUn g^}R`=r)B!8̓ GX  (ZCٓ,?I\hc={f%9o#*r WH fcfA$kW) C5 !k!OU׾3|Sj|~qѸ>3rqF/_ 'chHz)L2I~1 CcB_W} cɂ*7^ j>|c`x5ٺjG'Yێi\AVc@KVO9썀8^_iqG6m=g$VYu^ّ`2rk|- Bb8H,޶8Gq|$iR*UXz}Ksxw7ofҥ Uy쇐ؘ;}PKJ.˗ 5I[l5 F_}Ny.G[)/05 7J>GKs+rD0TKVrɥv,B X9sAuz/8ɕ$T~{' _CbG{neي<&;Glb㮷QZ\Aً^uՀtЎ%U۾bJ4@P1*:cE۱\Q]=!d#5zzǻGF\uV-)}e^P#Lu#19HiĴf0:F%@>H8=>ڥ}CpS\y)w^¿}0M~6j%&g,._%!2VcR,L'mŠ A?xE6ѭpe| {XC'' V$՚ Z- R2BQ"+]OrcInpULn/0LM6gM:9\gӃs*UD .$"$b,HJV Gaۿb_a;g0G <( ,*~:{=y~/syQI: "CTԁʺ_ g!p=Bȸm ej$|}k>iNDH-!B>KvC&$@A=oV Ҍs*ȞDE I3k&=GF>8bmT6?\jg 8`y#-$<_Ucݜ$-H[yhf)]S~)?{Vn#y˵Y?4ʗ?ۮ\$ @$Q,ne^tJ[pM0l>vʤh$+n !|y.g Al #z.p~tu/`[Dzy9!0S@=MLA9Lh%sUMCV7<a˥kqYׁnqNscgNS:Ăp&9iDP)e>9ɭ?[e\a+ãd ]I)`B`dcD.MpTJS2vG IҽđU4l =k.De-5:0څ(Y 3%Ȍt s\{Iǭ@$XrVo3Q|{14?@1s,R:)i)幉6QZ(-8n_[Y(~41>2{Pl`p,mUw$<3٠+>jV vLRzf(;4,qY4KHټNV[0F{av$9i,88b}R`+Kr]*A1eg۱!gkȈG[p0#~j7wĂ=5W87of}m۶! B4mQC 뗪~3[( 8}OlyJz I04pp ٱL ZS btnR>pnf)w8u6!;fE4 .$kٶAO1Q1N%83cTP,ʝUE/,9-W&|CxEMr"3 +Ȕj1|AϞ`f|+qm ]T4yh}"ixkO\3FykT2$*}cgggTSײ 9n]%aDž|w(Wi9;g{}X*ƐI9~40"+VΗ{WrT`2vHOĆ>Ld|š12Wmy %TPە2 }2gs.CB( `KK ⯋vcuӻOsO< @d:F>=|[y䃤iJ$hILmdA<#!B8yT_Κ%gэYH;| PR~KKJrQqԬm+R-h!J@7y֩̎t֞+;Y|]CaP@y ~O)ρW]D)#2z} aOշyFƑڦUىգVc$I*!M5ZAֶ}}'@nȍAF$M!`R9Qm it24*MχܱBL$Q Q`jc3v%1A /V agNӯRTr,#Os'@r\)kx0G9x!H)YjVnqDX.>(ra֠-,~IⒸTC+ش޽@3: ˜wNW 3{nⱑ;h6fQID)$Ai__0w<P֡Ŕ$nfޚ o^ց:24-Ih@+`$t+Zfwr(@5`hIoSV3B0"TڶՇ;heK}:ކ 2eÕR q@|N\d\}z$Ӈm^?LidYvK8l@R Dr24b~keʟ6<.#_f&GIVBhPirƍ4B؛Le FQiLn_M]y>QU~N^U"זLB}ptV+ajNl&عCaP+DoӮ|cȗ#P"27qC&Jo;_|*(5 Be/ !4@Y;yRP]uY[(➟mqO| @ތ#]}(-QiҚ4U(J*ESHS1hAS ZH1 B(0¯)_z) j"PyA!xdv'ts6SЬ5/xL_0W@{ F,ڼKGE&:эeffLN3l*+pvi@,:-u7 ڴ\@/!x Ն^i9<ӣ,\ - :' 8? ̷h"Ǐ.\ r k_Snx/Y6h#*%hRhIuVm4:TLQBcQ+k qm ۇB|SQL%עjإ, ap*Q lfVc2LMh5@PMM},C}Yh_ h_ypա0WvR3@*>%)De F&e{iϦX8^u{m"܀ QM hBv t?uG//H8m&߬'V5Me뵉1ƠhaZ+6hѩFaQrISRA׈iؐ@04cICPAy.$KwJy B0:m"R6ڧ|Bп#} XR"呙%D>S\"Fb$fbJfbaD!X$2 P7@y,Ȯ-=$Qe6<P d) #*kS+!B½s؎7wAaa{uchPP1}FO\?.yR @{#L"5=`I7㧱_!ke-Xek2J`JQڡUxX^@FB* hY+xknm,E60gI$n dӌrt)&^DwojJTPHddz (^Onzg\!O k 8$!Xq cRI|*1 F-g퍇K]]ǎcMLc'q< d¹yQd Zt7DT{_eXI3ށQjZ'$WCӘ E#!#,0"#0*APi!T$G FcT!c<*0rT :^%˖U۠ <2Cl'N'э ľ@q@ *%nj*jJ%&.(v,PZ(Mih6[Sme=jþBP!,q2hü8fNBVKð#$=Rrrg xI oAŗ>.j0+( 3O;D/xsV s'?9Ƿ41*Fp]Ώ+O4l?GȟSEu6'+ZjgA4*Ȋ-bWZ7Xβ IDAT8`VpS:E]^e3MjbBAہI{/Z2cBd]1j1C:dEf jLˣD>* r$)cjt^s^WL$gfyQ71MF£ltYۜg]a};"  aBPӪm GNg4޵\N|诽!o5zktF(^ѣAڧً:rS~iocba :H[+KjWTQAjjY%׶X6-!nam4KlfIyoc WXGY Y&vC0W} ⮣ede^**R8(EXBdgȾDa @i4[i9̵ȿgU~' `7_Ȥ81_1u`4﷟cP48|gZ bî?kK^لo΀/}Dž\6=z>!7"[O@ByYYnZ2]Fcl͝WƥB\rҩE FWv("EGؼX^8PjckaL} lKI#RLUe2~tjo/Tz(W)1q)&P.IH)1–D7P4s칳2Lm (>d,3~]@IX9k 6y`7gIHgl1So"&Ύ2<|V ^ЦqnC9O@BzDpmEM "0):0F&w}j\C=VDM`E1ZQ*\YYg_&̫x npEa6~hJl&@%( h g+Ae )̌V e qUP*2RZO՞~^*BIE"[ fK3LlqeӦa݅<&x;yhǁUB`{Ц >Mr"et+G#n?3'D GM/b?}D"0a> | `(LaIc}lWpDMۛv\} w~AQ)y";.DzK<ĶlQ<'Rr8I%Q%XqdURRXq-;mMDILH$ޝs{^ ]{9ַ54q׾{/Nk.u??fm0``b~-G*D7̳@o ldAZҐ;M2!B$6 rAR6\^rI?v9 5zy/prrR:}Lx򫽌";Qdc Ts9.V2JY3 ȼ`ߟ8cw4/η~Mכg&-w?Bg>~D"m"ICNl0[]g6_c̦-h\i IJ/;z_Bx.K!yьf5ZE2~}Q[7@iF/WZW_Ϋ_&OvEP͡›.@""y *3z+1r+FA#Wq]L.T'US}<|qu'oXbg x\rI$%,Qq+)!CR̵DRAБ$(a~ ҇0- (0Х ټW|12>O[xiOX"Hm L[h t|eld$4} ] x8pwo*aLYTUe>iL"X(reezO^QKl*='K^x9rct JA:&Tjŗܥ&vmH! G7Hs 3t?>w&j{m=9h2ʔJř\YIqhYuM&הH))urbV tJv0dAO% sw"1`@ o[_ѴM޽<[G'9ˮtC7D&mmـ͔|lΤ3iB&(OGђJKH]M۵-H&'A(%A";7__&l6mlj_C/h,G0~{?wR|6uۤ='?#u1:zO?>7X_|4/=}92['8ˀ((e|q1؂hhZ'6sZY9ys Z9o!iO嵀wMg[D6Xikh`g8X yB#:k`|\!:)nK=C_.H&*iuE\· QC.KgFinBK2}%#{ TFk[J+B3AB&VWr*'Xk׊ʯ^u?眯FrkrsYв:.a81~ό^GOѫz'JSu; sI9? gz&H5'JǷԡ`"Ťu A& ő8, U!I]N?.iCKQGN޺Őᭃ ya\=rAY. CP)%xhC 0iM!L39ɄiK3/rttoݬe}>J\*2kqLl^CqH6b yڦKHq⒚dtQ7Rr"ۯ4,]W"Xݾ/}Ӷz仹-ٗd-6Ÿ *B!<:GM&W߿t_|oݼ#-8h"춣HR:%d4a(yHq _Z)C@֟8D68o>#Z+ xw8?!|,-q G,O9Xo[h' I>MCzqAzGw Ȕw \`ట0h/$D>ȕ\lUkG|zGek~bŅp*/K{eD 9fЄh̹vn!o<ٸ.v+^/}WXls0o *SܱsCDw).S)G~GIqX[MS\9JZ UG*yQ1ԟ @Q#h{)#]H%I1vEʅH%9(H>#M8g0 닞901ľt ݲ,OOe>w"|hH DS;f!cww|'~'V).N2YƧkΙHAM/!:'Eh5W 3.BPvO=Dcw/~%ˎoywqה@t5rsKY p.+7fs"py? 0G;ɷMoEԂT>^N_qD 9_ܐQ#3 8_6kTEQX ;k^/\݀msJsF>[ {u );M64KN )={6 ҇h#`R*4".]gee< xkg^[(dla& U)K趩{’jB Ztb@TpoA618tWc7gƯq!٥/n_%(AQO֥ 7{-"^μ'@8w8?zJY#L \֪9R}0|Pb:l u}>jlyhydd8$.@D)p,#)f2Ѕ"Mq Y=!4d|'B L$nw''mЀ|&BN /.B_!We}y|c7ociVVVL&4MCTG9fiOD~N! =T% S{ {cCyXgsccx_ 6=V|wF^_:Fav!\{gđⰯI} C?}~ /=~z8=ۤBpYoZBS!AR̈́gD4Po4oP6X&IueSJ*8N&|1d%s\pC^"VEMA*LȒN7jǭ?CDLLM-+u8B(A h痟>`0נ%_=]m"%{=PZx (46 0bU!X oQAFOyO&k׶{ۯGYۼk(.E d8<υ5e]r, ^y֯~paB jh UX®,n<,@S0ޑg$ R@rą(>Ѿ|)+9%, PC6L%w|.%\x+ k RʿahbOh"C$ ms+|hLMNXYzDq.p}C|Ĺ.xɕCu3(7X.lob{;6$wg.@ErڏFA;!%_nqȊ78 (-@$~Y4S΄eb~DM. 8s/m‹pttȓQ|N Dr$@Pzfb* v]X};w2s34졂?; [* h?0ZpMP^A ϱ(F?D$ tSJTg V#火&vbōpdsYn({A?!q՛\[圾,=nCtH1$AL99ϐ<['\MsVV2 8LX.,K{;ᵱ >W R'a>l*D EnkP`YA]w>{ v1]<|Dm; 6pppz#n0[%ub;4@6 z`H-ur4˿>?N5Xf{H2Q~j6Iؗ8kE=ak̿(JFlB:}/Za1 D1n r_qS,!H7VS_ˌ}TVr)+$m|C*$:Yp>(a}\jPPC3=18+<B13]d:Ɍ$rRUղ3t/j6i4MuMQ:_.Vbx@l|(eIE"(Cw=)&AseS^z6;\ro:g/\V!2xTY|&[n[y4ti&*xBXnˍV&S6RMx9˂Op9˽Y.Zfl?-OwCO%Ex2:J&UT T\)>>7$7h!"GL#r q1|~&/.DnX2 ]N&Ba#H@פ*B(W_R8~M{ KR0%yBm&y(_'IJyʸ=eCӁېsMAHԦV9+1SpLq#bP|Q}p[G-J"=çJZ:T|0VuXo\A zϪWʐ|jʻ^y6Ꞌ쳁up]n:๧7?>osoĩЪ9#T#5a8eqzEt;zP^S'K3`4>wW(It~NB$ZJ\v$,c,\ÛfZ&B3EUPbʹV Õ#'%\d3%R _yKA҄|C}mvA IDAT$ Kb p!=6R>r@& ҅ߊ̋Rs lJu!K]q풮wy^mYY)O]"̢\HEȺԙEODײrJ &2IC ݉c蟠)cW_fO}~{;}F,/*d@[E,qaFv rec&KHai)S.ŮFyV!m&#" >&9X܁rO=U@e>" Hyp9 RTfIۃ$[K=1%|ؒ|Gl H4ð$H:fZ|~)V"Fʆlڿo2ˡY?}2ΐ= ˚GvNQ qϧX(욾,hԟ"Pc-Ğ9]^|_rmT𩋡~XzX$ux|cyQ9`"؛RCQE-c]T6ZR˗( ^$%> N+>ZQℝ8|ZȻҠ$IM9%!ӡ%I 5xWyn>U(e&?C1$E?ކt?z8%aI{Y}s ה4LDa DոC|'qKd\+_\=:[s^Op]C oX\}ӫt 7^jUʻ G^>sC 4ҿb'+`Hk6R$P2I8ѱ83HnY?[)QѠ ;[~F (Bh ʹTN̈́rlitNV!BJv-!#\(ҌEcⶉ f2ԟ>dᏅw0\FZƧ$,%Z Ŧ&p0o=#( &)i`-k(kXӉo[ߢ 7^?sʿK o؍$>My{/V M+SXa@4 ߔ4L\@9!AI=qUm|X+o ω*;,>b*\3ˣ?pT)FY%5TbBl Af}kȻ\ i 4$ }3) ^\ Z%y3L=a ,OvY3pZH4 GAx& O+Ӳ&|')qrF*EY e$Ȇ-P FXtktrguekʣ３[3sG<+%+ O/ϓDܽWH5.Z5@abY78?q%fд(E{&P420]j%Zj qfn p]Z3'Xh(3bQGSˆspfV%7VV*")Ydz'dt^Ɨuny5K#)Q}P}Zx$Xy+!X*3TSjDK ~BכSyťl8@\ l1i۷o/7Obz sh' Ye6ǎH3N;i)"jR՗ tuK΀(=E|N}aeRL٦;s\Bښϗ(Ő) l GslK([ \s( oHU^ ދ@"h-eԅ͗y Z֬;GDKDd`?g;)vuPd)s(nFg0(V-7+ : 0FJ筠SZ;pʜ~?`e>ep) vxWnp{\ ~XlHK I͢J 8PTl:846^XWTIv唄0f"q+?$՗ 'J*`af/k%EKdaYd> qUһ˂`/ŝTy2[H*Ro]K&]@]&/ iD,zn1z0fB,su[E#RՖw2w߱JJvӷ؝G> s*dSMU AФ6P<:[WT,&aC}TT%`g-G8 ćTwc]τX1ol<'fV!sGо*NCn(E[c*V Ēz)V C '0٢}^(΄e]$M;E kqԜ N wkO3de |]qKOv_ؗ+;cFPXvAu<98A@zn}Կ(GRD3-id]MYMP + li2LJ>]C= :Z@R ;#B(j aX,r |  (m$^!ER`DʸGaXigЀ#)B9ԄN6p#2Cc#>rrPL99*|uvĨn+, TAYբ8i$՛_WWxWXpz`XH<v|Gg)صt-!?9wc6=I[Joe5GYf[]8rSo j*htMS2M#pM6ڜҸPCVN\<(Fx]}һ#*abbQD4D"+y}fek ,ԕJuφtU؍ґU1[ΠceQRx l7N!pUڐ9ʩIT'BQ-ED~/x}.σ|b8z7^} +rWUv)ϒ ,5B &t+$uр{v8z\#~# i6j[cG/=;N3LMMr1J ["N r_'Cx sTw>Z {|f;! )F$cu+ 7!$cN gȚ΢(q$R",|ḀLv>K푯(IW L\+)_C^hJ9Q-zJB3u~Ɣիr〝焣7~}W9-urαNӴllKcmu}6sO~l-͆CzB"vrt&OiNvp<Nģϒ7"J׉!aإy5]y9:\*(CKLπ*r(ʜI^W;Ie4 xM6#%*?e< f]X2/__ʕp&x~ZqdC0=Dg0&X/wQUQ4Rі0tyQ?W&jqS\9r;IӼv g2ñrؤ;vuGȍ#qXMgH5M" ' PT6GƕL? }d X-LA|4IN)6w'~y7hk>8W~ 0I*)45݃KK8ݤlfA}2@R^װhyMQ=/c'ZB;qRP,u a\ڤ'!F>Uȡ[7!f.;^?A^xs|_P9AloqN۶eeeNft]~O@"O7D\b"a~;6hsS\zI$ Ȣ,|g'qIRՊ)r(]z8KF&Mc)5wAP\ɳi).RQ{_P|Z^y).уOAKʸH)k_F賒7 :Zǒ^Ϻ1PȲHi;)`2nH֪+󳬟Sp(/RIbTde:~*Vkóc}`c9vwn5X][gowsl6c(!|giJŧ&̡D`/)?"+1l'm|w4ɵrz߿/OoPm&O&xl8j 57z=q)VB(,Ē(,.'-GN=/* &l6D3/UP3D䴥d~Zc Y5/, 'P+촓("Se{D9蔘(U}BtrYŽpg䚟7;!Qeո6Rs7_xع}wkmpxхY[[LT!+m vԲ`Ӹ$G.AJ^E$'o~OV?ăIA61L4Z(m  3dD$;SbhYI8q* X*h7?_XTHEBS䒭c=EU "n}hp?*,KE.Vc<~޼y2ۄv@YK4}Qr=]į[yIаu8 oK޳q{U {ti=6;5n.3{MqI⇓>kİN~~_썔j\s~]|/{x,'^Ol8kI!%̦@+ VO(nQE[0 .!+*[`uTN;o(.("RZ[}k_'~لxԒ:\Iks(IUiHgƘH%|s"@ NJ-aAVP!9=a#Y{ f( gU| w1 \(*o^+1k ֽg2ar$>5|%Ep-{e|!ղ%uG-a|GfEh$aJ,nn'r~lG֯, (GO XyAckkj [Q ۫i'ln^c<`w1B1Fv!U4 VyV\k;82m:$<[ta˾ ɝe|X2L<ĕ>m3~%X׫~Y7jp |wDi,gFˁ.Dj `Ʃv*S6_)">R+A2)ɣ,CHȠ4} -t'k# !as@{Hb;pKè[lt) vE !.@g'{(]sOLJxs_b:wnF|.2t*;;ۤX__[yԧf~l h8Q$P7 +$V ;Ha;N аpI*<`t""&b IDATtڹRUQ UЗf^7"b%PkrD$$!4)ʣ0,cv6 p%//(4=ZV*FЅPZe35a Dݍ铍Tsb OD/ 2N'*!e(#Ϧ0*}G<~Y ٠V՗?Eiͫ,N9:ܽ=MӲy[pxw!2X]]c:kW._f8_Y'8Ir,%\$%@kaЙ8On8V&ڍ{m2IRJ]ďm\tYX7,`Nl51L؄|m x3&9ݵnlUJ~RƗ+jhHNb}qF,5W %cORcLEq J)/ ]s8,'>r?Ą[J֊juD<(y PՆ01 6>̓2_=kWi7. 9X]`Bdcc#A deeM{ogᔎ9X0Sqn`\cCI ~~$t8!?s0jMMAu^pwwM 5.l,mPAbR1[C4$QrK*TaeZ-H4^dHB H>%VGt!"#7;kc qYFed Kkaz!8+Ec]* 4nB3 E@2 kUE);YDƯRAxg߂y :[۷_(ɌW` i.]BUB`>s||8F7 qB'Dt8yU }{'n8",o{}a;~ b?HVrf6e8$.._bE(V}M1n2lNEƏ<Ԓ d.ZԼM{.ଛ!-2fEB͟(=GFƂ~QBq } *`k (5¶:M2B?"zee̽l,V("n^%nMp^yjP܇J&asBƇ8<:O|އk8}„<h e gswWv%X.;#Ri8ӥ5H}Q|m1089'Ϻ8p6 <@8J\Ý;=-Y}w"?M:} )gbt1@ѦnRg@y_n,Byu+o(ﵰZSEB8PlyXސm/U6$RQKq$>Rጐd>6[l+> ,? %dJ[Nf %sdAJĚF5*ӯ4'?ܾ,]MV.qӓ} 9>@d&Sq9::m[6<+ٿ?ݶ4d `"nJ ͰK^3nލK&ɼ@JW`Xjh^Anr[<;i̼ "T?<%*tq',1(V jP.@2? eRFi*p2&rL&F&!BJqUyU.3)&9Ŧ2FL>cQۣ\# HIx{?F~uW*2_0akCnѐ|U8yrїO" ί෾y3??'Wh&ln0tAùxؼ7oҶ-{狀VVVNHn3s_5{yi OO~ ȼ9zItk4-\:7e&th/f7+8C\aTH-<-PBt}c0S~|vѴUBMBL9tXW*k[b =3`X ~eӐk]'WQIс|<ȍc1i\e J%FeRoKDyIYu(!N٧~/rrյW69{i V698l[o}_ڿ>cwuh}0jr&.-ih맑[2L XE@C~_dfK>fwqRWģzRAnVXtX'_/zFw~E/@P̨n I36>v*?Ir8h ,DP}jV*(X]Qd.ĺКUߑMum4YP+)5AY|(Ba~y|ڸnr~[u9^/mgl\ý[BӲy-~Sdq ={"=[ Y]]{ﾵXs:lRwg`%hųcI;\gtx?>#,_"M{ m5 Gfz1|_u׉O z ”kчr*%F>jU|X )qX$hB߯!1ٌ_ZuQ Ԏ3e#p`hSg<brtت O=җAD&Rpa4Ȋ:ob52MB$3JjaICa VU ,̜9V7c MLumen"$Hh`/_&q˛eÊE8y6naq/qC0e&d6X_iQrj?$٦ۆ"4# gZk> F7=j@_߂\Roeh(VA"bdĊ 2&3Mv.+H2'\ _Ų^Xe^(ӕb\qhI[6̿64+܁&&sP"|KSXug/kwҴSvor!cmjF7:l''}d2teyw_ڥ'2'8s. S3ʁK B'62(oCEދ@]),nB oS\%d2mUw^[cpi iޚ*Cs7*~8}~uoqð$>1\ڞafUB&V͕jX.$!Φc7 ٙ(&JUa%&-| LѬ=\ehBa|C+HJtH){ēa8i8/sR y)bltW5Ee1mѮ}O6T(3]Sȯ%M;W2S1 Ӟ=,Nv9{вyp*D`Fh)_ 9J)z3d{%n BC>+ļl=|[OQ9K|:"MO=V.1;q45opmhVa .- CEhwQD}4gK Rw+F=rjgBUO|K( WRCy0Jsh>,_Q >*IU./FKao ZCD*|Ŭiץ*Kr+#E/P_y;l}'/|LD>V5|':_!{p|JhQfo6L=O:x swpfeacQSx T[\ޡp5&$%"Qhsğ 6%G R4fr7q[|s4j5-'F$*3oܥD"!Oωz3 TMV Rg>-e%KYtuMyҐ 3_a&9J 6wyH8o)c^ }hغ橾Wi) dtmoV|eݑK0NY-%l}>_k;@KNݜ&ȖF Wq!K84w2,o.Jcr V뤓 cd˱c *|7>X )Ճn4lyji[6Jr1ؓDiT6^}NR1Ir~A3XfOX"gh5+h/>vv>JrH*b]SCY$4ѠY;g｣->ޫ*{i`$ 0,ٖZBR´d KBB {IHha@f=3+鄽s_W30LkU{/~i\E#g[(o;:r!LVh/aν+|{[)UZ׈:jj}a6boXQo,3u-Dl:b4}y>F$ ->րO} MOLRr:@R&m\j(Q&u!7]cc@QBr_#O /r)k-^ ӱ hbP-andèd40hbGkn,% ZhiF,*>'-o"}EV˴R$ZK # -bR4Wؚu\ R}jĜ$4+]V,D)MjKZٿSPڝH:DkCM? 6 +4SЊXh5BS)½2p7ѹssoBs*4V4;Iӈ&&mH1MZ*[jR Yh,--qwmkg]y)4*+w?j\1#AHWmf{8xj wN"@{o)"V<YH1pHtQE2$;T?܀yP,[;"MYfaVh3^b"/IwK-OS HRm%i 6 #,XЙ)gTeST2B)* JN%GxH '\BE ^rDv/LDAb6HAE;QpgDuBN$Bi갎߸IOp_7CJ} LFIT[1b4X[&&.bT`XZl6߻P~HL QBZ6Yg)D#oFR鱄2ܳ-88j@۩S-XD 'L悂a|V6D쿃q+Ov>2nUkY9;(Dhm lxشcwPh.J"d| TAh0i-k &bk|=ç蒶n˳B90FYo 8U\ !Eb2neV(eY_^EIӯxǣ^|k78Ԛ52PA 7ehiARo4{餼w֌乗O}";_-|3%eC/<&mCB_HouN*N^0Q! !%{Y`8}*.24siT d#ɥysU0)fa!1Pk, EB>C;ToQHG(8(B %,\Ȓ*5ȊT7l=!cj´RIJ\0N@HtQT4?ac*! ,8dA¬YmaQ-CǩBԟ{^K%/@N.M%Dјa&P_F{2MK7p\~wm@P5#pI޺y_tQ'O,*͊$IJaN4qӻ8jqTTm 'Hm½d f?`q'[GT$"w*8tmLU3^m/Om\Ot>LV"O>[Oby= lY@cR|4['jI]XCwĵuvB@tS*&Ed,AY.tKđ@*P*B%3#TW׫t:o 81 WgdeYRm+]VdOf!pk8gڿb:7%//d9K wěX-σtwSˠTiϠdzpכL'#F!Q"xZdG_>5Q^(NXy^86`J" Ś>u/RC@8X2.(\ &V IDATvg ZoNi7Nrp9:c>:e ~gH]2A7W1Q "̴(PBXmc]&꟱Ub2 4;e~?1s9FzilVdaT XCe##`Ҕh}tr>'LMD뿻%1>XE6bpqCܹ݊PoZʠ{mp(UZԛ; n3.VbAXtc4elm'&]WWUJߔlI@~4IMN_ HSk[׀]NxdmR IAjpD[pһ8rqnS ![̯n{jP:e(ހ,(\>Jgi?W ǵ~L慅7\a驿_A5{C؝ EAFs`4[I&Gd,N&ٱv#/ZG O! _9R ,7i!uIA:'hR"MTQ~H{ 2knz>7 qrZ <I}  h?2mO526l5k!aXPR*M4{RIS%.=FPnWYQL+R>ɾk6n?hv޿.3'J=mTd]e;a|;A(HxJь)~pD.q r s5đ8PFa>.ŀDciiN \[ qm&Am\aнC޾23uޗO;Ǽ߇v<\%]v-/%ᒺ[W${*N|EQv f ]$;*jz;G` rr5@|9AbZ ` eGO*5ֿD(AVA,kJebpy:5cv5}B B/3?~[]Y.0Hg 0ej6clp6V ͭof # L33bF4wzmz򹁉؟)@"2NY3]Zpv5w/Gc)5SwM+Jmj}A֦AXSone<,lCl2b4\_lN@I3u|˧".K<=UᑢJnŕ=BSAtRᔵ5f%+9!|i蝙q*G^ 9x sS?{qpkvv>?|Nһ\ TL),03AAHJ(*8nٖ٧Ȍ@I22:*o5 z͓U,)KFq))Ehf@(-Dd4@VN W`D<5 IYnS2[_(E4___E}i/m[_h2`2BK I@B2hXX H+i$xJHf?h/yba?Iqsm[[1<>s[PXL B(.#䢴+*؅]dq+|fWPk̹66/ԎfבeQxP:IM$C,?p _E(6'L :b}UjԤ :ȗ Fmn h> xYqoAQ)-TZH)QTXZ "z+T]{ؽ03CDvP.88q^b:M81ͮXk}ԖHi{PkҀKz[(Wwmj$;LǽsRzs QpqAV HwQ[>wzŔ4Sk]M,NX:'8C?xJTH9Ma8%':ogB~?=CT *r6r.N"تX(s@Vt?\dCxIѪ@7OOL ZKt-&B/M˼>E#f :j!`/ Zo|OJ[L䠼`Ht.+D7Y$P>nHMcC:|\5 ݫ5ZkSQ)Vf^@,I"HW2d*դ70"+|/d]p*(7 c"~0~0f6l\O#>a"})(i>T*si"I8T.xȭZrjJ>* pw|3u.|'<̮RmDɔEd:hDn7~$޳5w_wr͠{fJj}.M-L=FC۱[qFHw8|;<H@ c"𢤁?rdSRPO.o}m 8%Y2.N +[&$!>-(imyRI|)TvS?J7?27en*ƠgۤI[)'@t_oWVҪBD]ac0Dq,&0m!q[A61E7siYђE-zш#Uh9Ad7:BU}۞ o#NK!ԷS`нt=kأ*Zn2~@NnmbiWg#X>L7;. H[ݑa?'vVJyX鮠e}HAF!`^Q> -20$X^[d!v@8%֓?Ua,F'ks瓧tP_L[⸹D&U!)zma YAF;,NaF 5bAD/jK͟Ioik|pjk+_DS$T~$jAb:a' R8}h"_>vsᎾ&@W3lph'_*ilB 4 X.h Jj|zӔS>("GokVFN.Ȝ.ă3wQR\0րLQxGo gʡu 7xcc|\e"6Ԯ}|!_XV*FT>`:1pVm_A)u-h )Tvw"qtc80^w1HoJ`<&lC (׷R`~d=&DXYŰ{p34Z;Nh̠b;t'm(/Ѓ\. u/|jmD]B;p⛛*܏oCdHA@TBAMo+8GANIGoz*qJ'~'2ݏ"\:}$U[OpF8l 3,Fa5=G#EFvFocڧZ"(a2UɮOc/D@*MW`}A{ {05|xaZ :n!N_i. M& I$ة)aйMp5h.8_`4n۽%cvWA)(Nf ]2`'jr/(NiNI.8 sOyV琣̺oL37 GXy%^s22~E/ or !?~W0[j6<_ʬ\psfBBsԼJ>mm|&M LQm ϒ#}+ NJ &n\Ba*qg^?rНaF{!mFiSk?򩵏,< '=)?Du MIAu(K Ђ[9EO/v/nA_G6(&}JW\q^o Ƒ?@}|kCy\koPIpsU1ւإ6*=n!*R rJ-&(K]h,`62_&5RLJԗ&Ho((A L«02m0+l!Qe4+mSLÍ|D*qNҎ7Qe @ FfE8s#k3tg~4Mq"U";(FCƽ/2#E  ;H §ޏC2He~,!*]2܄ٗ6*%zm-zp!~Ǘ\@ >'"wNy9 azva._mB .N(NtT|spqH!p_'m^5V.}x.q3 zu7a噟&n: nb,a5)]c@lmYwU؞{zyMC1/0L 0o^?EkTv !.F)BΡKP^a~d5ATIad-B0PkaؿZ is!AI. =7[{bz&Bʔ~'/rrvP4(;,@h4!D|xR,+*D#_֤ dq_x-x-'mϠ)IU8D~huP `9p;jW%\*?AN}ج`lq~m)Vgs2SfK\haQ/\8g6P9ܹ2\2|/lR_zޥ-MԖDCƽ /n  /dT`kWb~zda_Pi /E9 Ĝ&Ֆto0 wbxZd_bzv<OQ2cw>|5~osRP0_F܄V>-$xI/,SM~dxxֽpC$KDWȘAVϑN3L;I/P qɺ`HfѪ-0t;ܜL%`TsmC$9Via]LWHTȕ$ɬk/,xTpӨ45.2YiJPm\ɨw(wLQ9yf֩03̲ BsiUC}{75q ϗp|Y D(D/mro Q9эHnHA54gC2~)p'ෟ }dq Q񪇘Яq^|Qeqm*40iӼ/U}V8H}'FaaVh68J' IDAT lilPʛ}lnNnx{7 !fkL:vc0sRJ0%:j/E&$[|81\&{K~P0\ M`1Rk6$Wp[RAsh] ޽6I=K~Ǘ)@ԎC9HF߁tQpFTÅ6'UHAq˻ON eq+@:D4 N&\ 2}'QڇwFlB 88Cѻ&vpJxHG )hp Kn W>։?Z0 gU ?*ev BJi'뤃Õa{n0m[-եionfe@k T@pkᷞsWX;ot2\=+S_>L#F3c.*8ϰs: }3ukgȄ. D\N\BQJP&Y6w1f<JJ8g}0 ݄~W @ h1 DU ѻ,;%^9) T (\ƣD$(7dt~y'oOi=/t>B _pfUZH:Y\0b!留Vt߫>FzލΙZ/ZRmau'{D9H5v}Ltzܞ %*Ld{:UCԠ sx%mSF˺| (ZkD8$ı.)>p8{?Rzv<VVNy>^ [F6I:.CsmI'5)h?ֈD)3fk(`YlBӒl(pK;h=&F2jz,xdmќ`u cUĭf 7yY/7 {݆sZ)p2bFg9!d2փ:RiiY[8CruA.bA^%8PogܿlT{C9˧?`_+V@ ~4v` YA *Ť ǫ=ߘ4)8niWN w~!1'4)hjGZO>C"3h,E&1Ү̭Džs|j.BWh!v[)|Èp'n(rrDh`+nqʦ o/p"pp 5[&\zV}Kxo=ncqV n[p즆=O.&!2wX 8DoLo1azW}|6m*Ʒz"p:$QIXUZ0JIg4Ahfs~/d~V[0#܍6vG h"!v3\&Qgs,n4*D{xAwCB:x(ehN rQ Q8xjG",$jMQU2w݄K#X+KϒNo^svQ"\z8~-[2Eʱp-c?JIdc{L:o L~^/>ȃiŧ<wF#\,ha$P[I&9!Ay+^+LRT0^! dk/Rk#4 HӞW\=r~W @ѥDrv9:âo㷞AFwH@ ^@3uWs2nٝA.9 O~ @į$C<: @]sn $V.ɬCOFE*^ya{ _Xۃ_E4L4 M9 0\ ^jI4b?Tq,*r?\jk?2#&BJs@}/d$T2x~W)ãvv0ŭC[t`RW;S=H{9]^%]<`Djz7JQB ۈ{oL_ 4TckbdM@(*;'/(5u"M%/@8am #3Nk;(Wv3uTn1ĜuC?lPkc6^c< \pc}*k دU+  4 zȈ}4Hm z%'$WwG8-mcz7 7U0[&BjGp*,jLl|`8Ƈy|{.Jϒ$|03CLW e`+( 7lRiiдw _> ꛥA =9GɣڋvG ]޹R*6ڜ=+~Whkm+~^g6'UiRP*{ ϑ &ɢ`[N $ -q´ī-BFk$KS> p!J̷=k4p ~e­OngA7j(JLzT>A\pT2*p:{[%u3aMVvPdܻlٖh+KTZohY3׃6 Yl} /+gG9:O`3RP48>B5)Y`ڇтV%h=WlC׏u_%_ 6`4ZGFduWS~LMr/hMHgkF ;*"N>fD[鬋{$.I 6%/5&ʍUFs$Qڳ?APJQ ]$ sDwykN@ thu^e!A&=4L{!=W7-)Q$*{LZlG8!8~/k P2FSd4cX]ѻ qYv)lp.AirD!`7L;p\p Ad:eԽLtcWI`SlDm rʻ5)hxzsRPiAJ[^"%Z&P@7>|gW&*627}LɛʔGA$ ?6UZNs$貂֜ p)MF3MEtPPT2'vQ$yh:x~״?mxh O &q㋫ 8^e/߻)踦d|qxLjohO_t|dt1K}!#zܿ}(d}u.U+@R9]L{g&y;"+tp@(5 8D4 ] Fud`)Q.p3, o7l|]qr@@)?6`9vC 9)(X&\ k|А~>gnhc.nU>xtg 6$5MBEIWށWމR16iS\)V Hf}sYp !D}&3H7§:ㄌ =yQ[H؋6uφ`0y\l?6@_@ 6c8._qL7%&h=I}dxzpiYMZ ǫUwJiAd<`yOJaҁnP[xA oP$tnlzq^&u>/&\zxIUa{z\2;>'@8iP2Fɘ4*B)5-9IЬi i)-)GVN̺FWa}'*޹ 3jkUfÛ qY{7;sZwо _v|]|aD;D)W5?L*\!\)mN r8fk@4#gkD7g >aŠ]1)=r @*q2Y-ʭ&w2V~R(22N@HSpBʭ`}O u\;V=w|]|ho|OW{q'-=O: @T=n? h?0{p8neQ瓤Z p ^uNL:F2{..bC.v oWv+hhtx֥X7B0(5 1] egjC}hrhp3b/Sn%Mƌ{2@ջ{yw gE%Qd+NvZ6-EEEP @/wIv!N,$ҴڴEi;X%Ғp}}]|޹CޢCbw˙/Ug;B`n9uY@TM>GMA/u/4M>OZo@]>SrHu`+ƣҹն,dnoUBEu$an@kG(iHz;Pk& No4a3Ȏ64^in,A;8yٗG>ȂE07sl( R7E27۬cDyT* KәI柚k.՟&Z' ؑ-!$ƊA榛s9Ba%,\$Zlr}eyt[g 4#_;Ս]XAoW|1*-sObnEgG&>y gq*G,6g)hq֯m:^#lo @ez:&7c39Vl4@xGpǎ0\2 |NIvAw~r:E]sJk~ŌA]@]$}FDkdҞҝ~+8~$`ۖl/n8J9D7-Jїuf&)0G>Gt_Q?2~I[qMAGq > 4#;6'/T|}[Aᖐpm>x6[k"^A8hDV `qvqnh\8q Vs4 zR s}3h3;| |U= T@ED 8㙣C"y噙ی'sǟ% p;(+-,hY&c: l\!jJ|iRx8ܠ>N]}yGv_\rpH6>Oi[eroYsOU_Y>n8;ޕP mIފkW!_%\ʍGGXxc*SZo=7U7#jHpmF@?[;25\@5>5CKL#,/qѸmjEO-])t.DMӎ0b*' t.Gs >g Aқ T@]o5ѼpF* M~7OvjK)ĩBY>Q2` FG|;r8I>t%X ,tlNߏ_;$;htm~v~.I znE90s?ØS/v\6^)4/v4Qvٔ&[3*@&FGiŲ=3ܪ@)8hĽk$ $z1߃_!/o})q~T<Мz^KJ6 HD^l<7t& rϑDk'w 쒙 Qv)7XvGo~{qنIDATTXT°5)_AYitd6ïު}Aϫ"yHE֚5@:s*jO ol! {2 Io1,N9K_{O]*3ވ0g]F* zG`@:~\YpǏn\$Z?A\%ep+Eb+>;Vkc=?AB.en(CSZm*=S9։6 w `\oYY5@N:JtAx\wW7Qzv!v1KLyL]_Ƕ[MV?O *@Br|ObrLă6"8X_kW/EC@* >lRppaS%: :uJA\bYe,$IFzW}N]*3 "Hxm%FN|$[slcpjUX;aʅ`y;PA¼ y^1f²d;W^[{/22f.X ՘ǧ{`qg>Xj\sG|tNcJ{?$ÅT;esc>TwZCgvYi;\]uX 6m_ymG  9i ,35 ܄$%LG""=Cmh? on$mN '@.%瘋_ym)i8Ɩ4Ə6׼ޟHj *@0I-+                    ?_kIENDB`tomboy-ng_0.39-1/glyphs/icons/hicolor/22x22/0000755000175000017500000000000014551457644020276 5ustar dbannondbannontomboy-ng_0.39-1/glyphs/icons/hicolor/22x22/apps/0000755000175000017500000000000014551457644021241 5ustar dbannondbannontomboy-ng_0.39-1/glyphs/icons/hicolor/22x22/apps/tomboy-ng.png0000644000175000017500000002757714551457644023704 0ustar dbannondbannonPNG  IHDRĴl;iTXtXML:com.adobe.xmp Y%%iCCPxypd_sRGB default i1 DisplayPro, ColorMunki Display _[2018-11-14_18 35]x| |En䂈CAɵ אf# *n1$ $ 23:ㆢ>:긏Ό "2#n(﫮S`IUN:ۚڻz>vix!ޮhlS\SS%? st+6涷B~f"?[pf|'~t7vOzK[:\R^_yzOڱ'?/efeFܶn5K[5.tutVΝ}t TEaXP<:u7[˫&y<Z^7k .^ux / ^% jhPyZR^_"/52̓W7uY:sVw/linimSR\̇ow\VRY|ZgnwK_>??٠-+&tt 8/-d}7kgVb߸}}z{oWv׫v=yoMA4s%Ia7 1]=}k^~/ݫWGszs>=7}P{3O]gE}+k7culvf (*~]n~߱ggs~nAo؀ 8u[[ŚAG za˽}N/jVg3dPo识ohܵm 1.~0cDX_,Y: j ޿QcG}.ͻ'cv؉}{71>:Xʖ+¨5*'(G~!{ ػ>/W? ޾/kz] n77o};[|sП=裏/~O_%]/^^mo<_/jY~yՊcV^ѣ|+ל~-֯˒r2٘~]3ecPEяXndbp={z{#޾uN8dAi{Y'UL.-gu@X1U[WUv'K^z.>薃ov!za~4}ٍL?KZq̻g=;'۟dSs9οvqs;-=>8q/?:Ӆ9S<},urgת=}_r궵'=]ۧ{_})oqW\?D4fS;`Əv#s#vzŝuv9gǴvvsآ/1 b)-:0OU[zw|ny=sgOh*9l➓}_}吪}Y3w^v#{?mӇ͙zdzF9]c.{aE%Kwl h+*wu5Y뾽޸{<薑X}kmn?shw]uKnOw?caOt3㟝皞{^z_Yg}~o }sǿ+ޙnҩ/~JWpG_}?]jg'}޴kYc֖=믾˷W~^rgQPUE۠|q'[:`V[fE^b;5Ž#o7'=jCvucG>l/Z_#2谸\ R0=ɽ}D%5e|INPޫWg).;qK>?dC8l~<#lȏWN_Ѵye˧3G:w[>tl61A]Cǎ?vAp\|'/4ma㯎:O=OEg^ߝuwso> ^{K޿te/_~ŲE]eW/fŵ?aՍ_ܴ?ݒ?θ.;zq;~OV?&>^DÓmO\?? ǗzM|oGfOi#g@˼%W<,ʱ} _,0NSBǑ2@ Üu^\/a> >@X  .1k gp epP\BDBepDB L c8AY$ sLEȌ~#X$/ǿWy簛scXR&jiJ9xQd{"66 &\(}I=-$#"aMXP!c3Aa BBC3> TZtes >gy-LQ 1q3gR03\caOd^r!1iδc2K'1U |,C qCJp8LYd/B!Vb E!pGb(y`9# "4.j0B$g}9Ƈ=ܫ$2BcYJ_wmB't!05ĒFHF+84> b"x&h,0UQ s=+/bB cT&r4ˇaO`l}W*Iɜ9:#=@<z)ilPzE0\ pl!1󑎸Ql;$7 I2-9Ø.mԲƥ7f?F :j nhf_4/: /j~QIMx"(H00! 7/:WNllom[ȉ-ӑA6Y j%6A *I~D(ސE`Lt8Tah4(+ #}C<*k]S:dBn FIFPha!jD`dX45X"$E]t1N",d fV+Iڍ-DDxXP0%iaq@CR&8&&X"Pҁ'0LE"Ahl1CY cP+I.^Jm%Aaĭw0:$HTlm0Y#$]%]4 0IH,\dnl'#,R _Z]c} ˆ$5!&n-hKw]]x"+ҕbuep1Ft>@EAi$(+RAsMa:6naIWZ]mVFh$rI>ǬX]aVJ 3Ods8] O!AtR B8;6)d"0lҩviZi$X`j;Me;P.Vf9 Gu0Ս~H7'IW-`*AlH׬L9wq7,LNjRՕhҕI46i#vR-. +*ENAf-vPA8IצD :CIMcJ#Bl6$.¤tnaP S@2qgco۔yna8r`Du2IʼnnaZ5&] BP1!2tU9ݔ ";)"GnaxF8ȓKKīyax AZC&f,Nsv3Ψ,z ҁk70(-!wpK2 ]w I70@SLG4*:0|7be;M9 n&uUHk(0-R]:fF z渃*tk(0&m)-!J ÀޅxٖkqݔF@)397q Ƅ7%US@5Ť9]BD)Tm"jj8T EaCN&Ff ʭ!@A)Lir)C[o"0x3IT/Da4- &fߌ-FEaD8L%(&EaXI9x8 挹ěuna=3.GFsqۨ0H[70BROmr3gdr*2 89_tx}8 fAEcuAVd4U9s#!na6Rz8ݔ`2snzaNrda.*P(q(1wpQD$8L"S( छr(D)sQcKGAB]Dna,$Dΐ P9"ݔD&3cZ@b"{3r y݌Dfza2L=#HfQT/na"M!k709ո-70Ec("bM9LdҮ rm8L?w< !Qa"D8p]Qa0؅D1Kq$tb{p-y\)17L8bq0AEna"mqBE1qЅBKna5%1BF RN{(0MNΨI2F9@QPk殜)1!q3a>Az ͞tS4LK!ʼqabs~`!ak!T:ݔLTB6v]1w0gSt< P3cR,a<-8L, '%hEq4Mt809!$kZAСS;JqiOS%3br86'qPQ}Q"ݔ&ǑkIc8 2t);5 80b C"0D"tZC_ mItSc?D]D(~rqX#t 䳌 J*ؖݦ80xjѠIi Airsb%Øe6Q!<)3P3qZqn,$AˌÀ2rҨq\fFJ(wVM9d2`!OMq87r <"z IٛqHs>Z0H70>wӂ& ˌØ}/66^Qxda$足4-sriuS#zCR?M9 vK3;h[݌è MrqA\'ׂ scS1;cd:ݔ(B%<⤛r${Lge.e q͐Zjj>J|ReF2;*' M92G4x8V7B'sOqlݳ|e݆A"ihE9)8yD|.;8aS] H70:9K#t݌`ҙ`}Py8Fr6naGU@ʩhzZm{ c%)n.@:?J:1E`3B_[4 D{5ش(x8 *Kޤ9tә8?ps!6'tS\ w^fd:0=ØM.N53cr6ata ( _rX41-n1^n٧wfw=%inmroNVo p]뭸Q:pq5`gmH39T^躄/|6ץt=w^Hq-!k_gm}߶0kfpmo67 A./|K@`Wi7̷ۛ@f\'`{_z}^N?~ڳ9m^jy cpOM {xɷǴz2+o/* *z\ bΛWUxϼS$qg CVI7)'{ &WBfZof& o5f/"cߑ|#NixVjvFҒx#H)ZcvWmԖ[E6Of&-k=*M/ 4ed17{x@uX)}caϱ,zc :?tҢOmh<̆pd̝I'>l=.W&Mh#qfCfҔk3?CvUmN5XhխlH:1OcH%F=G+f̯InG6+ kJ"+S ͬVSI?S^c^w2ffO׮&n;ixa춫9oЅ;5%v4QOӁS035YռYՔ~gUY#lؾz"FՌq81=ƷܓOօ=f]ԏLz2OnC% ͖$D,`WQy4fǠ&nI:"g91w{[1scT s޺ pHYs%%IR$KIDAT8ՔKlTUtBKQ`7aA"+MB1FavhyQQ@c̝{E+!h>80Ԗ|ՑG788w[i>[pr?.N?UPXu8s,Η՟75> B-%7(*S}w)Q\M&[!ĦV6oJX_xNpxݜk^Ņ6raHFk'S?% N6A-O~B~ı@dW-EiMN$1RHadf6KfP&̶<ӚVz-WRq~AR#q!3.,lbmxgF!l|Mz=qQ>fǝa"ՒZBF`tݨV]= ؘV-ƸtKjzJ/D #0CyK1zИʁ@x{J&"MCp2.:w.x!BFX|h5x^$ͳhz$bpdbkgΒINӀ@J>8s 9zŗSv04xJybNo8)@8C5 &M&8`I.#qsc\M5,!8F2%UG*Y հNM?+CrBl5E`+Baz{zR2PhґS72֚$Whh/߳VMjP '@ueFiV[#)mBvjy՟>dmSn&s]]*t=%6}v̟ L JܚBuJX] oOɁo=J[<ӿB98 F/V[)r}ˈSPes%K;Nk5lWBĞp$oݹZcWᦥzW~kg7 fZI?M# Fo"xyV-$@HZq?ZlBcg?ҸA$L#$$ PBcWbg:tzs\t1BП 3N[w*_{GG8_ySw$ZHH&t؀׻q_e82dҥ^oj/wQU<5=?s"+Rm+ NKi/6zͻ %z{׫ONn--*!~$qA4=}4޹?Ik;; *-ctW'{~8>r=}Aw#W=׼bpy4Jd۟UnCZdԃ+IENDB`tomboy-ng_0.39-1/glyphs/icons/hicolor/16x16/0000755000175000017500000000000014551457644020304 5ustar dbannondbannontomboy-ng_0.39-1/glyphs/icons/hicolor/16x16/apps/0000755000175000017500000000000014551457644021247 5ustar dbannondbannontomboy-ng_0.39-1/glyphs/icons/hicolor/16x16/apps/tomboy-ng.png0000644000175000017500000002675214551457644023704 0ustar dbannondbannonPNG  IHDRaiTXtXML:com.adobe.xmp 0K%iCCPxypd_sRGB default i1 DisplayPro, ColorMunki Display _[2018-11-14_18 35]x| |En䂈CAɵ אf# *n1$ $ 23:ㆢ>:긏Ό "2#n(﫮S`IUN:ۚڻz>vix!ޮhlS\SS%? st+6涷B~f"?[pf|'~t7vOzK[:\R^_yzOڱ'?/efeFܶn5K[5.tutVΝ}t TEaXP<:u7[˫&y<Z^7k .^ux / ^% jhPyZR^_"/52̓W7uY:sVw/linimSR\̇ow\VRY|ZgnwK_>??٠-+&tt 8/-d}7kgVb߸}}z{oWv׫v=yoMA4s%Ia7 1]=}k^~/ݫWGszs>=7}P{3O]gE}+k7culvf (*~]n~߱ggs~nAo؀ 8u[[ŚAG za˽}N/jVg3dPo识ohܵm 1.~0cDX_,Y: j ޿QcG}.ͻ'cv؉}{71>:Xʖ+¨5*'(G~!{ ػ>/W? ޾/kz] n77o};[|sП=裏/~O_%]/^^mo<_/jY~yՊcV^ѣ|+ל~-֯˒r2٘~]3ecPEяXndbp={z{#޾uN8dAi{Y'UL.-gu@X1U[WUv'K^z.>薃ov!za~4}ٍL?KZq̻g=;'۟dSs9οvqs;-=>8q/?:Ӆ9S<},urgת=}_r궵'=]ۧ{_})oqW\?D4fS;`Əv#s#vzŝuv9gǴvvsآ/1 b)-:0OU[zw|ny=sgOh*9l➓}_}吪}Y3w^v#{?mӇ͙zdzF9]c.{aE%Kwl h+*wu5Y뾽޸{<薑X}kmn?shw]uKnOw?caOt3㟝皞{^z_Yg}~o }sǿ+ޙnҩ/~JWpG_}?]jg'}޴kYc֖=믾˷W~^rgQPUE۠|q'[:`V[fE^b;5Ž#o7'=jCvucG>l/Z_#2谸\ R0=ɽ}D%5e|INPޫWg).;qK>?dC8l~<#lȏWN_Ѵye˧3G:w[>tl61A]Cǎ?vAp\|'/4ma㯎:O=OEg^ߝuwso> ^{K޿te/_~ŲE]eW/fŵ?aՍ_ܴ?ݒ?θ.;zq;~OV?&>^DÓmO\?? ǗzM|oGfOi#g@˼%W<,ʱ} _,0NSBǑ2@ Üu^\/a> >@X  .1k gp epP\BDBepDB L c8AY$ sLEȌ~#X$/ǿWy簛scXR&jiJ9xQd{"66 &\(}I=-$#"aMXP!c3Aa BBC3> TZtes >gy-LQ 1q3gR03\caOd^r!1iδc2K'1U |,C qCJp8LYd/B!Vb E!pGb(y`9# "4.j0B$g}9Ƈ=ܫ$2BcYJ_wmB't!05ĒFHF+84> b"x&h,0UQ s=+/bB cT&r4ˇaO`l}W*Iɜ9:#=@<z)ilPzE0\ pl!1󑎸Ql;$7 I2-9Ø.mԲƥ7f?F :j nhf_4/: /j~QIMx"(H00! 7/:WNllom[ȉ-ӑA6Y j%6A *I~D(ސE`Lt8Tah4(+ #}C<*k]S:dBn FIFPha!jD`dX45X"$E]t1N",d fV+Iڍ-DDxXP0%iaq@CR&8&&X"Pҁ'0LE"Ahl1CY cP+I.^Jm%Aaĭw0:$HTlm0Y#$]%]4 0IH,\dnl'#,R _Z]c} ˆ$5!&n-hKw]]x"+ҕbuep1Ft>@EAi$(+RAsMa:6naIWZ]mVFh$rI>ǬX]aVJ 3Ods8] O!AtR B8;6)d"0lҩviZi$X`j;Me;P.Vf9 Gu0Ս~H7'IW-`*AlH׬L9wq7,LNjRՕhҕI46i#vR-. +*ENAf-vPA8IצD :CIMcJ#Bl6$.¤tnaP S@2qgco۔yna8r`Du2IʼnnaZ5&] BP1!2tU9ݔ ";)"GnaxF8ȓKKīyax AZC&f,Nsv3Ψ,z ҁk70(-!wpK2 ]w I70@SLG4*:0|7be;M9 n&uUHk(0-R]:fF z渃*tk(0&m)-!J ÀޅxٖkqݔF@)397q Ƅ7%US@5Ť9]BD)Tm"jj8T EaCN&Ff ʭ!@A)Lir)C[o"0x3IT/Da4- &fߌ-FEaD8L%(&EaXI9x8 挹ěuna=3.GFsqۨ0H[70BROmr3gdr*2 89_tx}8 fAEcuAVd4U9s#!na6Rz8ݔ`2snzaNrda.*P(q(1wpQD$8L"S( छr(D)sQcKGAB]Dna,$Dΐ P9"ݔD&3cZ@b"{3r y݌Dfza2L=#HfQT/na"M!k709ո-70Ec("bM9LdҮ rm8L?w< !Qa"D8p]Qa0؅D1Kq$tb{p-y\)17L8bq0AEna"mqBE1qЅBKna5%1BF RN{(0MNΨI2F9@QPk殜)1!q3a>Az ͞tS4LK!ʼqabs~`!ak!T:ݔLTB6v]1w0gSt< P3cR,a<-8L, '%hEq4Mt809!$kZAСS;JqiOS%3br86'qPQ}Q"ݔ&ǑkIc8 2t);5 80b C"0D"tZC_ mItSc?D]D(~rqX#t 䳌 J*ؖݦ80xjѠIi Airsb%Øe6Q!<)3P3qZqn,$AˌÀ2rҨq\fFJ(wVM9d2`!OMq87r <"z IٛqHs>Z0H70>wӂ& ˌØ}/66^Qxda$足4-sriuS#zCR?M9 vK3;h[݌è MrqA\'ׂ scS1;cd:ݔ(B%<⤛r${Lge.e q͐Zjj>J|ReF2;*' M92G4x8V7B'sOqlݳ|e݆A"ihE9)8yD|.;8aS] H70:9K#t݌`ҙ`}Py8Fr6naGU@ʩhzZm{ c%)n.@:?J:1E`3B_[4 D{5ش(x8 *Kޤ9tә8?ps!6'tS\ w^fd:0=ØM.N53cr6ata ( _rX41-n1^n٧wfw=%inmroNVo p]뭸Q:pq5`gmH39T^躄/|6ץt=w^Hq-!k_gm}߶0kfpmo67 A./|K@`Wi7̷ۛ@f\'`{_z}^N?~ڳ9m^jy cpOM {xɷǴz2+o/* *z\ bΛWUxϼS$qg CVI7)'{ &WBfZof& o5f/"cߑ|#NixVjvFҒx#H)ZcvWmԖ[E6Of&-k=*M/ 4ed17{x@uX)}caϱ,zc :?tҢOmh<̆pd̝I'>l=.W&Mh#qfCfҔk3?CvUmN5XhխlH:1OcH%F=G+f̯InG6+ kJ"+S ͬVSI?S^c^w2ffO׮&n;ixa춫9oЅ;5%v4QOӁS035YռYՔ~gUY#lؾz"FՌq81=ƷܓOօ=f]ԏLz2OnC% ͖$D,`WQy4fǠ&nI:"g91w{[1scT s޺ pHYs  IDAT8;hQϽw}>I4YE ""X`a b!&6(Zh `P$(qqlv73s*SCwwh':Ꭰpטni|xA ~F}͍+ƍWA7wh-}ӫU 3EdW%a/0mdZΜu+? treɽjM0A]jpk%c}&ui {kF!C*%`6t $k7IU:3q&@b.ƦZbSG[ar*2"޼ VzԽ%OZ۶3$dB1/$HUAr*T=clYt}3 '0M#y'䳚?fjlfY6B\0Dj-&@ Pi"n]kݙM6 c' l D`$I², >0~aY߭kga62CF?HBjI!&pF+rHP_J#GJV]l.4E PK۩T~#~<mK%[[)-n8;1+VFrq}v~)&b;o'}\#v^IENDB`tomboy-ng_0.39-1/glyphs/icons/hicolor/32x32/0000755000175000017500000000000014551457644020300 5ustar dbannondbannontomboy-ng_0.39-1/glyphs/icons/hicolor/32x32/apps/0000755000175000017500000000000014551457644021243 5ustar dbannondbannontomboy-ng_0.39-1/glyphs/icons/hicolor/32x32/apps/tomboy-ng.png0000644000175000017500000003127614551457644023675 0ustar dbannondbannonPNG  IHDR szziTXtXML:com.adobe.xmp I3O%iCCPxypd_sRGB default i1 DisplayPro, ColorMunki Display _[2018-11-14_18 35]x| |En䂈CAɵ אf# *n1$ $ 23:ㆢ>:긏Ό "2#n(﫮S`IUN:ۚڻz>vix!ޮhlS\SS%? st+6涷B~f"?[pf|'~t7vOzK[:\R^_yzOڱ'?/efeFܶn5K[5.tutVΝ}t TEaXP<:u7[˫&y<Z^7k .^ux / ^% jhPyZR^_"/52̓W7uY:sVw/linimSR\̇ow\VRY|ZgnwK_>??٠-+&tt 8/-d}7kgVb߸}}z{oWv׫v=yoMA4s%Ia7 1]=}k^~/ݫWGszs>=7}P{3O]gE}+k7culvf (*~]n~߱ggs~nAo؀ 8u[[ŚAG za˽}N/jVg3dPo识ohܵm 1.~0cDX_,Y: j ޿QcG}.ͻ'cv؉}{71>:Xʖ+¨5*'(G~!{ ػ>/W? ޾/kz] n77o};[|sП=裏/~O_%]/^^mo<_/jY~yՊcV^ѣ|+ל~-֯˒r2٘~]3ecPEяXndbp={z{#޾uN8dAi{Y'UL.-gu@X1U[WUv'K^z.>薃ov!za~4}ٍL?KZq̻g=;'۟dSs9οvqs;-=>8q/?:Ӆ9S<},urgת=}_r궵'=]ۧ{_})oqW\?D4fS;`Əv#s#vzŝuv9gǴvvsآ/1 b)-:0OU[zw|ny=sgOh*9l➓}_}吪}Y3w^v#{?mӇ͙zdzF9]c.{aE%Kwl h+*wu5Y뾽޸{<薑X}kmn?shw]uKnOw?caOt3㟝皞{^z_Yg}~o }sǿ+ޙnҩ/~JWpG_}?]jg'}޴kYc֖=믾˷W~^rgQPUE۠|q'[:`V[fE^b;5Ž#o7'=jCvucG>l/Z_#2谸\ R0=ɽ}D%5e|INPޫWg).;qK>?dC8l~<#lȏWN_Ѵye˧3G:w[>tl61A]Cǎ?vAp\|'/4ma㯎:O=OEg^ߝuwso> ^{K޿te/_~ŲE]eW/fŵ?aՍ_ܴ?ݒ?θ.;zq;~OV?&>^DÓmO\?? ǗzM|oGfOi#g@˼%W<,ʱ} _,0NSBǑ2@ Üu^\/a> >@X  .1k gp epP\BDBepDB L c8AY$ sLEȌ~#X$/ǿWy簛scXR&jiJ9xQd{"66 &\(}I=-$#"aMXP!c3Aa BBC3> TZtes >gy-LQ 1q3gR03\caOd^r!1iδc2K'1U |,C qCJp8LYd/B!Vb E!pGb(y`9# "4.j0B$g}9Ƈ=ܫ$2BcYJ_wmB't!05ĒFHF+84> b"x&h,0UQ s=+/bB cT&r4ˇaO`l}W*Iɜ9:#=@<z)ilPzE0\ pl!1󑎸Ql;$7 I2-9Ø.mԲƥ7f?F :j nhf_4/: /j~QIMx"(H00! 7/:WNllom[ȉ-ӑA6Y j%6A *I~D(ސE`Lt8Tah4(+ #}C<*k]S:dBn FIFPha!jD`dX45X"$E]t1N",d fV+Iڍ-DDxXP0%iaq@CR&8&&X"Pҁ'0LE"Ahl1CY cP+I.^Jm%Aaĭw0:$HTlm0Y#$]%]4 0IH,\dnl'#,R _Z]c} ˆ$5!&n-hKw]]x"+ҕbuep1Ft>@EAi$(+RAsMa:6naIWZ]mVFh$rI>ǬX]aVJ 3Ods8] O!AtR B8;6)d"0lҩviZi$X`j;Me;P.Vf9 Gu0Ս~H7'IW-`*AlH׬L9wq7,LNjRՕhҕI46i#vR-. +*ENAf-vPA8IצD :CIMcJ#Bl6$.¤tnaP S@2qgco۔yna8r`Du2IʼnnaZ5&] BP1!2tU9ݔ ";)"GnaxF8ȓKKīyax AZC&f,Nsv3Ψ,z ҁk70(-!wpK2 ]w I70@SLG4*:0|7be;M9 n&uUHk(0-R]:fF z渃*tk(0&m)-!J ÀޅxٖkqݔF@)397q Ƅ7%US@5Ť9]BD)Tm"jj8T EaCN&Ff ʭ!@A)Lir)C[o"0x3IT/Da4- &fߌ-FEaD8L%(&EaXI9x8 挹ěuna=3.GFsqۨ0H[70BROmr3gdr*2 89_tx}8 fAEcuAVd4U9s#!na6Rz8ݔ`2snzaNrda.*P(q(1wpQD$8L"S( छr(D)sQcKGAB]Dna,$Dΐ P9"ݔD&3cZ@b"{3r y݌Dfza2L=#HfQT/na"M!k709ո-70Ec("bM9LdҮ rm8L?w< !Qa"D8p]Qa0؅D1Kq$tb{p-y\)17L8bq0AEna"mqBE1qЅBKna5%1BF RN{(0MNΨI2F9@QPk殜)1!q3a>Az ͞tS4LK!ʼqabs~`!ak!T:ݔLTB6v]1w0gSt< P3cR,a<-8L, '%hEq4Mt809!$kZAСS;JqiOS%3br86'qPQ}Q"ݔ&ǑkIc8 2t);5 80b C"0D"tZC_ mItSc?D]D(~rqX#t 䳌 J*ؖݦ80xjѠIi Airsb%Øe6Q!<)3P3qZqn,$AˌÀ2rҨq\fFJ(wVM9d2`!OMq87r <"z IٛqHs>Z0H70>wӂ& ˌØ}/66^Qxda$足4-sriuS#zCR?M9 vK3;h[݌è MrqA\'ׂ scS1;cd:ݔ(B%<⤛r${Lge.e q͐Zjj>J|ReF2;*' M92G4x8V7B'sOqlݳ|e݆A"ihE9)8yD|.;8aS] H70:9K#t݌`ҙ`}Py8Fr6naGU@ʩhzZm{ c%)n.@:?J:1E`3B_[4 D{5ش(x8 *Kޤ9tә8?ps!6'tS\ w^fd:0=ØM.N53cr6ata ( _rX41-n1^n٧wfw=%inmroNVo p]뭸Q:pq5`gmH39T^躄/|6ץt=w^Hq-!k_gm}߶0kfpmo67 A./|K@`Wi7̷ۛ@f\'`{_z}^N?~ڳ9m^jy cpOM {xɷǴz2+o/* *z\ bΛWUxϼS$qg CVI7)'{ &WBfZof& o5f/"cߑ|#NixVjvFҒx#H)ZcvWmԖ[E6Of&-k=*M/ 4ed17{x@uX)}caϱ,zc :?tҢOmh<̆pd̝I'>l=.W&Mh#qfCfҔk3?CvUmN5XhխlH:1OcH%F=G+f̯InG6+ kJ"+S ͬVSI?S^c^w2ffO׮&n;ixa춫9oЅ;5%v4QOӁS035YռYՔ~gUY#lؾz"FՌq81=ƷܓOօ=f]ԏLz2OnC% ͖$D,`WQy4fǠ&nI:"g91w{[1scT s޺ pHYs%%IR$IDATXm\e/3v}e BhbSw &5H01aMlDk YbBBT&bQHLQTJܹ3s};] BA/wr39o*puO^{s}-Hg&?fS|[6ha6>bM#{ج~nkK=YMf~@vQE&pFxO7^eÛF;iMw{ß m\F]?m \'Leͥ <t׿GCm[ZAĊZK#{F3"eԒ$)xjJF*x}``ZS)3S\U> >b ` LUsEGjsS6h{fݐҌo^2`tSKSXMjb|0c<5agZ^.1 , EHSS^q#hy7?0`P^>LedQԁAPupY(/j0]uYn¶Ճn I1Jxhu+Ϋ4_}q_<+c9KAS2g8tdƩYQ|!=Dzؽ^/=7[)%Ԁ-'OHm>Y&d!6,91v;l1ϓ 1ԡ6bH J@Ր6=415~e|^eOcW]VyIl -d,Q5DԞ# 7 F4c~@?mь̂UkB3/_['S7T5j^}EGile.b|+13' \'o&R{g}}hް6]]-c染._hLxo,"pgX'htn/9_^NIENDB`tomboy-ng_0.39-1/glyphs/icons/hicolor/48x48/0000755000175000017500000000000014551457644020316 5ustar dbannondbannontomboy-ng_0.39-1/glyphs/icons/hicolor/48x48/apps/0000755000175000017500000000000014551457644021261 5ustar dbannondbannontomboy-ng_0.39-1/glyphs/icons/hicolor/48x48/apps/tomboy-ng.png0000644000175000017500000003447514551457644023717 0ustar dbannondbannonPNG  IHDR00WiTXtXML:com.adobe.xmp 7)%iCCPxypd_sRGB default i1 DisplayPro, ColorMunki Display _[2018-11-14_18 35]x| |En䂈CAɵ אf# *n1$ $ 23:ㆢ>:긏Ό "2#n(﫮S`IUN:ۚڻz>vix!ޮhlS\SS%? st+6涷B~f"?[pf|'~t7vOzK[:\R^_yzOڱ'?/efeFܶn5K[5.tutVΝ}t TEaXP<:u7[˫&y<Z^7k .^ux / ^% jhPyZR^_"/52̓W7uY:sVw/linimSR\̇ow\VRY|ZgnwK_>??٠-+&tt 8/-d}7kgVb߸}}z{oWv׫v=yoMA4s%Ia7 1]=}k^~/ݫWGszs>=7}P{3O]gE}+k7culvf (*~]n~߱ggs~nAo؀ 8u[[ŚAG za˽}N/jVg3dPo识ohܵm 1.~0cDX_,Y: j ޿QcG}.ͻ'cv؉}{71>:Xʖ+¨5*'(G~!{ ػ>/W? ޾/kz] n77o};[|sП=裏/~O_%]/^^mo<_/jY~yՊcV^ѣ|+ל~-֯˒r2٘~]3ecPEяXndbp={z{#޾uN8dAi{Y'UL.-gu@X1U[WUv'K^z.>薃ov!za~4}ٍL?KZq̻g=;'۟dSs9οvqs;-=>8q/?:Ӆ9S<},urgת=}_r궵'=]ۧ{_})oqW\?D4fS;`Əv#s#vzŝuv9gǴvvsآ/1 b)-:0OU[zw|ny=sgOh*9l➓}_}吪}Y3w^v#{?mӇ͙zdzF9]c.{aE%Kwl h+*wu5Y뾽޸{<薑X}kmn?shw]uKnOw?caOt3㟝皞{^z_Yg}~o }sǿ+ޙnҩ/~JWpG_}?]jg'}޴kYc֖=믾˷W~^rgQPUE۠|q'[:`V[fE^b;5Ž#o7'=jCvucG>l/Z_#2谸\ R0=ɽ}D%5e|INPޫWg).;qK>?dC8l~<#lȏWN_Ѵye˧3G:w[>tl61A]Cǎ?vAp\|'/4ma㯎:O=OEg^ߝuwso> ^{K޿te/_~ŲE]eW/fŵ?aՍ_ܴ?ݒ?θ.;zq;~OV?&>^DÓmO\?? ǗzM|oGfOi#g@˼%W<,ʱ} _,0NSBǑ2@ Üu^\/a> >@X  .1k gp epP\BDBepDB L c8AY$ sLEȌ~#X$/ǿWy簛scXR&jiJ9xQd{"66 &\(}I=-$#"aMXP!c3Aa BBC3> TZtes >gy-LQ 1q3gR03\caOd^r!1iδc2K'1U |,C qCJp8LYd/B!Vb E!pGb(y`9# "4.j0B$g}9Ƈ=ܫ$2BcYJ_wmB't!05ĒFHF+84> b"x&h,0UQ s=+/bB cT&r4ˇaO`l}W*Iɜ9:#=@<z)ilPzE0\ pl!1󑎸Ql;$7 I2-9Ø.mԲƥ7f?F :j nhf_4/: /j~QIMx"(H00! 7/:WNllom[ȉ-ӑA6Y j%6A *I~D(ސE`Lt8Tah4(+ #}C<*k]S:dBn FIFPha!jD`dX45X"$E]t1N",d fV+Iڍ-DDxXP0%iaq@CR&8&&X"Pҁ'0LE"Ahl1CY cP+I.^Jm%Aaĭw0:$HTlm0Y#$]%]4 0IH,\dnl'#,R _Z]c} ˆ$5!&n-hKw]]x"+ҕbuep1Ft>@EAi$(+RAsMa:6naIWZ]mVFh$rI>ǬX]aVJ 3Ods8] O!AtR B8;6)d"0lҩviZi$X`j;Me;P.Vf9 Gu0Ս~H7'IW-`*AlH׬L9wq7,LNjRՕhҕI46i#vR-. +*ENAf-vPA8IצD :CIMcJ#Bl6$.¤tnaP S@2qgco۔yna8r`Du2IʼnnaZ5&] BP1!2tU9ݔ ";)"GnaxF8ȓKKīyax AZC&f,Nsv3Ψ,z ҁk70(-!wpK2 ]w I70@SLG4*:0|7be;M9 n&uUHk(0-R]:fF z渃*tk(0&m)-!J ÀޅxٖkqݔF@)397q Ƅ7%US@5Ť9]BD)Tm"jj8T EaCN&Ff ʭ!@A)Lir)C[o"0x3IT/Da4- &fߌ-FEaD8L%(&EaXI9x8 挹ěuna=3.GFsqۨ0H[70BROmr3gdr*2 89_tx}8 fAEcuAVd4U9s#!na6Rz8ݔ`2snzaNrda.*P(q(1wpQD$8L"S( छr(D)sQcKGAB]Dna,$Dΐ P9"ݔD&3cZ@b"{3r y݌Dfza2L=#HfQT/na"M!k709ո-70Ec("bM9LdҮ rm8L?w< !Qa"D8p]Qa0؅D1Kq$tb{p-y\)17L8bq0AEna"mqBE1qЅBKna5%1BF RN{(0MNΨI2F9@QPk殜)1!q3a>Az ͞tS4LK!ʼqabs~`!ak!T:ݔLTB6v]1w0gSt< P3cR,a<-8L, '%hEq4Mt809!$kZAСS;JqiOS%3br86'qPQ}Q"ݔ&ǑkIc8 2t);5 80b C"0D"tZC_ mItSc?D]D(~rqX#t 䳌 J*ؖݦ80xjѠIi Airsb%Øe6Q!<)3P3qZqn,$AˌÀ2rҨq\fFJ(wVM9d2`!OMq87r <"z IٛqHs>Z0H70>wӂ& ˌØ}/66^Qxda$足4-sriuS#zCR?M9 vK3;h[݌è MrqA\'ׂ scS1;cd:ݔ(B%<⤛r${Lge.e q͐Zjj>J|ReF2;*' M92G4x8V7B'sOqlݳ|e݆A"ihE9)8yD|.;8aS] H70:9K#t݌`ҙ`}Py8Fr6naGU@ʩhzZm{ c%)n.@:?J:1E`3B_[4 D{5ش(x8 *Kޤ9tә8?ps!6'tS\ w^fd:0=ØM.N53cr6ata ( _rX41-n1^n٧wfw=%inmroNVo p]뭸Q:pq5`gmH39T^躄/|6ץt=w^Hq-!k_gm}߶0kfpmo67 A./|K@`Wi7̷ۛ@f\'`{_z}^N?~ڳ9m^jy cpOM {xɷǴz2+o/* *z\ bΛWUxϼS$qg CVI7)'{ &WBfZof& o5f/"cߑ|#NixVjvFҒx#H)ZcvWmԖ[E6Of&-k=*M/ 4ed17{x@uX)}caϱ,zc :?tҢOmh<̆pd̝I'>l=.W&Mh#qfCfҔk3?CvUmN5XhխlH:1OcH%F=G+f̯InG6+ kJ"+S ͬVSI?S^c^w2ffO׮&n;ixa춫9oЅ;5%v4QOӁS035YռYՔ~gUY#lؾz"FՌq81=ƷܓOօ=f]ԏLz2OnC% ͖$D,`WQy4fǠ&nI:"g91w{[1scT s޺ pHYs%%IR$ IDAThk]WuksglcĉcCw+J&5*DQhiIheBTL)T@@C"hK"$A<̝8W?s$j?4˽=_}^\/KySCie_qzˁHP?=ε1_RٵG8 ӹoµ^lfMbUH`>PzO^n@5WSw|Z{筷޺6rM;ծO@3@S'O͛S|[W|Qdvx=Y-uvpn6iKoi=y&n >˃ hRr0Dse,mUnc?ovN\XT̥sYF+·Ԧll|6[at˩5v9G}Vh8pwŻuy˫_]˒tfl߭A~C^{3tㄑ2QCw+>ݕֿ4!&nn:0"EEOkūo?6.BiWׅoi\of jm[r3ٶɦM*# ?Re`JVږ+hl[dP+g&{G?{ 'sv67̲L.rnaq1]0gdr=gm )TKgmnb2J'EiT]jLO=Թ8piT3:͚IVm%wmfۉGbʵ;8uA(X\Xڑ:/z~: /x' YAΝcMZ 0DP\^ +S4wؠPYݳtvdi=kkm.Ma@S-#jQp煰}~KLnjAUګ4wBqmd0KϚqz[ aޱ[l'}ֻ0O-$eܤ\!@HBkHhc[Yi\FXZx͵."2-XZ^Dm_:DL1;Ҽ\CڕwQk:l@3DTJFxBlfIӌ$MIc-[9>"IkC\:f4qJFƮ6#uO &<.Zl޳_Znj~C]]k}FG+~{5&F$"Ԅ eT ΃s:4!MzT|@%(KbqjM6 #Mu+HQJG.P%1~ћ0Ai6gDa{Ѽ|0 0$ < Bxzdg=xa~~ZƥP¼a?#đ?C> ")!!&$HvzQ>U!v1!`˜+Jt.A)ѬCTVe0Z " pf%T ƛu֖S?eb[ :HRAL1UrK~h_EPEL)o Se vJp <s8i,MlFFNV!Bg[=^2P4C}/P:,-blMgK:ДŨ:6*)d-_"9c( $yUgE 0611ф8Cy+DGMYMVg|#eO0gl7EBH a\׈*&"TΓ1s=OoCDYx^@ɺ'yGӞ턔w?{ԶڼqԂa7H!E$fUpVсSd;͊)]6poqXCH9v⽥*fA 4zQZ?NNw^EK¬e%ƃDTa Y9y[%لӧ\nT Z% ,/_B}jWٚ|( P5}(24eS :6iIn/8t1u%:1i!}jy * ?̞Ba]uuLuVa-)s"iC#"g1$k/_c]#F~ B}q\Rjl}p6ͭ{0S_rLu&zO#>As3<7آdrNy)k4"0#15"oƀixAPo-j;D-Dַ"KP3 Aa*Sx ;>Jap:#,wxiz|حs@k5;1g>(6% n8+y8E!C}~ POcv,l {יE]񽄥z>AcyKQ՜\ͅC]^~O|"^~>،'z$W jT_MQK /hS,uc`e:CmFJr7ObmZ$~Tt*]>r-,u9|ԁ+8fd'lWB bl?E2:wC\x+8kpSpB 簦jP8a wGr'C3:l6Kҷ\ۏo``T 1qc;z+|B`U:ŴsZW9szZN>]Yslڎ*y\yȯ aҦ wCzV U4XnIm2 =*Jݫ{uSr~hfg38כg^Os1ŘBR*Y4&Ixجhx6Qͯxz>[~#5o;4x\qgqi)U~WsD'(ؐI+8K6 xΣcRZ JwoR9ae?>}:C3j  T'o.ldx ἠޓZ=lYs{׮ݣO2?uP?ox. \ u`R=8Zs`|St|$3}_Y6k6q^\otAbx IENDB`tomboy-ng_0.39-1/glyphs/install.sh0000644000175000017500000000063314551457644016751 0ustar dbannondbannon#!/usr/bin/bash # A quick and dirty script playing with where icons go. # Definitly not for production use. APPNAME=tomboy-ng DEST=/usr/share/icons/hicolor for i in 16x16 22x22 24x24 32x32 48x48 256x256 ; do # for i in 256x256 ; do # mkdir -p "$DEST"/"$i"/apps/"$APPNAME" cp "$i.png" "$DEST/$i/apps/$APPNAME.png" echo "$DEST/$i/apps/$APPNAME.png" done; gtk-update-icon-cache -v /usr/share/icons/hicolor tomboy-ng_0.39-1/po/0000755000175000017500000000000014551457644014055 5ustar dbannondbannontomboy-ng_0.39-1/po/tomboy-ng.fr.po0000644000175000017500000013207614551457644016747 0ustar dbannondbannonmsgid "" msgstr "" "Content-Type: text/plain; charset=UTF-8\n" "Project-Id-Version: \n" "POT-Creation-Date: \n" "PO-Revision-Date: \n" "Last-Translator: \n" "Language-Team: \n" "MIME-Version: 1.0\n" "Content-Transfer-Encoding: 8bit\n" "Language: fr\n" "X-Generator: Poedit 2.0.6\n" #: editbox.rsunabletoevaluate msgid "Unable to find an expression to evaluate" msgstr "Impossible de trouver une expression à évaluer" #: fpttf.rsmissingfontfile #, object-pascal-format msgid "The font file <%s> can't be found." msgstr "" #: fpttf.rsnofontfilename msgid "The FileName property is empty, so we can't load font data." msgstr "" #: fpttf.rsnosearchpathdefined msgid "No search path was defined" msgstr "" #: fpttf.serrfontnotfound #, object-pascal-format msgid "The font <%s> can't be found" msgstr "" #: mainunit.rsabout msgid "tomboy-ng notes - cross platform, sync and manage notes." msgstr "tomboy-ng - prise de notes multiplateformes avec synchro" #: mainunit.rsaboutbdate msgid "Build date" msgstr "Compilé le" #: mainunit.rsaboutcpu msgid "TargetCPU" msgstr "CPUcible" #: mainunit.rsaboutoperatingsystem msgid "OS" msgstr "OS" #: mainunit.rsaboutver msgid "Version" msgstr "Version" #: mainunit.rsfailedtoindex msgid "Failed to index one or more notes." msgstr "Échec de l'indexation des notes." #: resourcestr.rsaddnotestonotebook msgid "Add notes to this Notebook" msgstr "Ajouter des notes au Carnet" #: resourcestr.rsalldone msgctxt "resourcestr.rsalldone" msgid "All Done" msgstr "Terminé" #: resourcestr.rsallrestored msgctxt "resourcestr.rsallrestored" msgid "Notes and config files Restored, restart suggested." msgstr "Notes et fichiers config rechargés, redémarrer svp." #: resourcestr.rsautosnapshotrun msgid "Completed autosnapshot run." msgstr "\"autosnapshot\" terminé." #: resourcestr.rsautosyncnotpossible msgid "Auto sync not possible right now" msgstr "Auto sync impossible pour l'instant" #: resourcestr.rsbadnotes #, object-pascal-format msgctxt "resourcestr.rsbadnotes" msgid "You have %d bad notes in Notes Directory" msgstr "Le répertoire contient %d notes vérolées" #: resourcestr.rsbadnotesfound1 msgctxt "resourcestr.rsbadnotesfound1" msgid "Please go to Settings -> Recover -> Recover Notes" msgstr "SVP utiliser Réglages -> Récup -> Récup des notes" #: resourcestr.rsbadnotesfound2 msgctxt "resourcestr.rsbadnotesfound2" msgid "You should do so to ensure your notes are safe." msgstr "Faites-le pour garantir des notes bien sauvegardées." #: resourcestr.rscannotdelete msgctxt "resourcestr.rscannotdelete" msgid "Cannot delete " msgstr "Suppression impossible " #: resourcestr.rscannotfindnote msgctxt "resourcestr.rscannotfindnote" msgid "ERROR, cannot find " msgstr "ERREUR, non trouvé " #: resourcestr.rschangenameofnotebook msgid "Change the name of this Notebook" msgstr "Change le nom du Carnet" #: resourcestr.rschangesync #, fuzzy #| msgid "Change Sync Repo" msgid "Change Sync Repository" msgstr "Changer le dépôt" #: resourcestr.rsclickbadnote msgctxt "resourcestr.rsclickbadnote" msgid "Double click on any Bad Notes" msgstr "Double-cliquer sur une note vérolée" #: resourcestr.rsclicksnapshot msgctxt "resourcestr.rsclicksnapshot" msgid "Click an Available Snapshot" msgstr "Sélectionner un Snapshot" #: resourcestr.rscontentdated msgid "Content Dated" msgstr "Contenu daté" #: resourcestr.rscopyfailed msgctxt "resourcestr.rscopyfailed" msgid "Copying orig to Backup directory failed" msgstr "Échec de la copie vers le répertoire de sauvegarde" #: resourcestr.rscreatenewrepo #, fuzzy #| msgid "Create a new Repo ?" msgctxt "resourcestr.rscreatenewrepo" msgid "Create a new Repository ?" msgstr "Créer un nouveau Dépôt ?" #: resourcestr.rsdeleteandreplace_1 msgctxt "resourcestr.rsdeleteandreplace_1" msgid "Notes at risk !" msgstr "Notes exposées !" #: resourcestr.rsdeleteandreplace_2 #, object-pascal-format msgctxt "resourcestr.rsdeleteandreplace_2" msgid "Delete all notes in %s and replace with snapshot dated %s ?" msgstr "Écraser toutes les notes de %s par le snapshot du %s ?" #: resourcestr.rsdeleteddamaged #, object-pascal-format msgid "OK, deleted %d damaged notes" msgstr "OK, %d carnets vérolés supprimés" #: resourcestr.rsdownloaded msgid "Downloaded" msgstr "Téléchargé" #: resourcestr.rsdownloadnotes msgid "Downloading notes" msgstr "Téléchargement des notes" #: resourcestr.rsenterhexvalue msgctxt "resourcestr.rsenterhexvalue" msgid "Enter the Hexadecimal value for a UTF8 character" msgstr "" #: resourcestr.rsenternewnotebook #, fuzzy #| msgid "Enter a new notebook name please" msgctxt "resourcestr.rsenternewnotebook" msgid "Enter a new Notebook name please" msgstr "Entrer un nom de carnet svp" #: resourcestr.rserrorcopyfile msgctxt "resourcestr.rserrorcopyfile" msgid "Failed to copy file, does destination dir exist ?" msgstr "Échec de la copie, répertoire inexistant ?" #: resourcestr.rsfilesyncinfo1 msgid "tomboy-ng uses File Sync to sync to eg DropBox, Google Drive, a USB drive" msgstr "tomboy-ng utilise File Sync pour se synchroniser avec Dropbox, Google Drive," #: resourcestr.rsfilesyncinfo2 #, fuzzy #| msgid "or use a remote server over the internet with sshfs" msgid "or uses a remote server over the internet with sshfs" msgstr "un disque externe ou encore un quelconque serveur distant avec sshfs" #: resourcestr.rsfindnavlefthint msgid "Backward Find : Shift-F3 or Shift-Ctrl-G" msgstr "Recherche arrière : Shift-F3 ou Shift-Ctrl-G" #: resourcestr.rsfindnavlefthintmac msgid "Backward Find : Shift-Command-G" msgstr "Recherche arrière : Shift-Command-G" #: resourcestr.rsfindnavrighthint msgid "Find : F3 or Ctrl-G" msgstr "Recherche : F3 or Ctrl-G" #: resourcestr.rsfindnavrighthintmac msgid "Find : Command-G" msgstr "Recherche : Command-G" #: resourcestr.rsfound msgctxt "resourcestr.rsfound" msgid "Found" msgstr "Trouvé" #: resourcestr.rsgithubsyncinfo1 msgid "tomboy-ng can use Github to both sync and display or edit notes" msgstr "tomboy peut utiliser Github pour sychroniser et afficher/editer les notes" #: resourcestr.rsgithubsyncinfo2 msgid "you should read the tomboy-ng wiki page for instructions." msgstr "Les instructions sont sur le wiki de tomboy-ng" #: resourcestr.rsgithubtokenexpired msgid "Github Token may have expired" msgstr "Le Token de Github est peut-être expiré" #: resourcestr.rshelpconfig msgctxt "resourcestr.rshelpconfig" msgid "Create or use an alternative config" msgstr "Créer ou utiliser une config alternative" #: resourcestr.rshelpdebug msgctxt "resourcestr.rshelpdebug" msgid "Direct debug output to SOME.LOG." msgstr "Debug direct dans SOME.LOG." #: resourcestr.rshelpdebugindex msgctxt "resourcestr.rshelpdebugindex" msgid "Show debug msgs while indexing notes" msgstr "Debug verbeux pour l'indexation" #: resourcestr.rshelpdebugspell msgctxt "resourcestr.rshelpdebugspell" msgid "Show debug messages while spell setup" msgstr "Debug verbeux pour la config de l'épellation" #: resourcestr.rshelpdebugsync msgctxt "resourcestr.rshelpdebugsync" msgid "Show debug messages during Sync" msgstr "Mode verbeux pour la synchro" #: resourcestr.rshelpdelay msgctxt "resourcestr.rshelpdelay" msgid "Delay startup 2 sec to allow OS to settle" msgstr "2 sec. de pause pour que l'OS s'installe" #: resourcestr.rshelphelp msgctxt "resourcestr.rshelphelp" msgid "Show this help message and exit." msgstr "Afficher ce message d'aide et quitter." #: resourcestr.rshelpimportfile #, fuzzy #| msgid "Import file into Note Repo" msgid "Import file into Note Directory" msgstr "Impor d'un fichier dans le Repo Note" #: resourcestr.rshelplang #, fuzzy #| msgid "Force Language, supported en, es, nl" msgctxt "resourcestr.rshelplang" msgid "Force Language, en, es, uk, fr, nl" msgstr "Choix de la langue (en, es, fr, nl)" #: resourcestr.rshelpnosplash #, fuzzy #| msgid "Dont show small status/splash window" msgctxt "resourcestr.rshelpnosplash" msgid "Do not show small status/splash window" msgstr "Cacher les petites fenêtres d'avertissement" #: resourcestr.rshelpsaveexit msgctxt "resourcestr.rshelpsaveexit" msgid "After import single note, save & exit" msgstr "Sauver & quitter après import de la note" #: resourcestr.rshelpsinglenote msgctxt "resourcestr.rshelpsinglenote" msgid "Open indicated note, switch is optional" msgstr "Ouvrir la note, commutation optionnelle" #: resourcestr.rshelptitleisfname msgid "Use Filename as title for import txt & md" msgstr "Nom de fichier comme titre pour l'import de txt & md" #: resourcestr.rshelpversion msgctxt "resourcestr.rshelpversion" msgid "Print version and exit" msgstr "Imprimer la version et quitter" #: resourcestr.rshexcharrequired msgid "2, 4, 6 or 8 Hex Characters Required" msgstr "" #: resourcestr.rslastchange msgid "Last Change" msgstr "Modifiée le" #: resourcestr.rslastsync msgid "Last Sync" msgstr "Dernière synchro" #: resourcestr.rslookingatnotes msgctxt "resourcestr.rslookingatnotes" msgid "Looking at notes ...." msgstr "Journal de la gestion des notes :" #: resourcestr.rslookingserverid msgid "Looking for ServerID" msgstr "Recherche du ServerID" #: resourcestr.rsmenuabout msgctxt "resourcestr.rsmenuabout" msgid "About" msgstr "À propos" #: resourcestr.rsmenuhelp msgctxt "resourcestr.rsmenuhelp" msgid "Help" msgstr "Aide" #: resourcestr.rsmenunewnote msgctxt "resourcestr.rsmenunewnote" msgid "New Note" msgstr "Nouvelle note" #: resourcestr.rsmenuquit msgctxt "resourcestr.rsmenuquit" msgid "Quit" msgstr "Quitter" #: resourcestr.rsmenusearch msgctxt "resourcestr.rsmenusearch" msgid "Search" msgstr "Recherche" #: resourcestr.rsmenusettings msgctxt "resourcestr.rsmenusettings" msgid "Settings" msgstr "Réglages" #: resourcestr.rsmenusync msgctxt "resourcestr.rsmenusync" msgid "Synchronise" msgstr "Synchronisation" #: resourcestr.rsmetadirwarning msgid "Please remember that to ensure a reliable sync, you must not change files in the Meta directory." msgstr "Rappel: pour une synchro fiable, ne pas changer les fichiers dans le Meta répertoire" #: resourcestr.rsmultiplenotebooks msgctxt "resourcestr.rsmultiplenotebooks" msgid "Settings allow multiple Notebooks" msgstr "L'option multi carnets est active" #: resourcestr.rsname msgid "Name" msgstr "Nom de la note" #: resourcestr.rsnewerversionexits msgctxt "resourcestr.rsnewerversionexits" msgid "A newer version exists in main repo" msgstr "Une nouvelle version est dispo. dans le dépôt principal" #: resourcestr.rsnoothernotes msgid "No other notes link to this one" msgstr "" #: resourcestr.rsnotavailable msgid "Not Available" msgstr "Non disponible" #: resourcestr.rsnotealreadyinrepo #, fuzzy #| msgid "Note already in Repo" msgctxt "resourcestr.rsnotealreadyinrepo" msgid "Note already in Repository" msgstr "Note déjà dans le dépôt" #: resourcestr.rsnotebookoptionctrl msgid "Ctrl click for Notebook Options" msgstr "Ctrl+clic pour les options du Carnet" #: resourcestr.rsnotebookoptionright msgid "Right click for Notebook Options" msgstr "Clic droit pour les options du Carnet" #: resourcestr.rsnotebooks msgctxt "resourcestr.rsnotebooks" msgid "Notebooks" msgstr "Carnets" #: resourcestr.rsnoteopen msgctxt "resourcestr.rsnoteopen" msgid "You have that note open, please close and try again" msgstr "Fermer cette note déjà ouverte et réessayer" #: resourcestr.rsnotes msgctxt "resourcestr.rsnotes" msgid "notes" msgstr "note(s)" #: resourcestr.rsnotesdeleted msgid "Note or notes deleted" msgstr "Note(s) effacée(s)" #: resourcestr.rsnotesinsnap msgctxt "resourcestr.rsnotesinsnap" msgid "Notes in Snapshot" msgstr "Notes placées dans le snapshot" #: resourcestr.rsnoteslinked msgid "Notes that link to this one" msgstr "" #: resourcestr.rsnotpresent msgctxt "resourcestr.rsnotpresent" msgid "Not present in main repo" msgstr "Absent du dépôt principal" #: resourcestr.rsnumbnotesaffected #, object-pascal-format msgid "This will affect %d notes" msgstr "Impacte %d notes" #: resourcestr.rsonenotebook msgctxt "resourcestr.rsonenotebook" msgid "Settings allow only one Notebook" msgstr "Un seul carnet autorisé (cf. Réglages)" #: resourcestr.rsoverwritenote msgctxt "resourcestr.rsoverwritenote" msgid "Overwrite newer version of that note" msgstr "Écrase la note avec la nouvelle version" #: resourcestr.rspressclose msgctxt "resourcestr.rspressclose" msgid "Press Close" msgstr "Presser \"Fermer\"" #: resourcestr.rsrecoverok msgctxt "resourcestr.rsrecoverok" msgid "OK, File recovered." msgstr "Fichier restauré." #: resourcestr.rsrenamefailed msgctxt "resourcestr.rsrenamefailed" msgid "ERROR, could not rename Backup File " msgstr "Échec de renommage du fichier sauvé " #: resourcestr.rsrollbackintro msgid "You can roll back to previous version of this note" msgstr "Vous pouvez revenir à la précédente version de la note" #: resourcestr.rsrunningsync msgctxt "resourcestr.rsrunningsync" msgid "Running Sync" msgstr "Synchro active" #: resourcestr.rssaveandsync msgctxt "resourcestr.rssaveandsync" msgid "Press Save and Sync if this looks OK" msgstr "Pour terminer presser \"Sauver + Synchro\"" #: resourcestr.rsscanremote msgid "Scanning remote files" msgstr "Scan des fichiers distants" #: resourcestr.rssearchhint msgid "Exact matches for terms between \" \"" msgstr "Correspondance exacte si placé entre \"\"" #: resourcestr.rssetthenotebooks #, fuzzy #| msgid "Set the notebooks this note is a member of" msgctxt "resourcestr.rssetthenotebooks" msgid "Set the Notebooks this note is a member of" msgstr "Choisir le(s) carnet(s) où ajouter la note courante." #: resourcestr.rssetup msgctxt "resourcestr.rssetup" msgid "Setup" msgstr "Configurer" #: resourcestr.rssetupnotesdirfirst msgctxt "resourcestr.rssetupnotesdirfirst" msgid "Please setup a notes directory first" msgstr "Définir d'abord un répertoire de notes" #: resourcestr.rssetupsyncfirst msgctxt "resourcestr.rssetupsyncfirst" msgid "Please config sync system first" msgstr "Configurer d'abord la synchro" #: resourcestr.rssnapshotcreated msgctxt "resourcestr.rssnapshotcreated" msgid "created, do you want to copy it elsewhere ?" msgstr "créé, faire une autre copie ailleurs ?" #: resourcestr.rssyncclash msgid "A Sync Clash has occurred" msgstr "" #: resourcestr.rssyncclashadvice msgid "Run the Sync from Main Menu to resolve" msgstr "" #: resourcestr.rssyncerror #, fuzzy #| msgid "A Sync Error occured" msgctxt "resourcestr.rssyncerror" msgid "A Sync Error occurred" msgstr "Erreur de synchro" #: resourcestr.rssyncnotconfig msgctxt "resourcestr.rssyncnotconfig" msgid "not configured" msgstr "non configuré" #: resourcestr.rssynctypefile msgid "File Sync - local or shared filesystem" msgstr "" #: resourcestr.rssynctypegithub msgid "Github - free Github account required" msgstr "" #: resourcestr.rstestingcredentials msgid "Testing Credentials" msgstr "Test des crédentiels" #: resourcestr.rstestingrepo #, fuzzy #| msgid "Testing Repo ...." msgctxt "resourcestr.rstestingrepo" msgid "Testing Repository ...." msgstr "Test du dépôt..." #: resourcestr.rstestingsync msgctxt "resourcestr.rstestingsync" msgid "Testing Sync" msgstr "Tst de la Synchro" #: resourcestr.rstryrecover_1 msgid "Try to recover a bad note by double clicking below," msgstr "Cliquer ci-dessous pour tenter de récupérer la note vérolé," #: resourcestr.rstryrecover_2 msgctxt "resourcestr.rstryrecover_2" msgid "if that fails, you may be able to recover it from a Snapshot." msgstr "Essai de restauration d'une note vérolée depuis un snapshot." #: resourcestr.rsunabletoproceed msgctxt "resourcestr.rsunabletoproceed" msgid "Unable to proceed because" msgstr "Impossible d'exécuter car" #: resourcestr.rsunabletosync msgctxt "resourcestr.rsunabletosync" msgid "Unable to sync because " msgstr "Synchro impossible car " #: resourcestr.rsuploaded msgid "Uploaded" msgstr "Chargé" #: resourcestr.rsuploading msgid "Uploading" msgstr "Chargement" #: resourcestr.rsutf8charlist msgid "Click here to browse to full list" msgstr "" #: resourcestr.rswarnnossystray msgid "WARNING, your Desktop might not display SysTray" msgstr "ATTENTION, votre desktop peut ne pas afficher Systray" #: resourcestr.rswehavesnapshots #, object-pascal-format msgid "We have %d snapshots" msgstr "Il y a %d snapshot" #: settings.rsdictionaryfailed msgid "Library Not Loaded" msgstr "Bibliothèque non chargée" #: settings.rsdictionaryloaded msgid "Dictionary Loaded OK" msgstr "La correction orthographique est correctement chargée." #: settings.rsdictionarynotfound msgid "No Dictionary Found" msgstr "Aucun dictionnaire trouvé" #: settings.rsdirhasnonotes #, fuzzy #| msgid "That directory does not contain any notes. Thats OK, if I can make my own there." msgid "That directory does not contain any notes. That is OK, if I can make my own there." msgstr "Aucune note dans ce répertoire mais une création est possible." #: settings.rserrorcannotwrite msgid "Cannot write into" msgstr "Échec d'écriture dans" #: settings.rserrorcreatedir msgid "Unable to Create Directory" msgstr "Échec de création du répertoire" #: settings.rsselectdictionary msgid "Select the dictionary you want to use" msgstr "Choisir le dictionnaire à utiliser" #: settings.rsselectlibrary msgid "Select your hunspell library" msgstr "Choisir la bibliothèque Hunspell" #: spelling.rscheckingfull msgid "Checking full document" msgstr "Vérification du document" #: spelling.rscheckingselection msgid "Checking selection" msgstr "Vérification de la sélection" #: spelling.rsreplace_with_1 msgid "replace" msgstr "remplacer" #: spelling.rsreplace_with_2 msgid "with" msgstr "avec" #: spelling.rsspellcomplete msgid "Spell check complete" msgstr "Orthographe vérifiée" #: spelling.rsspellnotconfig msgid "Spelling not configured" msgstr "Vérification orthographique non configurée" #: syncutils.rschangeexistingsync msgid "Change existing sync connection ?" msgstr "Changer la connexion synchro existante ?" #: syncutils.rsclashes msgid "Clashes " msgstr "Nbre de collisions = " #: syncutils.rsdonothing msgid "Do Nothing " msgstr "Nbre de notes sans action = " #: syncutils.rsdownloads msgid "Downloads " msgstr "Nbre de downloads = " #: syncutils.rsedituploads msgid "Edit Uploads " msgstr "Nbre d'uploads modifiés = " #: syncutils.rslocaldeletes msgid "Local Deletes " msgstr "Nbre de suppressions locales = " #: syncutils.rsnewuploads msgid "New Uploads " msgstr "Nbre de nouveaux uploads = " #: syncutils.rsnextbitslow msgid "Next bit can be a bit slow, please wait" msgstr "Prochain bit possiblement lent, merci de patienter" #: syncutils.rsnonotesneededsync msgid "No notes needed syncing. You need to write more." msgstr "Pas de synchro requise pour l'instant." #: syncutils.rsnotesweredealt msgid " notes were dealt with." msgstr " notes ont été traitées." #: syncutils.rsnotrecommend msgid "Generally not recommended." msgstr "Plutôt déconseillé." #: syncutils.rsremotedeletes msgid "Remote Deletes " msgstr "Nbre d'effacements distants = " #: syncutils.rssyncerrors #, fuzzy #| msgid "ERRORS (see consol log) " msgid "ERRORS (see console log) " msgstr "Nbre d'erreurs (cf. log console) = " #: teditboxform.buttmaintbmenu.caption msgctxt "teditboxform.buttmaintbmenu.caption" msgid "Menu" msgstr "Menu" #: teditboxform.editfind.text msgid "EditFind" msgstr "ÉditerRechercher" #: teditboxform.label2.caption msgid "Read Only" msgstr "Mode lecture" #: teditboxform.label3.caption msgid "This note has been changed by the Sync Process" msgstr "Note changée par le processus de synchro" #: teditboxform.label4.caption msgid "Please close it (and re-open if it was a download)" msgstr "Fermer (puis rouvrir si c'était un téléchargement)" #: teditboxform.menubold.caption msgctxt "teditboxform.menubold.caption" msgid "Bold" msgstr "Gras" #: teditboxform.menufindnext.caption msgid "Find Next" msgstr "Suivant" #: teditboxform.menufindprev.caption msgctxt "teditboxform.menufindprev.caption" msgid "Find Prev" msgstr "Précédent" #: teditboxform.menufixedwidth.caption msgid "Fixed Width" msgstr "Chasse fixe" #: teditboxform.menuhighlight.caption msgctxt "teditboxform.menuhighlight.caption" msgid "Highlight" msgstr "Surlignement" #: teditboxform.menuhuge.caption msgctxt "teditboxform.menuhuge.caption" msgid "Huge" msgstr "Police énorme" #: teditboxform.menuitalic.caption msgid "Italic" msgstr "Italique" #: teditboxform.menuitembulletleft.caption #, fuzzy #| msgid "Bullet <<" msgid "Bullet -" msgstr "Puce <<" #: teditboxform.menuitembulletright.caption #, fuzzy #| msgid "Bullet >>" msgid "Bullet +" msgstr "Puce >>" #: teditboxform.menuitemcopy.caption msgid "Copy" msgstr "Copier" #: teditboxform.menuitemcopyplain.caption msgid "Copy Plain" msgstr "" #: teditboxform.menuitemcut.caption msgid "Cut" msgstr "Couper" #: teditboxform.menuitemdelete.caption msgctxt "teditboxform.menuitemdelete.caption" msgid "Delete" msgstr "Effacer" #: teditboxform.menuitemevaluate.caption msgid "Evaluate" msgstr "Evaluer" #: teditboxform.menuitemexport.caption msgid "Export" msgstr "Export" #: teditboxform.menuitemexportmarkdown.caption msgid "Export Markdown" msgstr "Export réduit" #: teditboxform.menuitemexportpdf.caption msgid "Export PDF" msgstr "" #: teditboxform.menuitemexportplaintext.caption msgid "Export Plain Text" msgstr "Export en texte brut" #: teditboxform.menuitemexportrtf.caption msgid "Export RTF" msgstr "Export au format RTF" #: teditboxform.menuitemfind.caption msgid "Find in this Note" msgstr "Chercher dans la note" #: teditboxform.menuitemindex.caption msgid "Index" msgstr "Index" #: teditboxform.menuitempaste.caption msgid "Paste" msgstr "Coller" #: teditboxform.menuitemprint.caption msgid "Print" msgstr "Imprimer" #: teditboxform.menuitemselectall.caption msgid "Select All" msgstr "Tout sélectionner" #: teditboxform.menuitemsettings.caption msgctxt "teditboxform.menuitemsettings.caption" msgid "Settings" msgstr "Réglages" #: teditboxform.menuitemspell.caption msgid "Spell Check" msgstr "Vérification orthographique" #: teditboxform.menuitemsync.caption #, fuzzy #| msgid "Syncronize" msgid "Synchronize" msgstr "Synchroniser" #: teditboxform.menularge.caption msgid "Large Font" msgstr "Police grande" #: teditboxform.menunormal.caption msgid "Normal Font" msgstr "Police normale" #: teditboxform.menusmall.caption msgid "Small Font" msgstr "Police petite" #: teditboxform.menustayontop.caption msgid "Stay On Top" msgstr "Toujours visible" #: teditboxform.menustrikeout.caption msgid "Strikeout" msgstr "Barré" #: teditboxform.menuunderline.caption msgid "Underline" msgstr "Souligné" #: teditboxform.speedbuttondelete.hint msgid "Delete this note" msgstr "Supprimer la note" #: teditboxform.speedbuttonlink.hint #, fuzzy #| msgid "Link highlighted text to a new note" msgid "Create new linked note (text selected) or display Backlinks." msgstr "Créer une note avec la sélection" #: teditboxform.speedbuttonnotebook.hint msgid "Manage Notebooks" msgstr "Gestion des Carnets" #: teditboxform.speedbuttonsearch.hint msgid "Search All Notes Ctrl-Shift-F" msgstr "Rechercher (ctrl+shft+F)" #: teditboxform.speedbuttontext.hint msgid "Font size, bold, italics etc" msgstr "Formatage du texte" #: teditboxform.speedbuttontools.hint msgid "Tools - Sync, Export, Spell" msgstr "Outils - Synchro, Export, Orthographe" #: teditboxform.speedclose.caption #, fuzzy msgctxt "teditboxform.speedclose.caption" msgid "Close" msgstr "Fermer" #: teditboxform.speedrollback.hint msgid "Roll Back" msgstr "Annuler" #: teditboxform.speedsymbol.hint msgid "Insert extended character or symbol" msgstr "" #: tformbackupview.buttondelete.caption msgctxt "tformbackupview.buttondelete.caption" msgid "Delete" msgstr "Supprimer" #: tformbackupview.buttondelete.hint msgid "Really, totally delete this note." msgstr "Suppression de la note." #: tformbackupview.buttonok.caption msgctxt "tformbackupview.buttonok.caption" msgid "Close" msgstr "Fermer" #: tformbackupview.buttonok.hint msgid "My work here is done." msgstr "Travail terminé." #: tformbackupview.buttonopen.caption msgid "View" msgstr "Voir" #: tformbackupview.buttonopen.hint msgid "Open and view the whole note" msgstr "Affichage intégrale de la note" #: tformbackupview.buttonrecover.caption msgctxt "tformbackupview.buttonrecover.caption" msgid "Recover" msgstr "Récupérer" #: tformbackupview.buttonrecover.hint msgid "Restore this note to main repo" msgstr "Récupérer la note dans le dépôt principal" #: tformbackupview.caption msgid "View, recover or delete Backup Files" msgstr "Gestion des fichiers de sauvegarde" #: tformbackupview.listbox1.hint msgid "Use Ctrl or Shift to select multiple entries" msgstr "Presser Ctrl ou Shift pour la sélection multiple" #: tformcolours.label1.caption msgid "Sample" msgstr "Échantillon" #: tformcolours.label2.caption msgctxt "tformcolours.label2.caption" msgid "Set Colours" msgstr "Réglages des couleurs" #: tformcolours.speedbackground.caption msgid "Background" msgstr "Arrière-plan" #: tformcolours.speedcancel.caption msgctxt "tformcolours.speedcancel.caption" msgid "Cancel" msgstr "Annuler" #: tformcolours.speeddefault.caption msgid "Default" msgstr "Défaut" #: tformcolours.speedhighlight.caption msgctxt "tformcolours.speedhighlight.caption" msgid "Highlight" msgstr "Surlignement" #: tformcolours.speedlinks.caption msgid "Links" msgstr "" #: tformcolours.speedok.caption msgctxt "tformcolours.speedok.caption" msgid "OK" msgstr "OK" #: tformcolours.speedtext.caption msgid "Text" msgstr "Texte" #: tformcolours.speedtitle.caption msgctxt "tformcolours.speedtitle.caption" msgid "Title" msgstr "Titre" #: tformindex.caption msgid "Heading in this Note" msgstr "Entête de la note" #: tformindex.panel1.caption msgid "Single lines, all Huge, Large Bold or Large" msgstr "Ligne normale, énorme, ou grand (+gras)" #: tformkmemo2pdf.caption msgid "PDF Issues" msgstr "" #: tformrecover.buttondeletebadnotes.caption msgid "Delete Bad Notes" msgstr "Effacer les notes vérolées" #: tformrecover.buttonmakesafetysnap.caption msgid "Take a manual Snapshot" msgstr "Prendre un snapshot" #: tformrecover.buttonmakesafetysnap.hint msgid "Take a initial snapshot of your notes and config. Overwritten each time." msgstr "1er snapshot des notes & config puis remplacement à chaque màj." #: tformrecover.buttonrecoversnap.caption msgctxt "tformrecover.buttonrecoversnap.caption" msgid "Recover" msgstr "Récupérer" #: tformrecover.buttonsnaphelp.caption msgctxt "tformrecover.buttonsnaphelp.caption" msgid "Snapshot Help" msgstr "Aide snapshot" #: tformrecover.label10.caption msgid "Please close any notes you may have open." msgstr "Fermer les notes possiblement ouvertes." #: tformrecover.label12.caption msgid "Don't even consider this unless you have a backup Snapshot, Intro Tab." msgstr "Impossibe sauf à disposer d'un snapshot déjà sauvé, cf. onglet Intro." #: tformrecover.label14.caption msgid "Click an available snapshot to see its contents." msgstr "Sélectionner le snapshot à visualiser." #: tformrecover.label15.caption msgid "Click an available snapshot, click Recover" msgstr "Sélectionner un snapshot, cliquer sur Restauration" #: tformrecover.label16.caption msgid "You may chose to view, copy and paste into a new note." msgstr "Choisir de voir, copier et coller dans une note." #: tformrecover.label2.caption #, fuzzy #| msgid "Please be carefull, this is a dangerous place!" msgid "Please be careful, this is a dangerous place!" msgstr "Attention, cette fonctionnalité est instable !" #: tformrecover.label3.caption msgid "Restore any notes in the snapshot that are not in the existing notes directory." msgstr "Récupérer les notes du snapshot n'existant pas dans le répertoire local." #: tformrecover.label4.caption msgid "Remove all existing notes and use the ones in the Snapshot." msgstr "Effacer toutes les notes pour utiliser celles du snapshot." #: tformrecover.label5.caption msgid "Looking for notes with damaged XML" msgstr "Recherche de notes avec XML vérolé" #: tformrecover.label6.caption msgid "This tool might help you recover lost or damaged notes." msgstr "Outil d'aide à la restauration des notes perdues ou vérolées." #: tformrecover.label7.caption msgid "Before you start, take a Snapshot of your notes directory." msgstr "Faire préalablement un snapshot des notes du répertoire." #: tformrecover.label9.caption msgid "From here you can view snapshot notes, one by one." msgstr "Endroit permettant la visu snapshot par snapshot." #: tformrecover.listboxsnapshots.hint msgid "These are the currently known snapshots. " msgstr "Voici les snapshots actuellement connus." #: tformrecover.panelsnapshots.caption msgid "Available Snapshots" msgstr "Snapshots disponibles" #: tformrecover.tabsheetbadnotes.caption msgid "Bad Notes" msgstr "Notes vérolées" #: tformrecover.tabsheetintro.caption msgid "Introduction" msgstr "Introduction" #: tformrecover.tabsheetmergesnapshot.caption msgid "Merge Snapshot" msgstr "Fusionner le snapshot" #: tformrecover.tabsheetrecovernotes.caption msgid "Recover Notes" msgstr "Restauration des notes" #: tformrecover.tabsheetrecoversnapshot.caption msgid "Recover Snapshot" msgstr "Récupérer un snapshot" #: tformrollback.speedcancel.caption msgctxt "tformrollback.speedcancel.caption" msgid "Cancel" msgstr "Annuler" #: tformrollback.speedrolltoopen.caption msgid "Opening Backup" msgstr "Ouvrir une sauvegarde" #: tformrollback.speedrolltotitle.caption msgid "Title Change Backup" msgstr "Renommer la sauvegarde" #: tformsdiff.bitbtnuselocal.caption msgid "Use Local" msgstr "Utilisation Local" #: tformsdiff.bitbtnuseremote.caption msgid "Use Remote" msgstr "Utilisation Distante" #: tformsdiff.buttalllocal.caption msgid "Local" msgstr "Locale" #: tformsdiff.buttallnewest.caption msgid "Newest" msgstr "Nouveau" #: tformsdiff.buttalloldest.caption msgid "Oldest" msgstr "Ancien" #: tformsdiff.buttallremote.caption msgid "Remote" msgstr "Distant" #: tformsdiff.caption msgid "A Note Sync Clash has been Detected" msgstr "Détection d'une erreur de synchro de notes" #: tformsdiff.label1.caption msgid "Or make a choice for remainder of this run" msgstr "Ou faire une autre choix pour cette exécution" #: tformsdiff.label3.caption msgid "Remote Changed" msgstr "Distant changé" #: tformsdiff.label4.caption msgid "Local Changed" msgstr "Local changé" #: tformsdiff.radiolong.caption msgid "Long Lines" msgstr "Lignes longues" #: tformsdiff.radiolong.hint msgid "Maybe necessary to show difference" msgstr "Possible nécessité de voir la différence" #: tformsdiff.radioshort.caption msgid "Short Lines" msgstr "Lignes Courtes" #: tformsdiff.radioshort.hint msgid "Easier to read" msgstr "Plus facile à lire" #: tformspell.buttonignore.caption msgid "Ignore" msgstr "Ignorer" #: tformspell.buttonignore.hint msgid "Ignore all instances for the run" msgstr "Tout ignorer" #: tformspell.buttonskip.caption msgid "Skip" msgstr "Sauter" #: tformspell.buttonskip.hint msgid "Skip just this instance" msgstr "Sauter juste cette instance" #: tformspell.buttonuseandnextword.caption msgid "Use and Next Word" msgstr "Utiliser & passer au mot suivant" #: tformspell.caption msgctxt "tformspell.caption" msgid "Spell" msgstr "Vérifier" #: tformspell.label4.caption msgid "Suspect word -" msgstr "Mot suspect -" #: tformspell.labelprompt.caption msgid "Click a word to use it." msgstr "Cliquer sur un mot." #: tformsymbol.bitbtnrevert.caption msgid "Revert" msgstr "" #: tformsymbol.caption msgid "Symbol" msgstr "" #: tformsymbol.stringgrid1.columns[0].title.caption #, fuzzy msgctxt "tformsymbol.stringgrid1.columns[0].title.caption" msgid "Title" msgstr "Titre" #: tformsymbol.stringgrid1.columns[1].title.caption #, fuzzy msgctxt "tformsymbol.stringgrid1.columns[1].title.caption" msgid "Title" msgstr "Titre" #: tformsync.buttoncancel.caption msgctxt "tformsync.buttoncancel.caption" msgid "Cancel" msgstr "Annuler" #: tformsync.buttonclose.caption msgctxt "tformsync.buttonclose.caption" msgid "Close" msgstr "Fermer" #: tformsync.buttonsave.caption msgid "Save and Sync" msgstr "Sauver + Synchro" #: tformsync.caption msgctxt "tformsync.caption" msgid "Sync" msgstr "Synchro" #: tformsync.listviewreport.columns[0].caption msgid "Action" msgstr "Action" #: tformsync.listviewreport.columns[1].caption msgctxt "tformsync.listviewreport.columns[1].caption" msgid "Title" msgstr "Titre" #: tformsync.listviewreport.columns[2].caption msgid "Note ID" msgstr "ID de la note" #: tmainform.bitbtnhide.caption #, fuzzy msgctxt "tmainform.bitbtnhide.caption" msgid "Hide" msgstr "Cacher" #: tmainform.bitbtnquit.caption #, fuzzy msgctxt "tmainform.bitbtnquit.caption" msgid "Quit" msgstr "Quitter" #: tmainform.buttmenu.caption msgctxt "tmainform.buttmenu.caption" msgid "Menu" msgstr "Menu" #: tmainform.buttsystrayhelp.caption msgid "SysTray Help" msgstr "Aide Systray" #: tmainform.caption msgid "tomboy-ng" msgstr "tomboy-ng" #: tmainform.checkboxdontshow.caption msgid "Don't Show for normal startup" msgstr "Ne plus afficher au prochain démarrage" #: tmainform.checkboxdontshow.hint msgid "You can reverse this from Settings" msgstr "Inversion possible dans les réglages" #: tmainform.hint #, fuzzy #| msgid "If the green tomboy-ng icon is visible in your System Tray, you can dismiss this window." msgid "If the yellow tomboy-ng icon is visible in your System Tray, you can dismiss this window." msgstr "Si l'icône verte de tomboy-ng est présente dans le dock, la fenêtre peut être fermée." #: tmainform.label3.caption msgid "Dictionary Config (optional)" msgstr "Vérificateur orthographique (optionnel)" #: tmainform.label4.caption msgid "Sync Config (optional)" msgstr "Configuration de la synchro (optionnel)" #: tmainform.label5.caption msgid "Welcome to tomboy-ng !" msgstr "Bienvenue dans tomboy-ng !" #: tmainform.labelerror.hint msgid "Launch from commandline to see errors or see Config->SnapShot->Recover ..." msgstr "Lancer par le CLI pour voir les erreurs, la Config->Snapshot->Restauration, etc." #: tnotebookpick.button1.caption msgctxt "tnotebookpick.button1.caption" msgid "Cancel" msgstr "Annuler" #: tnotebookpick.buttonok.caption msgctxt "tnotebookpick.buttonok.caption" msgid "OK" msgstr "OK" #: tnotebookpick.caption #, fuzzy msgctxt "tnotebookpick.caption" msgid "Notebooks" msgstr "Carnets" #: tnotebookpick.label4.caption msgid "Name of the New Notebook" msgstr "Nom du nouveau Carnet" #: tnotebookpick.label5.caption #, fuzzy #| msgid "Press OK and we will make the Note Book AND add this note to it." msgid "Press OK and we will make the Notebook AND add this note to it." msgstr "\"OK\" crée le carnet et y ajoute la note courante." #: tnotebookpick.label6.caption msgid "Existing Name" msgstr "Nom existant" #: tnotebookpick.label8.caption msgid "New Name" msgstr "Nouveau nom" #: tnotebookpick.label9.caption #, fuzzy #| msgid "If you sync and are not absolutly sure its up to date, Cancel now !" msgid "If you sync and are not absolutely sure it is up to date, Cancel now !" msgstr "S'assurer d'être à jour avant une synchro ou annuler maintenant !" #: tnotebookpick.tabchangename.caption msgid "Change Notebook Name" msgstr "Renommer le Carnet" #: tnotebookpick.tabexisting.caption msgid "Existing Note Books" msgstr "Carnets existant" #: tnotebookpick.tabnewnotebook.caption msgid "New Note Book" msgstr "Nouveau carnet" #: tnotebookpick.tabsetnotes.caption msgid "Set Notes" msgstr "Définir Notes" #: tsearchform.bitbtnmenu.caption #, fuzzy msgctxt "tsearchform.bitbtnmenu.caption" msgid "Menu" msgstr "Menu" #: tsearchform.buttonclearfilters.caption #, fuzzy #| msgid "Clear Filters" msgctxt "tsearchform.buttonclearfilters.caption" msgid "Clear" msgstr "Effacer les filtres" #: tsearchform.buttonclearsearch.caption #, fuzzy msgctxt "tsearchform.buttonclearsearch.caption" msgid "Clear" msgstr "Effacer" #: tsearchform.buttonsearchoptions.caption #, fuzzy msgctxt "tsearchform.buttonsearchoptions.caption" msgid "Options" msgstr "Options" #: tsearchform.caption msgid "tomboy-ng_Search" msgstr "Recherche tomboy-ng" #: tsearchform.listboxnotebooks.hint msgid "Right Click to manage Notebooks" msgstr "Clic Droit pour gérer les carnets" #: tsearchform.menucreatenotebook.caption #, fuzzy #| msgid "Create new Note Book" msgid "Create new Notebook" msgstr "Créer un nouveau carnet" #: tsearchform.menudeletenotebook.caption msgid "Delete Notebook" msgstr "Effacer le carnet" #: tsearchform.menueditnotebooktemplate.caption msgid "Edit Notebook Template" msgstr "Éditer le modèle du carnet" #: tsearchform.menuitemcasesensitive.caption msgctxt "tsearchform.menuitemcasesensitive.caption" msgid "Case Sensitive" msgstr "Sensible à la casse" #: tsearchform.menuitemimportnote.caption msgid "Import File" msgstr "Import Fichier" #: tsearchform.menuitemmanagenbook.caption #, fuzzy #| msgid "Manage Notes in Note Book" msgid "Manage Notes in Notebook" msgstr "Gère les notes du carnet" #: tsearchform.menuitemswyt.caption msgid "Search While You Type" msgstr "Recherche pendant la saisie" #: tsearchform.menunewnotefromtemplate.caption msgid "Create New Note from Template" msgstr "Créer une note à partir du modèle" #: tsearchform.menurenamenotebook.caption #, fuzzy #| msgid "Rename Note Book" msgid "Rename Notebook" msgstr "Renommer le Carnet" #: tsearchform.panel2.caption msgctxt "tsearchform.panel2.caption" msgid "Notebooks" msgstr "Carnets" #: tsett.buttonfixedfont.caption msgid "Fixed Font" msgstr "Police fixe" #: tsett.buttonfont.caption msgid "Usual Font" msgstr "Police courante" #: tsett.buttonmanualsnap.caption msgid "Take a Manual Snapshot" msgstr "Snapshot manuel" #: tsett.buttonmanualsnap.hint msgid "Take a time stamped snapshot of notes and config" msgstr "Prendre un snapshot horodaté des notes + config" #: tsett.buttonsetcolours.caption msgctxt "tsett.buttonsetcolours.caption" msgid "Set Colours" msgstr "Choix des couleurs" #: tsett.buttonsetdictionary.caption msgid "Set Dictionary" msgstr "Choix du dictionnaire" #: tsett.buttonsetnotepath.caption msgid "Set Path to Note Files" msgstr "Choisir l'emplacement" #: tsett.buttonsetnotepath.hint msgid "If you have notes somewhere else" msgstr "S'il y a des notes ailleurs" #: tsett.buttonsetspelllibrary.caption msgid "Set Spell Library" msgstr "Choisir la bibliothèque" #: tsett.buttonshowbackup.caption msgid "Show Me" msgstr "Afficher" #: tsett.buttonsnaprecover.caption msgid "Recover Lost Notes" msgstr "Récupérer les notes perdues" #: tsett.buttonsnaprecover.hint msgid "If you have previously taken a snapshot ..." msgstr "Si un précédent snapshot existe..." #: tsett.checkautosnapenabled.caption msgctxt "tsett.checkautosnapenabled.caption" msgid "Use auto snapshots" msgstr "snapshot automatique" #: tsett.checkautostart.caption msgid "Autostart at Logon" msgstr "Ouvrir au démarrage" #: tsett.checkescclosesnote.caption #, fuzzy #| msgid "Esc Closes Note" msgid "ESC Closes Note" msgstr "Esc pour fermer la note" #: tsett.checkfindtoggles.caption msgid "Find Command Toggles" msgstr "Bascule Commande recherche" #: tsett.checkfindtoggles.hint msgctxt "tsett.checkfindtoggles.hint" msgid "eg Ctrl-F opens and closes Find Window" msgstr "ex: Ctrl-F ouvre et ferme la fenêtre de recherche" #: tsett.checkmanynotebooks.caption msgid "Allow a Note to be in Multiple Notebooks." msgstr "Une note peut figurer dans plusieurs carnets." #: tsett.checkmanynotebooks.hint msgid "This may adversly affect traditional Tomboy, take care." msgstr "Attention, risque d'impact sur le Tomboy traditionnel." #: tsett.checknotifications.caption msgid "Show Notifications" msgstr "affiche les notifications" #: tsett.checkshowextlinks.caption #, fuzzy #| msgid "Show External Links" msgid "Show External Links" msgstr "Voir les liens externes" #: tsett.checkshowintlinks.caption msgid "Show Internal Links" msgstr "Voir les liens internes" #: tsett.checkshowsearchatstart.caption msgid "Show Search at Start" msgstr "Afficher la recherche au démarrage" #: tsett.checkshowsplash.caption msgid "Show Splash at Start" msgstr "Afficher la fenêtre de démarrage" #: tsett.checkshowsplash.hint msgid "Always shown if error loading notes." msgstr "Toujours affiché en cas d'erreur de chargement des notes." #: tsett.checkstampbold.caption #, fuzzy msgctxt "tsett.checkstampbold.caption" msgid "Bold" msgstr "Gras" #: tsett.checkstampitalics.caption msgid "Italics" msgstr "Italique" #: tsett.checkstampsmall.caption #, fuzzy msgctxt "tsett.checkstampsmall.caption" msgid "Small" msgstr "Police petite" #: tsett.checkuseundo.caption msgid "Use Undo Redo (may slow editing)" msgstr "Réutiliser annuler (peut ralentir l'édition)" #: tsett.checkuseundo.hint msgid "Close and reopen a note to take effect. Use Ctrl-Z Ctrl-Y" msgstr "Fermer puis ouvrir une note pour valider. Utilisez Ctrl-Z Ctrl-Y" #: tsett.combosynctiming.text msgid "ComboSyncTiming" msgstr "" #: tsett.combosynctype.hint msgid "Github or File Sync" msgstr "GitHub ou Synchro fichier" #: tsett.groupbox4.caption #, fuzzy #| msgid " Options " msgctxt "tsett.groupbox4.caption" msgid "When a conflict is detected between a local note and remote one :" msgstr " Options " #: tsett.groupbox5.caption msgid "Font Size" msgstr "Taille de police" #: tsett.groupboxsync.caption msgid " Sync " msgstr " Synchro " #: tsett.groupboxtoken.caption msgctxt "tsett.groupboxtoken.caption" msgid "Token" msgstr "Jeton" #: tsett.groupboxuser.caption msgctxt "tsett.groupboxuser.caption" msgid "User" msgstr "Utilisateur" #: tsett.groupnotespath.caption msgid "Notes Path" msgstr "" #: tsett.label1.caption msgid "Settings will be saved in :" msgstr "Les réglages seront sauvegardés dans :" #: tsett.label10.caption msgctxt "tsett.label10.caption" msgid "Help Notes Language" msgstr "Langue pour les notes" #: tsett.label11.caption msgid "Backup Files" msgstr "Fichiers de sauvegarde" #: tsett.label13.caption msgid "Spell Check requires the Hunspell Libraries and" msgstr "Le contrôle de l'orthographe requiert des bibliothèques Hunspell" #: tsett.label14.caption msgid "an appropriate Hunspell Dictionary set." msgstr "et un réglage approprié du dictionnaire." #: tsett.label16.caption #, fuzzy #| msgid "Maxium number of snapshots" msgid "Maximum number of snapshots" msgstr "snaphots au maximum" #: tsett.label17.caption msgid "Date Stamp Format" msgstr "Format horodatage" #: tsett.label2.caption msgid "Notes will be looked for and saved in :" msgstr "Les notes seront sauvegardées dans :" #: tsett.label4.caption msgid "Repo : " msgstr "Dépôt : " #: tsett.label5.caption msgid "Days per snapshot" msgstr "jours entre 2 synchro" #: tsett.label6.caption msgid "Backup files are made when you delete a note or the sync system" msgstr "Une sauvegarde est réalisé quand une note est effacée" #: tsett.label7.caption msgid "is about to overwrite one. " msgstr "manuellement ou par une synchronisation." #: tsett.label8.caption #, fuzzy #| msgid "They remain, for ever, unless you do something about them." msgid "They remain, forever, unless you do something about them." msgstr "Elle reste ensuite présente jusqu'à son effacement manuel." #: tsett.label9.caption msgid "A snaphot is a copy of your current note directory." msgstr "Un snapshot est une copie en l'état du répertoire des notes" #: tsett.labelsnapdir.caption msgid "Snap dir" msgstr "Répertoire des snap" #: tsett.labelsyncrepo.caption #, fuzzy msgctxt "tsett.labelsyncrepo.caption" msgid "not configured" msgstr "non configuré" #: tsett.labelsynctiming.caption msgid "Sync Timing" msgstr "" #: tsett.labelsynctype.caption msgid "Sync Type" msgstr "Typede synchro" #: tsett.menuitemcopytoken.caption msgid "Copy Existing Token" msgstr "Copie d'un jeton existant" #: tsett.menuitemgettoken.caption msgid "Get a Token in your Browser" msgstr "Obtenir un jeton dans le navigateur" #: tsett.menuitempastetoken.caption msgid "Paste a New Token" msgstr "Coller un nouveau jeton" #: tsett.radioalwaysask.caption msgid "Always Ask me what to do." msgstr "Demander quoi faire à chaque fois." #: tsett.radiochoose.caption msgid "Choose" msgstr "" #: tsett.radiofontbig.caption msgid "Big" msgstr "Police grande" #: tsett.radiofonthuge.caption msgctxt "tsett.radiofonthuge.caption" msgid "Huge" msgstr "Police énorme" #: tsett.radiofontmedium.caption msgid "Medium" msgstr "Police moyenne" #: tsett.radiofontsmall.caption msgctxt "tsett.radiofontsmall.caption" msgid "Small" msgstr "Police petite" #: tsett.radiotomboydefault.caption msgid "Old Tomboy Default" msgstr "" #: tsett.radiotomboyngdefault.caption msgid "tomboy-ng Default" msgstr "" #: tsett.radiouselocal.caption msgid "Use Local Note and Overwrite Server Note." msgstr "Préférer la note locale, écraser la note serveur." #: tsett.radiouseserver.caption msgid "Use Server Note and Rename Local Note." msgstr "Préférer la note serveur, écraser la note locale." #: tsett.speedbuthelp.caption msgctxt "tsett.speedbuthelp.caption" msgid "Help" msgstr "Aide" #: tsett.speedbuthide.caption msgctxt "tsett.speedbuthide.caption" msgid "Close" msgstr "Fermer" #: tsett.speedbutttbmenu.caption msgctxt "tsett.speedbutttbmenu.caption" msgid "Menu" msgstr "Menu" #: tsett.speedsetupsync.caption msgctxt "tsett.speedsetupsync.caption" msgid "Setup" msgstr "Réglages" #: tsett.speedtokenactions.caption msgid "Actions" msgstr "Actions" #: tsett.tabbackup.caption msgid "BackUp" msgstr "Sauvegarde" #: tsett.tabbasic.caption msgid "Basic" msgstr "Général" #: tsett.tabdisplay.caption msgid "Notes" msgstr "Notes" #: tsett.tabrecover.caption msgctxt "tsett.tabrecover.caption" msgid "Recover" msgstr "Restauration" #: tsett.tabspell.caption msgctxt "tsett.tabspell.caption" msgid "Spell" msgstr "Orthographe" #: tsett.tabsync.caption msgctxt "tsett.tabsync.caption" msgid "Sync" msgstr "Synchro" tomboy-ng_0.39-1/po/tomboy-ng.uk.po0000644000175000017500000015247414551457644016763 0ustar dbannondbannon# Ukrainian translation for tomboy-ng # Copyright (C) 2022 Free Software Foundation, Inc. # Andrij Mizyk , 2022. msgid "" msgstr "" "Project-Id-Version: tomboy-ng v0.34\n" "PO-Revision-Date: 2022-10-23 12:06+0300\n" "Last-Translator: Andrij Mizyk \n" "Language-Team: Ukrainian\n" "Language: uk\n" "MIME-Version: 1.0\n" "Content-Type: text/plain; charset=UTF-8\n" "Content-Transfer-Encoding: 8bit\n" #: editbox.rsunabletoevaluate msgid "Unable to find an expression to evaluate" msgstr "Неможливо знайти вираз для виконання" #: fpttf.rsmissingfontfile #, object-pascal-format msgid "The font file <%s> can't be found." msgstr "" #: fpttf.rsnofontfilename msgid "The FileName property is empty, so we can't load font data." msgstr "" #: fpttf.rsnosearchpathdefined msgid "No search path was defined" msgstr "" #: fpttf.serrfontnotfound #, object-pascal-format msgid "The font <%s> can't be found" msgstr "" #: mainunit.rsabout msgid "tomboy-ng notes - cross platform, sync and manage notes." msgstr "нотатки tomboy-ng - міжплатформове, синхронізоване керування нотатками." #: mainunit.rsaboutbdate msgid "Build date" msgstr "Дата збірки" #: mainunit.rsaboutcpu msgid "TargetCPU" msgstr "ЦільовийЦП" #: mainunit.rsaboutoperatingsystem msgid "OS" msgstr "ОС" #: mainunit.rsaboutver msgid "Version" msgstr "Версія" #: mainunit.rsfailedtoindex msgid "Failed to index one or more notes." msgstr "Не вдалося проіндексувати одну або більше нотаток." #: resourcestr.rsaddnotestonotebook msgid "Add notes to this Notebook" msgstr "Додати нотатки до цього записника" #: resourcestr.rsalldone msgctxt "resourcestr.rsalldone" msgid "All Done" msgstr "Усе готово" #: resourcestr.rsallrestored msgctxt "resourcestr.rsallrestored" msgid "Notes and config files Restored, restart suggested." msgstr "Нотатки і файл конфігурації відновлено, радимо перезапустити." #: resourcestr.rsautosnapshotrun msgid "Completed autosnapshot run." msgstr "Завершено роботу автозрізів." #: resourcestr.rsautosyncnotpossible msgid "Auto sync not possible right now" msgstr "Автосинхронізація не можлива прямо зараз" #: resourcestr.rsbadnotes #, object-pascal-format msgctxt "resourcestr.rsbadnotes" msgid "You have %d bad notes in Notes Directory" msgstr "Ви маєте %d поганих нотаток у каталозі з нотатками" #: resourcestr.rsbadnotesfound1 msgctxt "resourcestr.rsbadnotesfound1" msgid "Please go to Settings -> Recover -> Recover Notes" msgstr "Будь ласка, перейдіть у Налаштувати -> Відновлення -> Відновлення нотаток" #: resourcestr.rsbadnotesfound2 msgctxt "resourcestr.rsbadnotesfound2" msgid "You should do so to ensure your notes are safe." msgstr "Ви повинні зробити це, щоб забезпечити безпеку своїх нотаток." #: resourcestr.rscannotdelete msgctxt "resourcestr.rscannotdelete" msgid "Cannot delete " msgstr "Неможливо видалити" #: resourcestr.rscannotfindnote msgctxt "resourcestr.rscannotfindnote" msgid "ERROR, cannot find " msgstr "ПОМИЛКА, неможливо знайти" #: resourcestr.rschangenameofnotebook msgid "Change the name of this Notebook" msgstr "Змінити назву цього записника" #: resourcestr.rschangesync #, fuzzy #| msgid "Change Sync Repo" msgid "Change Sync Repository" msgstr "Змінити синхронізацію репозиторію" #: resourcestr.rsclickbadnote msgctxt "resourcestr.rsclickbadnote" msgid "Double click on any Bad Notes" msgstr "Подвійне клацання на будь-якій поганій нотатці" #: resourcestr.rsclicksnapshot msgctxt "resourcestr.rsclicksnapshot" msgid "Click an Available Snapshot" msgstr "Клацніть на доступному зрізі" #: resourcestr.rscontentdated msgid "Content Dated" msgstr "Вміст датовано" #: resourcestr.rscopyfailed msgctxt "resourcestr.rscopyfailed" msgid "Copying orig to Backup directory failed" msgstr "Не вдалося скопіювати оригінал до каталогу резервних копій" #: resourcestr.rscreatenewrepo #, fuzzy #| msgid "Create a new Repo ?" msgctxt "resourcestr.rscreatenewrepo" msgid "Create a new Repository ?" msgstr "Створити новий репозиторій?" #: resourcestr.rsdeleteandreplace_1 msgctxt "resourcestr.rsdeleteandreplace_1" msgid "Notes at risk !" msgstr "Нотатки під ризиком !" #: resourcestr.rsdeleteandreplace_2 #, object-pascal-format msgctxt "resourcestr.rsdeleteandreplace_2" msgid "Delete all notes in %s and replace with snapshot dated %s ?" msgstr "Видалити всі нотатки в %s і замінити на зріз датований %s ?" #: resourcestr.rsdeleteddamaged #, object-pascal-format msgid "OK, deleted %d damaged notes" msgstr "ДОБРЕ, видалено %d пошкоджених нотаток" #: resourcestr.rsdownloaded msgid "Downloaded" msgstr "Завантажено" #: resourcestr.rsdownloadnotes msgid "Downloading notes" msgstr "Завантаження нотаток" #: resourcestr.rsenterhexvalue msgctxt "resourcestr.rsenterhexvalue" msgid "Enter the Hexadecimal value for a UTF8 character" msgstr "" #: resourcestr.rsenternewnotebook #, fuzzy #| msgid "Enter a new notebook name please" msgctxt "resourcestr.rsenternewnotebook" msgid "Enter a new Notebook name please" msgstr "Уведіть назву нового записника, будь ласка" #: resourcestr.rserrorcopyfile msgctxt "resourcestr.rserrorcopyfile" msgid "Failed to copy file, does destination dir exist ?" msgstr "Не вдалося скопіювати файл, цільовий каталог існує ?" #: resourcestr.rsfilesyncinfo1 msgid "tomboy-ng uses File Sync to sync to eg DropBox, Google Drive, a USB drive" msgstr "tomboy-ng використовує синхронізацію файлів, щоб синхронізувати на DropBox, Google Drive, пристрій USB і т.п." #: resourcestr.rsfilesyncinfo2 msgid "or uses a remote server over the internet with sshfs" msgstr "або використовує віддалений сервер поверх інтернету з sshfs" #: resourcestr.rsfindnavlefthint msgid "Backward Find : Shift-F3 or Shift-Ctrl-G" msgstr "Зворотній пошук : Shift-F3 або Shift-Ctrl-G" #: resourcestr.rsfindnavlefthintmac msgid "Backward Find : Shift-Command-G" msgstr "Зворотній пошук : Shift-Command-G" #: resourcestr.rsfindnavrighthint msgid "Find : F3 or Ctrl-G" msgstr "Шукати : F3 або Ctrl-G" #: resourcestr.rsfindnavrighthintmac msgid "Find : Command-G" msgstr "Шукати : Command-G" #: resourcestr.rsfound msgctxt "resourcestr.rsfound" msgid "Found" msgstr "Знайдено" #: resourcestr.rsgithubsyncinfo1 msgid "tomboy-ng can use Github to both sync and display or edit notes" msgstr "tomboy-ng може використовувати Github для показу і синхронізації, та для редагування нотаток" #: resourcestr.rsgithubsyncinfo2 msgid "you should read the tomboy-ng wiki page for instructions." msgstr "прочитайте сторінки вікі tomboy-ng для інструкцій." #: resourcestr.rsgithubtokenexpired msgid "Github Token may have expired" msgstr "Токен Github напевно застарів" #: resourcestr.rshelpconfig msgctxt "resourcestr.rshelpconfig" msgid "Create or use an alternative config" msgstr "Створити або використовувати конфіґ" #: resourcestr.rshelpdebug msgctxt "resourcestr.rshelpdebug" msgid "Direct debug output to SOME.LOG." msgstr "Пряме виведення зневадження у SOME.LOG." #: resourcestr.rshelpdebugindex msgctxt "resourcestr.rshelpdebugindex" msgid "Show debug msgs while indexing notes" msgstr "Показувати повідомлення зневадження під час індексування нотаток" #: resourcestr.rshelpdebugspell msgctxt "resourcestr.rshelpdebugspell" msgid "Show debug messages while spell setup" msgstr "Показувати повідомлення зневадження під час налаштування правопису" #: resourcestr.rshelpdebugsync msgctxt "resourcestr.rshelpdebugsync" msgid "Show debug messages during Sync" msgstr "Показувати повідомлення зневадження під час синхронізації" #: resourcestr.rshelpdelay msgctxt "resourcestr.rshelpdelay" msgid "Delay startup 2 sec to allow OS to settle" msgstr "Затримати запуск на 2 сек., щоб дозволити ОС запуститися" #: resourcestr.rshelphelp msgctxt "resourcestr.rshelphelp" msgid "Show this help message and exit." msgstr "Показати це повідомлення довідки і вийти." #: resourcestr.rshelpimportfile #, fuzzy #| msgid "Import file into Note Repo" msgid "Import file into Note Directory" msgstr "Імпортувати файл у репозиторій нотаток" #: resourcestr.rshelplang msgctxt "resourcestr.rshelplang" msgid "Force Language, en, es, uk, fr, nl" msgstr "Примусово вказати мову, en, es, uk, fr, nl" #: resourcestr.rshelpnosplash msgctxt "resourcestr.rshelpnosplash" msgid "Do not show small status/splash window" msgstr "Не показувати мале вспливне вікно стану" #: resourcestr.rshelpsaveexit msgctxt "resourcestr.rshelpsaveexit" msgid "After import single note, save & exit" msgstr "Після імпортування одної нотатки, зберегти і вийти" #: resourcestr.rshelpsinglenote msgctxt "resourcestr.rshelpsinglenote" msgid "Open indicated note, switch is optional" msgstr "Відкрити визначену нотатку, перемикання не обовʼязкове" #: resourcestr.rshelptitleisfname msgid "Use Filename as title for import txt & md" msgstr "Використовувати назву файлу як заголовок для імпортування txt та md" #: resourcestr.rshelpversion msgctxt "resourcestr.rshelpversion" msgid "Print version and exit" msgstr "Показати версію і вийти" #: resourcestr.rshexcharrequired msgid "2, 4, 6 or 8 Hex Characters Required" msgstr "" #: resourcestr.rslastchange msgid "Last Change" msgstr "Востаннє змінено" #: resourcestr.rslastsync msgid "Last Sync" msgstr "Остання синхронізація" #: resourcestr.rslookingatnotes msgctxt "resourcestr.rslookingatnotes" msgid "Looking at notes ...." msgstr "Перегляд нотаток ...." #: resourcestr.rslookingserverid msgid "Looking for ServerID" msgstr "Перегляд ServerID" #: resourcestr.rsmenuabout msgctxt "resourcestr.rsmenuabout" msgid "About" msgstr "Про програму" #: resourcestr.rsmenuhelp msgctxt "resourcestr.rsmenuhelp" msgid "Help" msgstr "Довідка" #: resourcestr.rsmenunewnote msgctxt "resourcestr.rsmenunewnote" msgid "New Note" msgstr "Нова нотатка" #: resourcestr.rsmenuquit msgctxt "resourcestr.rsmenuquit" msgid "Quit" msgstr "Вийти" #: resourcestr.rsmenusearch msgctxt "resourcestr.rsmenusearch" msgid "Search" msgstr "Пошук" #: resourcestr.rsmenusettings msgctxt "resourcestr.rsmenusettings" msgid "Settings" msgstr "Налаштувати" #: resourcestr.rsmenusync msgctxt "resourcestr.rsmenusync" msgid "Synchronise" msgstr "Синхронізувати" #: resourcestr.rsmetadirwarning msgid "Please remember that to ensure a reliable sync, you must not change files in the Meta directory." msgstr "Памʼятайте, що для забезпечення надійної синхронізації не можна змінювати файли в каталозі Meta." #: resourcestr.rsmultiplenotebooks msgctxt "resourcestr.rsmultiplenotebooks" msgid "Settings allow multiple Notebooks" msgstr "Налаштування дозволяють багато записників" #: resourcestr.rsname msgid "Name" msgstr "Назва" #: resourcestr.rsnewerversionexits msgctxt "resourcestr.rsnewerversionexits" msgid "A newer version exists in main repo" msgstr "Новіша версія існує в основному репозиторії" #: resourcestr.rsnoothernotes msgid "No other notes link to this one" msgstr "" #: resourcestr.rsnotavailable msgid "Not Available" msgstr "Не доступно" #: resourcestr.rsnotealreadyinrepo #, fuzzy #| msgid "Note already in Repo" msgctxt "resourcestr.rsnotealreadyinrepo" msgid "Note already in Repository" msgstr "Нотатка вже в репозиторії" #: resourcestr.rsnotebookoptionctrl msgid "Ctrl click for Notebook Options" msgstr "Клацання Ctrl для параметрів записника" #: resourcestr.rsnotebookoptionright msgid "Right click for Notebook Options" msgstr "Праве клацання для параметрів записника" #: resourcestr.rsnotebooks msgctxt "resourcestr.rsnotebooks" msgid "Notebooks" msgstr "Записники" #: resourcestr.rsnoteopen msgctxt "resourcestr.rsnoteopen" msgid "You have that note open, please close and try again" msgstr "Ви маєте цю нотатку відкритою, будь ласка, закрийте і спробуйте ще раз" #: resourcestr.rsnotes msgctxt "resourcestr.rsnotes" msgid "notes" msgstr "нотаток" #: resourcestr.rsnotesdeleted msgid "Note or notes deleted" msgstr "Нотатку або нотатки видалено" #: resourcestr.rsnotesinsnap msgctxt "resourcestr.rsnotesinsnap" msgid "Notes in Snapshot" msgstr "Нотаток у зрізі" #: resourcestr.rsnoteslinked msgid "Notes that link to this one" msgstr "" #: resourcestr.rsnotpresent msgctxt "resourcestr.rsnotpresent" msgid "Not present in main repo" msgstr "Немає в основному репозиторії" #: resourcestr.rsnumbnotesaffected #, object-pascal-format msgid "This will affect %d notes" msgstr "Це вплине на %d нотаток" #: resourcestr.rsonenotebook msgctxt "resourcestr.rsonenotebook" msgid "Settings allow only one Notebook" msgstr "Налаштування дозволяють лише один записник" #: resourcestr.rsoverwritenote msgctxt "resourcestr.rsoverwritenote" msgid "Overwrite newer version of that note" msgstr "Перезаписати новішу версію цієї нотатки" #: resourcestr.rspressclose msgctxt "resourcestr.rspressclose" msgid "Press Close" msgstr "Натисніть Закрити" #: resourcestr.rsrecoverok msgctxt "resourcestr.rsrecoverok" msgid "OK, File recovered." msgstr "Добре, файл відновлено." #: resourcestr.rsrenamefailed msgctxt "resourcestr.rsrenamefailed" msgid "ERROR, could not rename Backup File " msgstr "ПОМИЛКА, неможливо перейменувати файл резервної копії " #: resourcestr.rsrollbackintro msgid "You can roll back to previous version of this note" msgstr "Ви можете відкотитися до попередньої версії цієї нотатки" #: resourcestr.rsrunningsync msgctxt "resourcestr.rsrunningsync" msgid "Running Sync" msgstr "Працює синхронізація" #: resourcestr.rssaveandsync msgctxt "resourcestr.rssaveandsync" msgid "Press Save and Sync if this looks OK" msgstr "Натисніть зберегти і синхронізувати, якщо все виглядає добре" #: resourcestr.rsscanremote msgid "Scanning remote files" msgstr "Сканування віддалених файлів" #: resourcestr.rssearchhint msgid "Exact matches for terms between \" \"" msgstr "Точні збіги термінів між \" \"" #: resourcestr.rssetthenotebooks #, fuzzy #| msgid "Set the notebooks this note is a member of" msgctxt "resourcestr.rssetthenotebooks" msgid "Set the Notebooks this note is a member of" msgstr "Вкажіть записник, частиною якого є ця нотатка" #: resourcestr.rssetup msgctxt "resourcestr.rssetup" msgid "Setup" msgstr "Встановлення" #: resourcestr.rssetupnotesdirfirst msgctxt "resourcestr.rssetupnotesdirfirst" msgid "Please setup a notes directory first" msgstr "Налаштуйте спочатку каталог для нотаток" #: resourcestr.rssetupsyncfirst msgctxt "resourcestr.rssetupsyncfirst" msgid "Please config sync system first" msgstr "Налаштуйте спочатку систему синхронізації" #: resourcestr.rssnapshotcreated msgctxt "resourcestr.rssnapshotcreated" msgid "created, do you want to copy it elsewhere ?" msgstr "створено, бажаєте скопіювати деінде ?" #: resourcestr.rssyncclash msgid "A Sync Clash has occurred" msgstr "" #: resourcestr.rssyncclashadvice msgid "Run the Sync from Main Menu to resolve" msgstr "" #: resourcestr.rssyncerror msgctxt "resourcestr.rssyncerror" msgid "A Sync Error occurred" msgstr "Відбулася помилка синхронізації" #: resourcestr.rssyncnotconfig msgctxt "resourcestr.rssyncnotconfig" msgid "not configured" msgstr "не налаштовано" #: resourcestr.rssynctypefile msgid "File Sync - local or shared filesystem" msgstr "" #: resourcestr.rssynctypegithub msgid "Github - free Github account required" msgstr "" #: resourcestr.rstestingcredentials msgid "Testing Credentials" msgstr "Тестування облікових даних" #: resourcestr.rstestingrepo #, fuzzy #| msgid "Testing Repo ...." msgctxt "resourcestr.rstestingrepo" msgid "Testing Repository ...." msgstr "Тестування репозиторію ...." #: resourcestr.rstestingsync msgctxt "resourcestr.rstestingsync" msgid "Testing Sync" msgstr "Тестування синхронізації" #: resourcestr.rstryrecover_1 msgid "Try to recover a bad note by double clicking below," msgstr "Спробуйте відновити погану нотатку подвійним клацанням нижче," #: resourcestr.rstryrecover_2 msgctxt "resourcestr.rstryrecover_2" msgid "if that fails, you may be able to recover it from a Snapshot." msgstr "якщо це не вдалося, можете відновити її зі зрізу." #: resourcestr.rsunabletoproceed msgctxt "resourcestr.rsunabletoproceed" msgid "Unable to proceed because" msgstr "Неможливо обробити, тому що" #: resourcestr.rsunabletosync msgctxt "resourcestr.rsunabletosync" msgid "Unable to sync because " msgstr "Неможливо синхронізувати, тому що" #: resourcestr.rsuploaded msgid "Uploaded" msgstr "Вивантажено" #: resourcestr.rsuploading msgid "Uploading" msgstr "Вивантаження" #: resourcestr.rsutf8charlist msgid "Click here to browse to full list" msgstr "" #: resourcestr.rswarnnossystray msgid "WARNING, your Desktop might not display SysTray" msgstr "ПОПЕРЕДЖЕННЯ, Ваша стільниця може не відображати системний лоток" #: resourcestr.rswehavesnapshots #, object-pascal-format msgid "We have %d snapshots" msgstr "У нас %d зрізів" #: settings.rsdictionaryfailed msgid "Library Not Loaded" msgstr "Бібліотеку не завантажено" #: settings.rsdictionaryloaded msgid "Dictionary Loaded OK" msgstr "Словник завантажений ДОБРЕ" #: settings.rsdictionarynotfound msgid "No Dictionary Found" msgstr "Не знайдено словника" #: settings.rsdirhasnonotes msgid "That directory does not contain any notes. That is OK, if I can make my own there." msgstr "У цьому каталозі нема жодних нотаток. Добре, якщо я зможу створити там свої власні." #: settings.rserrorcannotwrite msgid "Cannot write into" msgstr "Неможливо писати в" #: settings.rserrorcreatedir msgid "Unable to Create Directory" msgstr "Неможливо створити каталог" #: settings.rsselectdictionary msgid "Select the dictionary you want to use" msgstr "Виберіть словник, який бажаєте використовувати" #: settings.rsselectlibrary msgid "Select your hunspell library" msgstr "Виберіть свою бібліотеку hunspell" #: spelling.rscheckingfull msgid "Checking full document" msgstr "Перевірка повного документа" #: spelling.rscheckingselection msgid "Checking selection" msgstr "Перевірка вибраного" #: spelling.rsreplace_with_1 msgid "replace" msgstr "замінити" #: spelling.rsreplace_with_2 msgid "with" msgstr "на" #: spelling.rsspellcomplete msgid "Spell check complete" msgstr "Перевірку правопису завершено" #: spelling.rsspellnotconfig msgid "Spelling not configured" msgstr "Правопис не налаштовано" #: syncutils.rschangeexistingsync msgid "Change existing sync connection ?" msgstr "Змінити наявне зʼєднання синхронізації ?" #: syncutils.rsclashes msgid "Clashes " msgstr "Зіткнення " #: syncutils.rsdonothing msgid "Do Nothing " msgstr "Нічого не робити" #: syncutils.rsdownloads msgid "Downloads " msgstr "Завантаження " #: syncutils.rsedituploads msgid "Edit Uploads " msgstr "Змінити вивантаження" #: syncutils.rslocaldeletes msgid "Local Deletes " msgstr "Локальні видалення" #: syncutils.rsnewuploads msgid "New Uploads " msgstr "Нові вивантаження" #: syncutils.rsnextbitslow msgid "Next bit can be a bit slow, please wait" msgstr "Наступний біт може бути трохи повільним, будь ласка, зачекайте" #: syncutils.rsnonotesneededsync msgid "No notes needed syncing. You need to write more." msgstr "Нема нотаток для синхронізації. Пишіть більше." #: syncutils.rsnotesweredealt msgid " notes were dealt with." msgstr " нотаток опрацьовано." #: syncutils.rsnotrecommend msgid "Generally not recommended." msgstr "Загалом не рекомендується." #: syncutils.rsremotedeletes msgid "Remote Deletes " msgstr "Віддалені видалення " #: syncutils.rssyncerrors msgid "ERRORS (see console log) " msgstr "ПОМИЛКИ (дивіться журнал консолі)" #: teditboxform.buttmaintbmenu.caption msgctxt "teditboxform.buttmaintbmenu.caption" msgid "Menu" msgstr "Меню" #: teditboxform.editfind.text msgid "EditFind" msgstr "ЗмінаПошуку" #: teditboxform.label2.caption msgid "Read Only" msgstr "Лише для читання" #: teditboxform.label3.caption msgid "This note has been changed by the Sync Process" msgstr "Цю нотатку змінено процесом синхронізації" #: teditboxform.label4.caption msgid "Please close it (and re-open if it was a download)" msgstr "Закрийте це (і відкрийте ще раз, коли воно завантажеться)" #: teditboxform.menubold.caption msgctxt "teditboxform.menubold.caption" msgid "Bold" msgstr "Грубий" #: teditboxform.menufindnext.caption msgid "Find Next" msgstr "Шукати наступне" #: teditboxform.menufindprev.caption msgctxt "teditboxform.menufindprev.caption" msgid "Find Prev" msgstr "Шукати попереднє" #: teditboxform.menufixedwidth.caption msgid "Fixed Width" msgstr "Фіксованої ширини" #: teditboxform.menuhighlight.caption msgctxt "teditboxform.menuhighlight.caption" msgid "Highlight" msgstr "Підсвічений" #: teditboxform.menuhuge.caption msgctxt "teditboxform.menuhuge.caption" msgid "Huge" msgstr "Величезний" #: teditboxform.menuitalic.caption msgid "Italic" msgstr "Похилий" #: teditboxform.menuitembulletleft.caption #, fuzzy #| msgid "Bullet <<" msgid "Bullet -" msgstr "Список <<" #: teditboxform.menuitembulletright.caption #, fuzzy #| msgid "Bullet >>" msgid "Bullet +" msgstr "Список >>" #: teditboxform.menuitemcopy.caption msgid "Copy" msgstr "Копіювати" #: teditboxform.menuitemcopyplain.caption msgid "Copy Plain" msgstr "" #: teditboxform.menuitemcut.caption msgid "Cut" msgstr "Вирізати" #: teditboxform.menuitemdelete.caption msgctxt "teditboxform.menuitemdelete.caption" msgid "Delete" msgstr "Видалити" #: teditboxform.menuitemevaluate.caption msgid "Evaluate" msgstr "Обрахувати" #: teditboxform.menuitemexport.caption msgid "Export" msgstr "Експортувати" #: teditboxform.menuitemexportmarkdown.caption msgid "Export Markdown" msgstr "Експортувати в Markdown" #: teditboxform.menuitemexportpdf.caption msgid "Export PDF" msgstr "" #: teditboxform.menuitemexportplaintext.caption msgid "Export Plain Text" msgstr "Експортувати в звичайний текст" #: teditboxform.menuitemexportrtf.caption msgid "Export RTF" msgstr "Експортувати в RTF" #: teditboxform.menuitemfind.caption msgid "Find in this Note" msgstr "Шукати в цій нотатці" #: teditboxform.menuitemindex.caption msgid "Index" msgstr "Індекс" #: teditboxform.menuitempaste.caption msgid "Paste" msgstr "Вставити" #: teditboxform.menuitemprint.caption msgid "Print" msgstr "Друкувати" #: teditboxform.menuitemselectall.caption msgid "Select All" msgstr "Вибрати все" #: teditboxform.menuitemsettings.caption msgctxt "teditboxform.menuitemsettings.caption" msgid "Settings" msgstr "Налаштувати" #: teditboxform.menuitemspell.caption msgid "Spell Check" msgstr "Перевірка правопису" #: teditboxform.menuitemsync.caption msgid "Synchronize" msgstr "Синхронізувати" #: teditboxform.menularge.caption msgid "Large Font" msgstr "Великий шрифт" #: teditboxform.menunormal.caption msgid "Normal Font" msgstr "Звичайний шрифт" #: teditboxform.menusmall.caption msgid "Small Font" msgstr "Малий шрифт" #: teditboxform.menustayontop.caption msgid "Stay On Top" msgstr "Тримати зверху" #: teditboxform.menustrikeout.caption msgid "Strikeout" msgstr "Закреслений" #: teditboxform.menuunderline.caption msgid "Underline" msgstr "Підкреслений" #: teditboxform.speedbuttondelete.hint msgid "Delete this note" msgstr "Видалити цю нотатку" #: teditboxform.speedbuttonlink.hint #, fuzzy #| msgid "Link highlighted text to a new note" msgid "Create new linked note (text selected) or display Backlinks." msgstr "Виділений текст посилання на нову нотатку" #: teditboxform.speedbuttonnotebook.hint msgid "Manage Notebooks" msgstr "Керування записниками" #: teditboxform.speedbuttonsearch.hint msgid "Search All Notes Ctrl-Shift-F" msgstr "Пошук усіх нотаток Ctrl-Shift-F" #: teditboxform.speedbuttontext.hint msgid "Font size, bold, italics etc" msgstr "Розмір шрифту, грубий, похилий і т.п." #: teditboxform.speedbuttontools.hint msgid "Tools - Sync, Export, Spell" msgstr "Засоби — Синхронізація, Експортування, Правопис" #: teditboxform.speedclose.caption #, fuzzy msgctxt "teditboxform.speedclose.caption" msgid "Close" msgstr "Закрити" #: teditboxform.speedrollback.hint msgid "Roll Back" msgstr "Відкотити" #: teditboxform.speedsymbol.hint msgid "Insert extended character or symbol" msgstr "" #: tformbackupview.buttondelete.caption msgctxt "tformbackupview.buttondelete.caption" msgid "Delete" msgstr "Видалити" #: tformbackupview.buttondelete.hint msgid "Really, totally delete this note." msgstr "Дійсно, повіністю видалити цю нотатку." #: tformbackupview.buttonok.caption msgctxt "tformbackupview.buttonok.caption" msgid "Close" msgstr "Закрити" #: tformbackupview.buttonok.hint msgid "My work here is done." msgstr "Моя робота тут завершена." #: tformbackupview.buttonopen.caption msgid "View" msgstr "Переглянути" #: tformbackupview.buttonopen.hint msgid "Open and view the whole note" msgstr "Відкрити і переглянути нотатку повністю" #: tformbackupview.buttonrecover.caption msgctxt "tformbackupview.buttonrecover.caption" msgid "Recover" msgstr "Відновити" #: tformbackupview.buttonrecover.hint msgid "Restore this note to main repo" msgstr "Відновити цю нотатку до основного репозиторію" #: tformbackupview.caption msgid "View, recover or delete Backup Files" msgstr "Перегляд, відновлення або видалення файлів резервної копії" #: tformbackupview.listbox1.hint msgid "Use Ctrl or Shift to select multiple entries" msgstr "Використовуйте Ctrl або Shift, щоб вибрати кілька записів" #: tformcolours.label1.caption msgid "Sample" msgstr "Зразок" #: tformcolours.label2.caption msgctxt "tformcolours.label2.caption" msgid "Set Colours" msgstr "Вказати кольори" #: tformcolours.speedbackground.caption msgid "Background" msgstr "Фон" #: tformcolours.speedcancel.caption msgctxt "tformcolours.speedcancel.caption" msgid "Cancel" msgstr "Скасувати" #: tformcolours.speeddefault.caption msgid "Default" msgstr "Типово" #: tformcolours.speedhighlight.caption msgctxt "tformcolours.speedhighlight.caption" msgid "Highlight" msgstr "Підсвічування" #: tformcolours.speedlinks.caption msgid "Links" msgstr "" #: tformcolours.speedok.caption msgctxt "tformcolours.speedok.caption" msgid "OK" msgstr "Гаразд" #: tformcolours.speedtext.caption msgid "Text" msgstr "Текст" #: tformcolours.speedtitle.caption msgctxt "tformcolours.speedtitle.caption" msgid "Title" msgstr "Заголовок" #: tformindex.caption msgid "Heading in this Note" msgstr "Заголовки в цій нотатці" #: tformindex.panel1.caption msgid "Single lines, all Huge, Large Bold or Large" msgstr "Одинарні рядки, всі великі, довгі грубі або довгі" #: tformkmemo2pdf.caption msgid "PDF Issues" msgstr "" #: tformrecover.buttondeletebadnotes.caption msgid "Delete Bad Notes" msgstr "Видалити погані нотатки" #: tformrecover.buttonmakesafetysnap.caption msgid "Take a manual Snapshot" msgstr "Зробити зріз вручну" #: tformrecover.buttonmakesafetysnap.hint msgid "Take a initial snapshot of your notes and config. Overwritten each time." msgstr "Зробити початковий зріз ваших нотаток і налаштувань. Щоразу перезаписується." #: tformrecover.buttonrecoversnap.caption msgctxt "tformrecover.buttonrecoversnap.caption" msgid "Recover" msgstr "Відновити" #: tformrecover.buttonsnaphelp.caption msgid "Snapshot Help" msgstr "Довідка про зрізи" #: tformrecover.label10.caption msgid "Please close any notes you may have open." msgstr "Будь ласка, закрийте будь-які нотатки, які Ви відкрили." #: tformrecover.label12.caption msgid "Don't even consider this unless you have a backup Snapshot, Intro Tab." msgstr "Навіть не розглядайте це, якщо у вас нема резервної копії зразу, вкладка Intro." #: tformrecover.label14.caption msgid "Click an available snapshot to see its contents." msgstr "Клацніть по доступному зрізі, щоб побачити його вміст." #: tformrecover.label15.caption msgid "Click an available snapshot, click Recover" msgstr "Клацніть по доступному зрізі, клацніть Відновити" #: tformrecover.label16.caption msgid "You may chose to view, copy and paste into a new note." msgstr "Ви можете обрати перегляд, копіювання або вставити в нову нотатку." #: tformrecover.label2.caption msgid "Please be careful, this is a dangerous place!" msgstr "Будьте обережні, це небезпечне місце!" #: tformrecover.label3.caption msgid "Restore any notes in the snapshot that are not in the existing notes directory." msgstr "Відновити будь-які нотатки в зрізі, яких нема в наявному каталозі нотаток." #: tformrecover.label4.caption msgid "Remove all existing notes and use the ones in the Snapshot." msgstr "Вилучити всі наявні нотатки і використовувати нотатки зі зрізу." #: tformrecover.label5.caption msgid "Looking for notes with damaged XML" msgstr "Перегляд нотаток із пошкодженим XML" #: tformrecover.label6.caption msgid "This tool might help you recover lost or damaged notes." msgstr "Цей засіб може допомогти Вам відновити втрачені або пошкоджені нотатки." #: tformrecover.label7.caption msgid "Before you start, take a Snapshot of your notes directory." msgstr "Перед початком, зробіть зріз каталогу з Вашими нотатками." #: tformrecover.label9.caption msgid "From here you can view snapshot notes, one by one." msgstr "Звідси ви можете переглядати нотатки зрізів одна за одною." #: tformrecover.listboxsnapshots.hint msgid "These are the currently known snapshots. " msgstr "Це відомі зараз зрізи. " #: tformrecover.panelsnapshots.caption msgid "Available Snapshots" msgstr "Доступні зрізи" #: tformrecover.tabsheetbadnotes.caption msgid "Bad Notes" msgstr "Погані нотатки" #: tformrecover.tabsheetintro.caption msgid "Introduction" msgstr "Ознайомлення" #: tformrecover.tabsheetmergesnapshot.caption msgid "Merge Snapshot" msgstr "Обʼєднати зріз" #: tformrecover.tabsheetrecovernotes.caption msgid "Recover Notes" msgstr "Відновити нотатки" #: tformrecover.tabsheetrecoversnapshot.caption msgid "Recover Snapshot" msgstr "Відновити зріз" #: tformrollback.speedcancel.caption msgctxt "tformrollback.speedcancel.caption" msgid "Cancel" msgstr "Скасувати" #: tformrollback.speedrolltoopen.caption msgid "Opening Backup" msgstr "Відкривання резервної копії" #: tformrollback.speedrolltotitle.caption msgid "Title Change Backup" msgstr "Змінити заголовок резервної копії" #: tformsdiff.bitbtnuselocal.caption msgid "Use Local" msgstr "Викор. локальний" #: tformsdiff.bitbtnuseremote.caption msgid "Use Remote" msgstr "Викор. віддалений" #: tformsdiff.buttalllocal.caption msgid "Local" msgstr "Локальний" #: tformsdiff.buttallnewest.caption msgid "Newest" msgstr "Новий" #: tformsdiff.buttalloldest.caption msgid "Oldest" msgstr "Старий" #: tformsdiff.buttallremote.caption msgid "Remote" msgstr "Віддалений" #: tformsdiff.caption msgid "A Note Sync Clash has been Detected" msgstr "Виявлено стик синхронізації нотаток" #: tformsdiff.label1.caption msgid "Or make a choice for remainder of this run" msgstr "Або зробіть вибір про нагадування про цей запуск" #: tformsdiff.label3.caption msgid "Remote Changed" msgstr "Віддалений змінено" #: tformsdiff.label4.caption msgid "Local Changed" msgstr "Локальний змінено" #: tformsdiff.radiolong.caption msgid "Long Lines" msgstr "Довгі рядки" #: tformsdiff.radiolong.hint msgid "Maybe necessary to show difference" msgstr "Можливо, потрібно показати відмінності" #: tformsdiff.radioshort.caption msgid "Short Lines" msgstr "Короткі рядки" #: tformsdiff.radioshort.hint msgid "Easier to read" msgstr "Легше для читання" #: tformspell.buttonignore.caption msgid "Ignore" msgstr "Ігнорувати" #: tformspell.buttonignore.hint msgid "Ignore all instances for the run" msgstr "Іґнорувати всі екземпляри запуску" #: tformspell.buttonskip.caption msgid "Skip" msgstr "Пропустити" #: tformspell.buttonskip.hint msgid "Skip just this instance" msgstr "Пропустити лише для цього екземпляра" #: tformspell.buttonuseandnextword.caption msgid "Use and Next Word" msgstr "Використати і наступне слово" #: tformspell.caption msgctxt "tformspell.caption" msgid "Spell" msgstr "Правопис" #: tformspell.label4.caption msgid "Suspect word -" msgstr "Сумнівне слово -" #: tformspell.labelprompt.caption msgid "Click a word to use it." msgstr "Клацніть по слові для використання" #: tformsymbol.bitbtnrevert.caption msgid "Revert" msgstr "" #: tformsymbol.caption msgid "Symbol" msgstr "" #: tformsymbol.stringgrid1.columns[0].title.caption #, fuzzy msgctxt "tformsymbol.stringgrid1.columns[0].title.caption" msgid "Title" msgstr "Заголовок" #: tformsymbol.stringgrid1.columns[1].title.caption #, fuzzy msgctxt "tformsymbol.stringgrid1.columns[1].title.caption" msgid "Title" msgstr "Заголовок" #: tformsync.buttoncancel.caption msgctxt "tformsync.buttoncancel.caption" msgid "Cancel" msgstr "Скасувати" #: tformsync.buttonclose.caption msgctxt "tformsync.buttonclose.caption" msgid "Close" msgstr "Закрити" #: tformsync.buttonsave.caption msgid "Save and Sync" msgstr "Зберегти і синхронізувати" #: tformsync.caption msgctxt "tformsync.caption" msgid "Sync" msgstr "Синхронізація" #: tformsync.listviewreport.columns[0].caption msgid "Action" msgstr "Дія" #: tformsync.listviewreport.columns[1].caption msgctxt "tformsync.listviewreport.columns[1].caption" msgid "Title" msgstr "Заголовок" #: tformsync.listviewreport.columns[2].caption msgid "Note ID" msgstr "ІД нотатки" #: tmainform.bitbtnhide.caption msgid "Hide" msgstr "Сховати" #: tmainform.bitbtnquit.caption msgctxt "tmainform.bitbtnquit.caption" msgid "Quit" msgstr "Вийти" #: tmainform.buttmenu.caption msgctxt "tmainform.buttmenu.caption" msgid "Menu" msgstr "Меню" #: tmainform.buttsystrayhelp.caption msgid "SysTray Help" msgstr "Довідка про системний лоток" #: tmainform.caption msgid "tomboy-ng" msgstr "tomboy-ng" #: tmainform.checkboxdontshow.caption msgid "Don't Show for normal startup" msgstr "Не показувати це під час запуску" #: tmainform.checkboxdontshow.hint msgid "You can reverse this from Settings" msgstr "Ви можете обернути це в Налаштуваннях" #: tmainform.hint msgid "If the yellow tomboy-ng icon is visible in your System Tray, you can dismiss this window." msgstr "Якщо видно жовтий значок tomboy-ng у системному лотку, то можна закрити це вікно." #: tmainform.label3.caption msgid "Dictionary Config (optional)" msgstr "Налаштування словника (необовʼязкове)" #: tmainform.label4.caption msgid "Sync Config (optional)" msgstr "Налаштування синхронізації (необовʼязкове)" #: tmainform.label5.caption msgid "Welcome to tomboy-ng !" msgstr "Вітаємо в tomboy-ng !" #: tmainform.labelerror.hint msgid "Launch from commandline to see errors or see Config->SnapShot->Recover ..." msgstr "Запустіть з командного рядка, щоб побачити помилки або перегляньте Налаштувати->Зріз->Відновити ..." #: tnotebookpick.button1.caption msgctxt "tnotebookpick.button1.caption" msgid "Cancel" msgstr "Скасувати" #: tnotebookpick.buttonok.caption msgctxt "tnotebookpick.buttonok.caption" msgid "OK" msgstr "Гаразд" #: tnotebookpick.caption #, fuzzy msgctxt "tnotebookpick.caption" msgid "Notebooks" msgstr "Записники" #: tnotebookpick.label4.caption msgid "Name of the New Notebook" msgstr "Назва нового записника" #: tnotebookpick.label5.caption #, fuzzy #| msgid "Press OK and we will make the Note Book AND add this note to it." msgid "Press OK and we will make the Notebook AND add this note to it." msgstr "Натисніть Гаразд і ми створимо записник і додамо в нього цю нотатку." #: tnotebookpick.label6.caption msgid "Existing Name" msgstr "Наявна назва" #: tnotebookpick.label8.caption msgid "New Name" msgstr "Нова назва" #: tnotebookpick.label9.caption #, fuzzy #| msgid "If you sync and are not absolutely sure its up to date, Cancel now !" msgid "If you sync and are not absolutely sure it is up to date, Cancel now !" msgstr "Якщо ви синхронізуєте і не впевнені, що він оновлений, Скасуйте негайно !" #: tnotebookpick.tabchangename.caption msgid "Change Notebook Name" msgstr "Змінити назву записника" #: tnotebookpick.tabexisting.caption msgid "Existing Note Books" msgstr "Наявний записник" #: tnotebookpick.tabnewnotebook.caption msgid "New Note Book" msgstr "Новий записник" #: tnotebookpick.tabsetnotes.caption msgid "Set Notes" msgstr "Вказати нотатки" #: tsearchform.bitbtnmenu.caption #, fuzzy msgctxt "tsearchform.bitbtnmenu.caption" msgid "Menu" msgstr "Меню" #: tsearchform.buttonclearfilters.caption msgctxt "tsearchform.buttonclearfilters.caption" msgid "Clear" msgstr "Очистити" #: tsearchform.buttonclearsearch.caption #, fuzzy msgctxt "tsearchform.buttonclearsearch.caption" msgid "Clear" msgstr "Очистити" #: tsearchform.buttonsearchoptions.caption #, fuzzy msgctxt "tsearchform.buttonsearchoptions.caption" msgid "Options" msgstr "Параметри" #: tsearchform.caption msgid "tomboy-ng_Search" msgstr "tomboy-ng_Пошук" #: tsearchform.listboxnotebooks.hint msgid "Right Click to manage Notebooks" msgstr "Праве клацання для керування записниками" #: tsearchform.menucreatenotebook.caption #, fuzzy #| msgid "Create new Note Book" msgid "Create new Notebook" msgstr "Створити новий записник" #: tsearchform.menudeletenotebook.caption msgid "Delete Notebook" msgstr "Видалити записник" #: tsearchform.menueditnotebooktemplate.caption msgid "Edit Notebook Template" msgstr "Змінити шаблон записника" #: tsearchform.menuitemcasesensitive.caption msgctxt "tsearchform.menuitemcasesensitive.caption" msgid "Case Sensitive" msgstr "Чутливість до регістру" #: tsearchform.menuitemimportnote.caption msgid "Import File" msgstr "Імпортувати файл" #: tsearchform.menuitemmanagenbook.caption #, fuzzy #| msgid "Manage Notes in Note Book" msgid "Manage Notes in Notebook" msgstr "Керувати нотатками в записнику" #: tsearchform.menuitemswyt.caption msgid "Search While You Type" msgstr "Шукати під час введення" #: tsearchform.menunewnotefromtemplate.caption msgid "Create New Note from Template" msgstr "Створити нову нотатку зі шаблону" #: tsearchform.menurenamenotebook.caption #, fuzzy #| msgid "Rename NoteBook" msgid "Rename Notebook" msgstr "Перейменувати записник" #: tsearchform.panel2.caption msgctxt "tsearchform.panel2.caption" msgid "Notebooks" msgstr "Записники" #: tsett.buttonfixedfont.caption msgid "Fixed Font" msgstr "Фіксований шрифт" #: tsett.buttonfont.caption msgid "Usual Font" msgstr "Звичайний шрифт" #: tsett.buttonmanualsnap.caption msgid "Take a Manual Snapshot" msgstr "Зробити зріз вручну" #: tsett.buttonmanualsnap.hint msgid "Take a time stamped snapshot of notes and config" msgstr "Зробити зріз із штампом часу нотаток і налаштувань" #: tsett.buttonsetcolours.caption msgctxt "tsett.buttonsetcolours.caption" msgid "Set Colours" msgstr "Вказати кольори" #: tsett.buttonsetdictionary.caption msgid "Set Dictionary" msgstr "Вказати словник" #: tsett.buttonsetnotepath.caption msgid "Set Path to Note Files" msgstr "Вказати шлях до файлів з нотатками" #: tsett.buttonsetnotepath.hint msgid "If you have notes somewhere else" msgstr "Якщо ваші нотатки деінде" #: tsett.buttonsetspelllibrary.caption msgid "Set Spell Library" msgstr "Вказати бібліотеку правопису" #: tsett.buttonshowbackup.caption msgid "Show Me" msgstr "Показати мені" #: tsett.buttonsnaprecover.caption msgid "Recover Lost Notes" msgstr "Відновити втрачені нотатки" #: tsett.buttonsnaprecover.hint msgid "If you have previously taken a snapshot ..." msgstr "Якщо у вас є попередньо зроблений зріз ..." #: tsett.checkautosnapenabled.caption msgid "Use auto snapshots" msgstr "Використовувати автозрізи" #: tsett.checkautostart.caption msgid "Autostart at Logon" msgstr "Автозапуск під час входу в систему" #: tsett.checkescclosesnote.caption #, fuzzy #| msgid "Esc Closes Note" msgid "ESC Closes Note" msgstr "Esc закриває нотатку" #: tsett.checkfindtoggles.caption msgid "Find Command Toggles" msgstr "Перемикання команди пошуку" #: tsett.checkfindtoggles.hint msgctxt "tsett.checkfindtoggles.hint" msgid "eg Ctrl-F opens and closes Find Window" msgstr "напр., Ctrl-F відкриває і закриває вікно пошуку" #: tsett.checkmanynotebooks.caption msgid "Allow a Note to be in Multiple Notebooks." msgstr "Дозволити нотатці бути в декількох записниках." #: tsett.checkmanynotebooks.hint msgid "This may adversly affect traditional Tomboy, take care." msgstr "Це може негативно вплинути на традиційний Tomboy, будьте обережні." #: tsett.checknotifications.caption msgid "Show Notifications" msgstr "Показувати сповіщення" #: tsett.checkshowextlinks.caption #, fuzzy #| msgid "Show External Links" msgid "Show External Links" msgstr "Показувати зовнішні посилання" #: tsett.checkshowintlinks.caption msgid "Show Internal Links" msgstr "Показувати внутрішні посилання" #: tsett.checkshowsearchatstart.caption msgid "Show Search at Start" msgstr "Показувати Пошук під час запуску" #: tsett.checkshowsplash.caption msgid "Show Splash at Start" msgstr "Показувати вспливне вікно під час запуску" #: tsett.checkshowsplash.hint msgid "Always shown if error loading notes." msgstr "Завжди показується, якщо помилка завантаження нотаток." #: tsett.checkstampbold.caption msgctxt "tsett.checkstampbold.caption" msgid "Bold" msgstr "Грубий" #: tsett.checkstampitalics.caption msgid "Italics" msgstr "Похилий" #: tsett.checkstampsmall.caption msgctxt "tsett.checkstampsmall.caption" msgid "Small" msgstr "Малий" #: tsett.checkuseundo.caption msgid "Use Undo Redo (may slow editing)" msgstr "Викор. Скасувати Повторити (може сповільнити редагування)" #: tsett.checkuseundo.hint msgid "Close and reopen a note to take effect. Use Ctrl-Z Ctrl-Y" msgstr "Закрийте і перевідкрийте нотатку, щоб зміни ввійшли в дію. Викор. Ctrl-Z Ctrl-Y" #: tsett.combosynctiming.text msgid "ComboSyncTiming" msgstr "" #: tsett.combosynctype.hint msgid "Github or File Sync" msgstr "" #: tsett.groupbox4.caption msgctxt "tsett.groupbox4.caption" msgid "When a conflict is detected between a local note and remote one :" msgstr "Коли виник конфлікт між локальною нотаткою і віддаленою :" #: tsett.groupbox5.caption msgid "Font Size" msgstr "Розмір шрифту" #: tsett.groupboxsync.caption msgid " Sync " msgstr " Синхр. " #: tsett.groupboxtoken.caption msgctxt "tsett.groupboxtoken.caption" msgid "Token" msgstr "Токен" #: tsett.groupboxuser.caption msgctxt "tsett.groupboxuser.caption" msgid "User" msgstr "Користувач" #: tsett.groupnotespath.caption msgid "Notes Path" msgstr "" #: tsett.label1.caption msgid "Settings will be saved in :" msgstr "Налаштування зберігаютсья в :" #: tsett.label10.caption msgid "Help Notes Language" msgstr "Мова нотаток довідки" #: tsett.label11.caption msgid "Backup Files" msgstr "Файли резервних копій" #: tsett.label13.caption msgid "Spell Check requires the Hunspell Libraries and" msgstr "Перевірка правопису вимагає бібліотек Hunspell та" #: tsett.label14.caption msgid "an appropriate Hunspell Dictionary set." msgstr "вказаного відповідного словника Hunspell." #: tsett.label16.caption msgid "Maximum number of snapshots" msgstr "Найбільша кількість зрізів" #: tsett.label17.caption msgid "Date Stamp Format" msgstr "Формат штампу дати" #: tsett.label2.caption msgid "Notes will be looked for and saved in :" msgstr "Нотатки зберігаються в :" #: tsett.label4.caption msgid "Repo : " msgstr "Репозиторій : " #: tsett.label5.caption msgid "Days per snapshot" msgstr "Днів на зріз" #: tsett.label6.caption msgid "Backup files are made when you delete a note or the sync system" msgstr "Файли резервних копій створюються коли Ви видаляєте нотатку або синхронізуєте систему" #: tsett.label7.caption msgid "is about to overwrite one. " msgstr "це перезапише одну." #: tsett.label8.caption msgid "They remain, forever, unless you do something about them." msgstr "Вони залишаються назавжди, якщо з ними нічого не робити." #: tsett.label9.caption msgid "A snaphot is a copy of your current note directory." msgstr "Зріз — це копія вашого поточного каталогу з нотатками." #: tsett.labelsnapdir.caption msgid "Snap dir" msgstr "Каталог шматків" #: tsett.labelsyncrepo.caption msgctxt "tsett.labelsyncrepo.caption" msgid "not configured" msgstr "не налаштовано" #: tsett.labelsynctiming.caption msgid "Sync Timing" msgstr "" #: tsett.labelsynctype.caption msgid "Sync Type" msgstr "Тип синхронізації" #: tsett.menuitemcopytoken.caption msgid "Copy Existing Token" msgstr "Копіювати наявний токен" #: tsett.menuitemgettoken.caption msgid "Get a Token in your Browser" msgstr "Отримати токен у вашому оглядачі" #: tsett.menuitempastetoken.caption msgid "Paste a New Token" msgstr "Вставити новий токен" #: tsett.radioalwaysask.caption msgid "Always Ask me what to do." msgstr "Завжди запитувати мене, що робити." #: tsett.radiochoose.caption msgid "Choose" msgstr "" #: tsett.radiofontbig.caption msgid "Big" msgstr "Великий" #: tsett.radiofonthuge.caption msgctxt "tsett.radiofonthuge.caption" msgid "Huge" msgstr "Величезний" #: tsett.radiofontmedium.caption msgid "Medium" msgstr "Середній" #: tsett.radiofontsmall.caption msgctxt "tsett.radiofontsmall.caption" msgid "Small" msgstr "Малий" #: tsett.radiotomboydefault.caption msgid "Old Tomboy Default" msgstr "" #: tsett.radiotomboyngdefault.caption msgid "tomboy-ng Default" msgstr "" #: tsett.radiouselocal.caption msgid "Use Local Note and Overwrite Server Note." msgstr "Використовувати локальну нотатку і перезаписати нотатку на сервері." #: tsett.radiouseserver.caption msgid "Use Server Note and Rename Local Note." msgstr "Використовувати нотатку на сервері і перейменувати локальну нотатку." #: tsett.speedbuthelp.caption msgctxt "tsett.speedbuthelp.caption" msgid "Help" msgstr "Довідка" #: tsett.speedbuthide.caption msgctxt "tsett.speedbuthide.caption" msgid "Close" msgstr "Закрити" #: tsett.speedbutttbmenu.caption msgctxt "tsett.speedbutttbmenu.caption" msgid "Menu" msgstr "Меню" #: tsett.speedsetupsync.caption msgctxt "tsett.speedsetupsync.caption" msgid "Setup" msgstr "Встановлення" #: tsett.speedtokenactions.caption msgid "Actions" msgstr "Дії" #: tsett.tabbackup.caption msgid "BackUp" msgstr "Резервна копія" #: tsett.tabbasic.caption msgid "Basic" msgstr "Основне" #: tsett.tabdisplay.caption msgid "Notes" msgstr "Нотатки" #: tsett.tabrecover.caption msgctxt "tsett.tabrecover.caption" msgid "Recover" msgstr "Відновлення" #: tsett.tabspell.caption msgctxt "tsett.tabspell.caption" msgid "Spell" msgstr "Правопис" #: tsett.tabsync.caption msgctxt "tsett.tabsync.caption" msgid "Sync" msgstr "Синхронізація" tomboy-ng_0.39-1/po/tomboy-ng.es.po0000644000175000017500000013274414551457644016751 0ustar dbannondbannon# Spanish translation for Tomboy-ng. # This file is put in the public domain. # Roy W. Reese , 2018-2024. msgid "" msgstr "" "Project-Id-Version: tomboy-ng v0.39\n" "POT-Creation-Date: \n" "PO-Revision-Date: 2024-01-15 09:27+0100\n" "Last-Translator: RWR\n" "Language-Team: \n" "Language: es\n" "MIME-Version: 1.0\n" "Content-Type: text/plain; charset=UTF-8\n" "Content-Transfer-Encoding: 8bit\n" "Plural-Forms: nplurals=2; plural=(n != 1);\n" "X-Generator: Poedit 3.4.2\n" #: editbox.rsunabletoevaluate msgid "Unable to find an expression to evaluate" msgstr "Ninguna expresión encontrada para calcular" #: fpttf.rsmissingfontfile #, object-pascal-format msgid "The font file <%s> can't be found." msgstr "Archivo de la fuente <%s> no encontrado." #: fpttf.rsnofontfilename msgid "The FileName property is empty, so we can't load font data." msgstr "No podemos cargar la fuente porque la propiedad FileName está vacía." #: fpttf.rsnosearchpathdefined msgid "No search path was defined" msgstr "Falta la ruta de búsqueda" #: fpttf.serrfontnotfound #, object-pascal-format msgid "The font <%s> can't be found" msgstr "La fuente <%s> no encontrada" #: mainunit.rsabout msgid "tomboy-ng notes - cross platform, sync and manage notes." msgstr "Notas tomboy-ng - multiplataforma: sincronizar y gestionar notas." #: mainunit.rsaboutbdate msgid "Build date" msgstr "Fecha de compilación" #: mainunit.rsaboutcpu msgid "TargetCPU" msgstr "Arquitectura" #: mainunit.rsaboutoperatingsystem msgid "OS" msgstr "SO" #: mainunit.rsaboutver msgid "Version" msgstr "Versión" #: mainunit.rsfailedtoindex msgid "Failed to index one or more notes." msgstr "Fallo en indizar una nota o más." #: resourcestr.rsaddnotestonotebook msgid "Add notes to this Notebook" msgstr "Añadir notas al cuaderno" #: resourcestr.rsalldone msgctxt "resourcestr.rsalldone" msgid "All Done" msgstr "Todo hecho" #: resourcestr.rsallrestored msgctxt "resourcestr.rsallrestored" msgid "Notes and config files Restored, restart suggested." msgstr "Notas y configuración restablecidos. Se recomienda reiniciar." #: resourcestr.rsautosnapshotrun msgid "Completed autosnapshot run." msgstr "Instantánea automática hecha." #: resourcestr.rsautosyncnotpossible msgid "Auto sync not possible right now" msgstr "Sincronización automática imposible ahora mismo" #: resourcestr.rsbadnotes #, object-pascal-format msgid "You have %d bad notes in Notes Directory" msgstr "%d notas corrompidas en el directorio de las notas" #: resourcestr.rsbadnotesfound1 msgctxt "resourcestr.rsbadnotesfound1" msgid "Please go to Settings -> Recover -> Recover Notes" msgstr "Por favor, vaya a Preferencias -> Recuperar -> Recuperar notas" #: resourcestr.rsbadnotesfound2 msgctxt "resourcestr.rsbadnotesfound2" msgid "You should do so to ensure your notes are safe." msgstr "Debería hacerlo para salvaguardar sus notas." #: resourcestr.rscannotdelete msgctxt "resourcestr.rscannotdelete" msgid "Cannot delete " msgstr "No se puede eliminar " #: resourcestr.rscannotfindnote msgctxt "resourcestr.rscannotfindnote" msgid "ERROR, cannot find " msgstr "ERROR: no se encuentra " #: resourcestr.rschangenameofnotebook msgid "Change the name of this Notebook" msgstr "Cambiar el nombre de este cuaderno" #: resourcestr.rschangesync msgid "Change Sync Repo" msgstr "Cambiar repositorio de sincronización" #: resourcestr.rsclickbadnote msgctxt "resourcestr.rsclickbadnote" msgid "Double click on any Bad Notes" msgstr "Hacer doble clic en las notas corrompidas" #: resourcestr.rsclicksnapshot msgctxt "resourcestr.rsclicksnapshot" msgid "Click an Available Snapshot" msgstr "Hacer clic en una instantánea" # Puede ser contenido viejo #: resourcestr.rscontentdated msgid "Content Dated" msgstr "Contenido con fecha" #: resourcestr.rscopyfailed msgctxt "resourcestr.rscopyfailed" msgid "Copying orig to Backup directory failed" msgstr "Fallo en copiar al directorio de copias de seguridad" #: resourcestr.rscreatenewrepo msgctxt "resourcestr.rscreatenewrepo" msgid "Create a new Repo ?" msgstr "¿Crear un repositorio nuevo?" #: resourcestr.rsdeleteandreplace_1 msgctxt "resourcestr.rsdeleteandreplace_1" msgid "Notes at risk !" msgstr "¡Notas en peligro!" # Hecho más corto #: resourcestr.rsdeleteandreplace_2 #, object-pascal-format msgctxt "resourcestr.rsdeleteandreplace_2" msgid "Delete all notes in %s and replace with snapshot dated %s ?" msgstr "Eliminar todas en %s y reemplazarlas con la instantánea con fecha %s?" #: resourcestr.rsdeleteddamaged #, object-pascal-format msgid "OK, deleted %d damaged notes" msgstr "Eliminadas %d notas corrompidas" # Supongo refiere a descargar unas notas #: resourcestr.rsdownloaded msgid "Downloaded" msgstr "Descargadas" #: resourcestr.rsdownloadnotes msgid "Downloading notes" msgstr "Descargando notas" #: resourcestr.rsenterhexvalue msgctxt "resourcestr.rsenterhexvalue" msgid "Enter the Hexadecimal value for a UTF8 character" msgstr "Escribe el valor hexidecimal para el carácter UTF8" #: resourcestr.rsenternewnotebook msgctxt "resourcestr.rsenternewnotebook" msgid "Enter a new notebook name please" msgstr "Introduzca un nuevo nombre de cuaderno, por favor" #: resourcestr.rserrorcopyfile msgctxt "resourcestr.rserrorcopyfile" msgid "Failed to copy file, does destination dir exist ?" msgstr "El archivo no se copió. ¿Existe el directorio?" #: resourcestr.rsfilesyncinfo1 msgid "tomboy-ng uses File Sync to sync to eg DropBox, Google Drive, a USB drive" msgstr "tomboy-ng usa Sincronización de Archivos a DropBox, Google Drive, un disco USB, etc" #: resourcestr.rsfilesyncinfo2 msgid "or uses a remote server over the internet with sshfs" msgstr "o use un servidor remoto por internet con sshfs" #: resourcestr.rsfindnavlefthint msgid "Backward Find : Shift-F3 or Shift-Ctrl-G" msgstr "Buscar atrás: Mayús-F3 o Mayús-Ctrl-G" #: resourcestr.rsfindnavlefthintmac msgid "Backward Find : Shift-Command-G" msgstr "Buscar atrás: Mayús-Cmd-G" #: resourcestr.rsfindnavrighthint msgid "Find : F3 or Ctrl-G" msgstr "Buscar: F3 o Ctrl-G" #: resourcestr.rsfindnavrighthintmac msgid "Find : Command-G" msgstr "Buscar: Cmd-G" #: resourcestr.rsfound msgctxt "resourcestr.rsfound" msgid "Found" msgstr "Encontrada" #: resourcestr.rsgithubsyncinfo1 msgid "tomboy-ng can use Github to both sync and display or edit notes" msgstr "tomboy-ng puede usar Github para sincronizar, mostrar o editar notas" #: resourcestr.rsgithubsyncinfo2 msgid "you should read the tomboy-ng wiki page for instructions." msgstr "debería leer las instrucciones en la wiki de tomboy-ng." #: resourcestr.rsgithubtokenexpired msgid "Github Token may have expired" msgstr "Puede que el autentificador haya caducado" #: resourcestr.rshelpconfig msgctxt "resourcestr.rshelpconfig" msgid "Create or use an alternative config" msgstr "Crear o usar una configuración alternativa" #: resourcestr.rshelpdebug msgctxt "resourcestr.rshelpdebug" msgid "Direct debug output to SOME.LOG." msgstr "Enviar salida de depuración a SOME.LOG." #: resourcestr.rshelpdebugindex msgctxt "resourcestr.rshelpdebugindex" msgid "Show debug msgs while indexing notes" msgstr "Mostrar mensajes de depuración durante indización" #: resourcestr.rshelpdebugspell msgctxt "resourcestr.rshelpdebugspell" msgid "Show debug messages while spell setup" msgstr "Mostrar mensajes de depuración durante configuración de ortografía" #: resourcestr.rshelpdebugsync msgctxt "resourcestr.rshelpdebugsync" msgid "Show debug messages during Sync" msgstr "Mostrar mensajes de depuración durante Sincronización" #: resourcestr.rshelpdelay msgctxt "resourcestr.rshelpdelay" msgid "Delay startup 2 sec to allow OS to settle" msgstr "Retrasar el arranque 2 segs para dejar asentarse el SO" #: resourcestr.rshelphelp msgctxt "resourcestr.rshelphelp" msgid "Show this help message and exit." msgstr "Mostrar mensaje de ayuda y salir." #: resourcestr.rshelpimportfile msgid "Import file into Note Repo" msgstr "Importar archivo al repositario" #: resourcestr.rshelplang msgctxt "resourcestr.rshelplang" msgid "Force Language, en, es, uk, fr, nl" msgstr "Forzar idioma: en, es, fr, nl, uk" #: resourcestr.rshelpnosplash msgctxt "resourcestr.rshelpnosplash" msgid "Do not show small status/splash window" msgstr "No mostrar ventana de estado/bienvenida" #: resourcestr.rshelpsaveexit msgctxt "resourcestr.rshelpsaveexit" msgid "After import single note, save & exit" msgstr "Después de importar una sola nota, guardar y salir." #: resourcestr.rshelpsinglenote msgctxt "resourcestr.rshelpsinglenote" msgid "Open indicated note, switch is optional" msgstr "Abrir nota marcada, parámetro es opcional" #: resourcestr.rshelptitleisfname msgid "Use Filename as title for import txt & md" msgstr "Usar Nombre de archivo como título al importar txt y md" #: resourcestr.rshelpversion msgctxt "resourcestr.rshelpversion" msgid "Print version and exit" msgstr "Imprimir versión y salir" #: resourcestr.rshexcharrequired msgid "2, 4, 6 or 8 Hex Characters Required" msgstr "Hacen falta 2, 4, 6 o 8 carácteres hexadecimal" #: resourcestr.rslastchange msgctxt "resourcestr.rslastchange" msgid "Last Change" msgstr "Último cambio" #: resourcestr.rslastsync msgid "Last Sync" msgstr "Última sincronización" #: resourcestr.rslookingatnotes msgctxt "resourcestr.rslookingatnotes" msgid "Looking at notes ...." msgstr "Examinando las notas ..." #: resourcestr.rslookingserverid msgid "Looking for ServerID" msgstr "Buscando ServerID" #: resourcestr.rsmenuabout msgctxt "resourcestr.rsmenuabout" msgid "About" msgstr "Acerca de" #: resourcestr.rsmenuhelp msgctxt "resourcestr.rsmenuhelp" msgid "Help" msgstr "Ayuda" #: resourcestr.rsmenunewnote msgctxt "resourcestr.rsmenunewnote" msgid "New Note" msgstr "Nota nueva" #: resourcestr.rsmenuquit msgctxt "resourcestr.rsmenuquit" msgid "Quit" msgstr "Salir" #: resourcestr.rsmenusearch msgctxt "resourcestr.rsmenusearch" msgid "Search" msgstr "Buscar" #: resourcestr.rsmenusettings msgctxt "resourcestr.rsmenusettings" msgid "Settings" msgstr "Preferencias" #: resourcestr.rsmenusync msgctxt "resourcestr.rsmenusync" msgid "Synchronise" msgstr "Sincronizar" #: resourcestr.rsmetadirwarning msgid "Please remember that to ensure a reliable sync, you must not change files in the Meta directory." msgstr "Recuerde que para tener una sincronización fiable, no deba cambiar archivos en el directorio Meta." #: resourcestr.rsmultiplenotebooks msgctxt "resourcestr.rsmultiplenotebooks" msgid "Settings allow multiple Notebooks" msgstr "Las preferencias permiten cuadernos múltiples" #: resourcestr.rsname msgctxt "resourcestr.rsname" msgid "Name" msgstr "Nombre" #: resourcestr.rsnewerversionexits msgctxt "resourcestr.rsnewerversionexits" msgid "A newer version exists in main repo" msgstr "Hay una versión más nueva en el repositorio principal" #: resourcestr.rsnoothernotes msgid "No other notes link to this one" msgstr "Ninguna nota vinculada a ésta" #: resourcestr.rsnotavailable msgid "Not Available" msgstr "No disponible" #: resourcestr.rsnotealreadyinrepo msgctxt "resourcestr.rsnotealreadyinrepo" msgid "Note already in Repo" msgstr "Ya está en el repositorio" #: resourcestr.rsnotebookoptionctrl msgid "Ctrl click for Notebook Options" msgstr "Ctrl+Clic para Opciones de Cuaderno" #: resourcestr.rsnotebookoptionright msgid "Right click for Notebook Options" msgstr "Clic derecho para opciones de cuaderno" #: resourcestr.rsnotebooks msgctxt "resourcestr.rsnotebooks" msgid "Notebooks" msgstr "Cuadernos" #: resourcestr.rsnoteopen msgctxt "resourcestr.rsnoteopen" msgid "You have that note open, please close and try again" msgstr "La nota está abierta, por favor cierrela e intentelo de nuevo" #: resourcestr.rsnotes msgctxt "resourcestr.rsnotes" msgid "notes" msgstr "notas" #: resourcestr.rsnotesdeleted msgid "Note or notes deleted" msgstr "Nota(s) eliminada(s)" #: resourcestr.rsnotesinsnap msgid "Notes in Snapshot" msgstr "Notas en instantánea" #: resourcestr.rsnoteslinked msgid "Notes that link to this one" msgstr "Notas vinculadas a ésta" #: resourcestr.rsnotpresent msgctxt "resourcestr.rsnotpresent" msgid "Not present in main repo" msgstr "No está en el repositorio principal" #: resourcestr.rsnumbnotesaffected #, object-pascal-format msgid "This will affect %d notes" msgstr "Esto afectará %d notas." #: resourcestr.rsonenotebook msgctxt "resourcestr.rsonenotebook" msgid "Settings allow only one Notebook" msgstr "Preferencias permiten un solo cuaderno" #: resourcestr.rsoverwritenote msgctxt "resourcestr.rsoverwritenote" msgid "Overwrite newer version of that note" msgstr "Sobrescribir la versión más nueva de la nota" #: resourcestr.rspressclose msgctxt "resourcestr.rspressclose" msgid "Press Close" msgstr "Pulse Cerrar" #: resourcestr.rsrecoverok msgctxt "resourcestr.rsrecoverok" msgid "OK, File recovered." msgstr "OK, archivo recuperado." #: resourcestr.rsrenamefailed msgctxt "resourcestr.rsrenamefailed" msgid "ERROR, could not rename Backup File " msgstr "ERROR: No se pudo renombrar el archivo de seguridad " #: resourcestr.rsrollbackintro msgid "You can roll back to previous version of this note" msgstr "Puede volver a la versión anterior de esta nota" #: resourcestr.rsrunningsync msgctxt "resourcestr.rsrunningsync" msgid "Running Sync" msgstr "Sincronizando" #: resourcestr.rssaveandsync msgctxt "resourcestr.rssaveandsync" msgid "Press Save and Sync if this looks OK" msgstr "Pulse Guardar y Sincronizar si todo le parece bien" #: resourcestr.rsscanremote msgid "Scanning remote files" msgstr "Escaneando archivos remotos" #: resourcestr.rssearchhint msgctxt "resourcestr.rssearchhint" msgid "Exact matches for terms between \" \"" msgstr "Búsqueda exacta para términos entre \" \"" #: resourcestr.rssetthenotebooks msgctxt "resourcestr.rssetthenotebooks" msgid "Set the notebooks this note is a member of" msgstr "Establezca los cuadernos a cuales pertenece esta nota" #: resourcestr.rssetup msgctxt "resourcestr.rssetup" msgid "Setup" msgstr "Configurar" #: resourcestr.rssetupnotesdirfirst msgctxt "resourcestr.rssetupnotesdirfirst" msgid "Please setup a notes directory first" msgstr "Primero establezca un directorio para notas" #: resourcestr.rssetupsyncfirst msgctxt "resourcestr.rssetupsyncfirst" msgid "Please config sync system first" msgstr "Primero configure el sistema de sincronización" #: resourcestr.rssnapshotcreated msgctxt "resourcestr.rssnapshotcreated" msgid "created, do you want to copy it elsewhere ?" msgstr "creada. ¿Quiere copiarla a otro sitio?" #: resourcestr.rssyncclash msgid "A Sync Clash has occurred" msgstr "Conflicto en sincronización" #: resourcestr.rssyncclashadvice msgid "Run the Sync from Main Menu to resolve" msgstr "Sincronice desde el Menú Principal para resolverlo" #: resourcestr.rssyncerror msgctxt "resourcestr.rssyncerror" msgid "A Sync Error occurred" msgstr "Error de sincronización" #: resourcestr.rssyncnotconfig msgctxt "resourcestr.rssyncnotconfig" msgid "not configured" msgstr "sin configurar" #: resourcestr.rssynctypefile msgid "File Sync - local or shared filesystem" msgstr "Archivo - sistema de archivos local/compartido" #: resourcestr.rssynctypegithub msgid "Github - free Github account required" msgstr "Github - cuenta gratis de Github requerida" #: resourcestr.rstestingcredentials msgid "Testing Credentials" msgstr "Probando credenciales" #: resourcestr.rstestingrepo msgctxt "resourcestr.rstestingrepo" msgid "Testing Repo ...." msgstr "Probando repositorio ..." #: resourcestr.rstestingsync msgctxt "resourcestr.rstestingsync" msgid "Testing Sync" msgstr "Probando sincronización" #: resourcestr.rstryrecover_1 msgid "Try to recover a bad note by double clicking below," msgstr "Intente recuperar una nota corrompida con clic doble abajo," #: resourcestr.rstryrecover_2 msgctxt "resourcestr.rstryrecover_2" msgid "if that fails, you may be able to recover it from a Snapshot." msgstr "si falla, puede que se pueda recuperarla desde una instantánea." #: resourcestr.rsunabletoproceed msgctxt "resourcestr.rsunabletoproceed" msgid "Unable to proceed because" msgstr "No se puede continuar porque" #: resourcestr.rsunabletosync msgctxt "resourcestr.rsunabletosync" msgid "Unable to sync because " msgstr "No se puede sincronizar porque " # Plural, feminina para "notas" #: resourcestr.rsuploaded msgid "Uploaded" msgstr "Subidas" #: resourcestr.rsuploading msgid "Uploading" msgstr "Subiendo" #: resourcestr.rsutf8charlist msgid "Click here to browse to full list" msgstr "Haga clic aquí para ver la lista completa" #: resourcestr.rswarnnossystray msgid "WARNING, your Desktop might not display SysTray" msgstr "AVISO: Puede que su Escritorio no muestre la SysTray" #: resourcestr.rswehavesnapshots #, object-pascal-format msgid "We have %d snapshots" msgstr "Hay %d instantáneas" # Creo que refiere a archivo de biblioteca #: settings.rsdictionaryfailed msgid "Library Not Loaded" msgstr "Archivo lib no cargada" #: settings.rsdictionaryloaded msgid "Dictionary Loaded OK" msgstr "Diccionario cargada OK" #: settings.rsdictionarynotfound msgid "No Dictionary Found" msgstr "Ningún diccionario encontrado" #: settings.rsdirhasnonotes msgid "That directory does not contain any notes. That is OK, if I can make my own there." msgstr "El directorio no tiene ninguna nota. Está bien, si puedo hacer las mías aquí." #: settings.rserrorcannotwrite msgid "Cannot write into" msgstr "No se puede escribir en" #: settings.rserrorcreatedir msgid "Unable to Create Directory" msgstr "No se puede crear el directorio" #: settings.rsselectdictionary msgid "Select the dictionary you want to use" msgstr "Seleccione el diccionario que quiere usar" #: settings.rsselectlibrary msgid "Select your hunspell library" msgstr "Seleccione su archivo Hunspell" #: spelling.rscheckingfull msgid "Checking full document" msgstr "Comprobando todo el documento" #: spelling.rscheckingselection msgid "Checking selection" msgstr "Comprobando selección" #: spelling.rsreplace_with_1 msgid "replace" msgstr "reemplazar" #: spelling.rsreplace_with_2 msgid "with" msgstr "con" #: spelling.rsspellcomplete msgid "Spell check complete" msgstr "Revisión ortográfica terminada" #: spelling.rsspellnotconfig msgid "Spelling not configured" msgstr "Ortografía sin configurar" #: syncutils.rschangeexistingsync msgid "Change existing sync connection ?" msgstr "¿Cambiar conexión de sincronización actual?" #: syncutils.rsclashes msgid "Clashes " msgstr "Conflictos" #: syncutils.rsdonothing msgid "Do Nothing " msgstr "No hacer nada" #: syncutils.rsdownloads msgid "Downloads " msgstr "Descargas" # ¿Revisar las notas, la lista, cual? #: syncutils.rsedituploads msgid "Edit Uploads " msgstr "Revisar notas subidas" # ¿Revisar? #: syncutils.rslocaldeletes msgid "Local Deletes " msgstr "Notas locales borradas " # Revisar #: syncutils.rsnewuploads msgid "New Uploads " msgstr "Nuevas notas para subir" #: syncutils.rsnextbitslow msgid "Next bit can be a bit slow, please wait" msgstr "El próximo paso se puede tardar. Espere por favor." #: syncutils.rsnonotesneededsync msgid "No notes needed syncing. You need to write more." msgstr "No hay notas sin sincronizar. Tiene que escribir otras." # ¿Contexto? # ¿Espacio delante? #: syncutils.rsnotesweredealt msgid " notes were dealt with." msgstr " notas fueron procesadas." # ¿Y el sujeto? #: syncutils.rsnotrecommend msgid "Generally not recommended." msgstr "En general, no aconsejable" # ¿Revisar? #: syncutils.rsremotedeletes msgid "Remote Deletes " msgstr "Notas remotas borradas " #: syncutils.rssyncerrors msgid "ERRORS (see console log) " msgstr "ERRORES: vea registro en el terminal" #: teditboxform.buttmaintbmenu.caption msgctxt "teditboxform.buttmaintbmenu.caption" msgid "Menu" msgstr "Menú" # ¿Texto a traducir o un variabe? #: teditboxform.editfind.text msgid "EditFind" msgstr "RevisarBuscar" #: teditboxform.label2.caption msgid "Read Only" msgstr "Sólo lectura" #: teditboxform.label3.caption msgid "This note has been changed by the Sync Process" msgstr "Esta nota ha sido cambiado por el proceso de sincronizar." #: teditboxform.label4.caption msgid "Please close it (and re-open if it was a download)" msgstr "Por favor, cierrela (y reabrirla si fue descargada)" #: teditboxform.labelbacklinks.caption msgid "label1" msgstr "label1" #: teditboxform.labelfindinfo.caption msgid "LabelFindInfo" msgstr "BuscarInfo" #: teditboxform.menubold.caption msgctxt "teditboxform.menubold.caption" msgid "Bold" msgstr "Negrita" #: teditboxform.menufindnext.caption msgid "Find Next" msgstr "Buscar siguiente" #: teditboxform.menufindprev.caption msgctxt "teditboxform.menufindprev.caption" msgid "Find Prev" msgstr "Buscar anterior" #: teditboxform.menufixedwidth.caption msgid "Fixed Width" msgstr "Monoespaciada" #: teditboxform.menuhighlight.caption msgctxt "teditboxform.menuhighlight.caption" msgid "Highlight" msgstr "Resaltar" #: teditboxform.menuhuge.caption msgctxt "teditboxform.menuhuge.caption" msgid "Huge" msgstr "Enorme" #: teditboxform.menuitalic.caption msgid "Italic" msgstr "Cursiva" #: teditboxform.menuitembulletleft.caption msgid "Bullet -" msgstr "Viñeta -" #: teditboxform.menuitembulletright.caption msgid "Bullet +" msgstr "Viñeta +" #: teditboxform.menuitemcopy.caption msgid "Copy" msgstr "Copiar" #: teditboxform.menuitemcopyplain.caption msgid "Copy Plain" msgstr "Copiar sin formato" #: teditboxform.menuitemcut.caption msgid "Cut" msgstr "Cortar" #: teditboxform.menuitemdelete.caption msgctxt "teditboxform.menuitemdelete.caption" msgid "Delete" msgstr "Eliminar" #: teditboxform.menuitemevaluate.caption msgid "Evaluate" msgstr "Calcular" #: teditboxform.menuitemexport.caption msgid "Export" msgstr "Exportar" #: teditboxform.menuitemexportmarkdown.caption msgid "Export Markdown" msgstr "Exportar Markdown" #: teditboxform.menuitemexportpdf.caption msgid "Export PDF" msgstr "Exportar PDF" #: teditboxform.menuitemexportplaintext.caption msgid "Export Plain Text" msgstr "Exportar texto plano" #: teditboxform.menuitemexportrtf.caption msgid "Export RTF" msgstr "Exportar RTF" #: teditboxform.menuitemfind.caption msgid "Find in this Note" msgstr "Buscar en esta nota" #: teditboxform.menuitemindex.caption msgid "Index" msgstr "Indizar" #: teditboxform.menuitempaste.caption msgid "Paste" msgstr "Pegar" #: teditboxform.menuitemprint.caption msgid "Print" msgstr "Imprimir" #: teditboxform.menuitemselectall.caption msgid "Select All" msgstr "Seleccionar todo" #: teditboxform.menuitemsettings.caption msgctxt "teditboxform.menuitemsettings.caption" msgid "Settings" msgstr "Preferencias" #: teditboxform.menuitemspell.caption msgid "Spell Check" msgstr "Revisar ortográfica" #: teditboxform.menuitemsync.caption msgid "Synchronize" msgstr "Sincronizar" #: teditboxform.menularge.caption msgid "Large Font" msgstr "Fuente grande" #: teditboxform.menunormal.caption msgid "Normal Font" msgstr "Fuente normal" #: teditboxform.menusmall.caption msgid "Small Font" msgstr "Fuente pequeña" #: teditboxform.menustayontop.caption msgid "Stay On Top" msgstr "Siempre encima" #: teditboxform.menustrikeout.caption msgid "Strikeout" msgstr "Tachado" #: teditboxform.menuunderline.caption msgid "Underline" msgstr "Subrayado" #: teditboxform.panelbacklinks.caption msgid "PanelBackLinks" msgstr "PanelBackLinks" #: teditboxform.speedbuttondelete.hint msgid "Delete this note" msgstr "Eliminar esta nota" #: teditboxform.speedbuttonlink.hint msgid "Create new linked note (text selected) or display Backlinks." msgstr "Crear nueva nota vinculada (texto seleccionado) o mostrar enlaces recibidas," #: teditboxform.speedbuttonnotebook.hint msgid "Manage Notebooks" msgstr "Gestionar cuadernos" #: teditboxform.speedbuttonsearch.hint msgid "Search All Notes Ctrl-Shift-F" msgstr "Buscar en todas las notas: Ctrl-Shift-F" #: teditboxform.speedbuttontext.hint msgid "Font size, bold, italics etc" msgstr "Fuente: tamaño, negrita, cursiva, etc" #: teditboxform.speedbuttontools.hint msgid "Tools - Sync, Export, Spell" msgstr "Herramientas - Sincronizar, Exportar, Ortografía" #: teditboxform.speedclose.caption msgctxt "teditboxform.speedclose.caption" msgid "Close" msgstr "Cerrar" #: teditboxform.speedrollback.hint msgid "Roll Back" msgstr "Restaurar" #: teditboxform.speedsymbol.hint msgid "Insert extended character or symbol" msgstr "Insertar carácter extendido o símbolo" #: tformbackupview.buttondelete.caption msgctxt "tformbackupview.buttondelete.caption" msgid "Delete" msgstr "Eliminar" # Cambiado: 20240115 #: tformbackupview.buttondelete.hint msgid "Really, totally delete this note." msgstr "Sí, elimine la nota completamente." #: tformbackupview.buttonok.caption msgctxt "tformbackupview.buttonok.caption" msgid "Close" msgstr "Cerrar" #: tformbackupview.buttonok.hint msgid "My work here is done." msgstr "Mi trabajo aquí se ha terminado." #: tformbackupview.buttonopen.caption msgid "View" msgstr "Ver" #: tformbackupview.buttonopen.hint msgid "Open and view the whole note" msgstr "Abrir y ver la nota completa" #: tformbackupview.buttonrecover.caption msgctxt "tformbackupview.buttonrecover.caption" msgid "Recover" msgstr "Recuperar" #: tformbackupview.buttonrecover.hint msgid "Restore this note to main repo" msgstr "Restaurar esta nota al repositorio principal" #: tformbackupview.caption msgid "View, recover or delete Backup Files" msgstr "Ver, recuperar o elimina copias de seguridad" #: tformbackupview.listbox1.hint msgid "Use Ctrl or Shift to select multiple entries" msgstr "Seleccione entradas múltiples con Ctrl o Mayús " #: tformcolours.label1.caption msgid "Sample" msgstr "Muestra" #: tformcolours.label2.caption msgctxt "tformcolours.label2.caption" msgid "Set Colours" msgstr "Establecer colores" #: tformcolours.speedbackground.caption msgid "Background" msgstr "Fondo" #: tformcolours.speedcancel.caption msgctxt "tformcolours.speedcancel.caption" msgid "Cancel" msgstr "Cancelar" # Colores "por defecto", pero poco espacio en el botón #: tformcolours.speeddefault.caption msgid "Default" msgstr "Predetos." #: tformcolours.speedhighlight.caption msgctxt "tformcolours.speedhighlight.caption" msgid "Highlight" msgstr "Resaltar" #: tformcolours.speedlinks.caption msgid "Links" msgstr "Enlaces" #: tformcolours.speedok.caption msgctxt "tformcolours.speedok.caption" msgid "OK" msgstr "OK" #: tformcolours.speedtext.caption msgid "Text" msgstr "Texto" #: tformcolours.speedtitle.caption msgctxt "tformcolours.speedtitle.caption" msgid "Title" msgstr "Título" #: tformindex.caption msgid "Heading in this Note" msgstr "Cabecera de esta nota" #: tformindex.panel1.caption msgid "Single lines, all Huge, Large Bold or Large" msgstr "Líneas únicas, todas Enormes, Grandes-Negritas o Grandes" #: tformkmemo2pdf.caption msgid "PDF Issues" msgstr "Problemas PDF" #: tformrecover.buttondeletebadnotes.caption msgid "Delete Bad Notes" msgstr "Eliminar Notas Corrompidas" #: tformrecover.buttonmakesafetysnap.caption msgid "Take a manual Snapshot" msgstr "Hacer una instantánea manual" #: tformrecover.buttonmakesafetysnap.hint msgid "Take a initial snapshot of your notes and config. Overwritten each time." msgstr "Haga una instantánea de sus notas y configuración. Sobrescrita cada vez." #: tformrecover.buttonrecoversnap.caption msgctxt "tformrecover.buttonrecoversnap.caption" msgid "Recover" msgstr "Recuperar" #: tformrecover.buttonsnaphelp.caption msgid "Snapshot Help" msgstr "Ayuda, Instantaneas" #: tformrecover.label10.caption msgid "Please close any notes you may have open." msgstr "Por favor, si hay notas abiertas, ciérrelas." #: tformrecover.label12.caption msgid "Don't even consider this unless you have a backup Snapshot, Intro Tab." msgstr "Ni pensarlo sin tener una instantánea de seguridad reciente. (Pestaña \\\"Introducción\\\")" #: tformrecover.label14.caption msgid "Click an available snapshot to see its contents." msgstr "Haga clic en una instantánea para ver los contenidos." #: tformrecover.label15.caption msgid "Click an available snapshot, click Recover" msgstr "Haga clic en una instantánea, luego en Recuperar." #: tformrecover.label16.caption msgid "You may chose to view, copy and paste into a new note." msgstr "Puede elegir ver, copiar y pegar en una nota nueva." #: tformrecover.label2.caption msgid "Please be careful, this is a dangerous place!" msgstr "Por favor ¡tenga cuidado! ¡Es un sitio peligroso!" #: tformrecover.label3.caption msgid "Restore any notes in the snapshot that are not in the existing notes directory." msgstr "Restaurar las notas de la instantánea que no están en el directorio de notas." #: tformrecover.label4.caption msgid "Remove all existing notes and use the ones in the Snapshot." msgstr "Remove all existing notes and use the ones in the Snapshot." #: tformrecover.label5.caption msgid "Looking for notes with damaged XML" msgstr "Buscando notas con el XML corrompido" #: tformrecover.label6.caption msgid "This tool might help you recover lost or damaged notes." msgstr "Esta herramienta puede ayudarle recuperar las notas." #: tformrecover.label7.caption msgid "Before you start, take a Snapshot of your notes directory." msgstr "Antes de empezar, haga un instantánea de las notas." #: tformrecover.label9.caption msgid "From here you can view snapshot notes, one by one." msgstr "Aquí puede ver las notas de la instantánea una por una." #: tformrecover.listboxsnapshots.hint msgid "These are the currently known snapshots. " msgstr "Éstas son las instantáneas actuales encontradas. " #: tformrecover.panelsnapshots.caption msgid "Available Snapshots" msgstr "Instantáneas disponibles" #: tformrecover.tabsheetbadnotes.caption msgid "Bad Notes" msgstr "Notas corrumpidas" #: tformrecover.tabsheetintro.caption msgid "Introduction" msgstr "Introducción" #: tformrecover.tabsheetmergesnapshot.caption msgid "Merge Snapshot" msgstr "Combinar Instantánea" #: tformrecover.tabsheetrecovernotes.caption msgid "Recover Notes" msgstr "Recuperar notas" #: tformrecover.tabsheetrecoversnapshot.caption msgid "Recover Snapshot" msgstr "Recuperar notas" #: tformrollback.speedcancel.caption msgctxt "tformrollback.speedcancel.caption" msgid "Cancel" msgstr "Cancelar" #: tformrollback.speedrolltoopen.caption msgid "Opening Backup" msgstr "Abriendo copia de seguridad" #: tformrollback.speedrolltotitle.caption msgid "Title Change Backup" msgstr "Copia por cambio de título" #: tformsdiff.bitbtnuselocal.caption msgid "Use Local" msgstr "Usar Local" #: tformsdiff.bitbtnuseremote.caption msgid "Use Remote" msgstr "Usar Remota" #: tformsdiff.buttalllocal.caption msgid "Local" msgstr "Local" # ¿Demasiado largo? ¿Singular/plural? #: tformsdiff.buttallnewest.caption msgid "Newest" msgstr "Más reciente" #: tformsdiff.buttalloldest.caption msgid "Oldest" msgstr "Más vieja" #: tformsdiff.buttallremote.caption msgid "Remote" msgstr "Remota" #: tformsdiff.caption msgid "A Note Sync Clash has been Detected" msgstr "Se ha detectado un conflicto entre notas" #: tformsdiff.label1.caption msgid "Or make a choice for remainder of this run" msgstr "O seleccione una opción para el proceso" #: tformsdiff.label3.caption msgid "Remote Changed" msgstr "Nota remota cambiada" #: tformsdiff.label4.caption msgid "Local Changed" msgstr "Nota local cambiada" #: tformsdiff.radiolong.caption msgid "Long Lines" msgstr "Líneas largas" #: tformsdiff.radiolong.hint msgid "Maybe necessary to show difference" msgstr "Quizás hace falta mostrar la diferencia" #: tformsdiff.radioshort.caption msgid "Short Lines" msgstr "Líneas cortas" #: tformsdiff.radioshort.hint msgid "Easier to read" msgstr "Más fácil de leer" #: tformspell.buttonignore.caption msgid "Ignore" msgstr "Omitir" #: tformspell.buttonignore.hint msgid "Ignore all instances for the run" msgstr "Omitir todas" #: tformspell.buttonskip.caption msgid "Skip" msgstr "Saltar" #: tformspell.buttonskip.hint msgid "Skip just this instance" msgstr "Saltar esta instancia" #: tformspell.buttonuseandnextword.caption msgid "Use and Next Word" msgstr "Usar y sigiente palabra" #: tformspell.caption msgctxt "tformspell.caption" msgid "Spell" msgstr "Ortografía" #: tformspell.label4.caption msgid "Suspect word -" msgstr "Palabra dudosa -" #: tformspell.labelprompt.caption msgid "Click a word to use it." msgstr "Haga clic en una palabra." #: tformsymbol.bitbtnrevert.caption msgid "Revert" msgstr "Deshacer" #: tformsymbol.caption msgid "Symbol" msgstr "Símbolo" #: tformsymbol.stringgrid1.columns[0].title.caption msgctxt "tformsymbol.stringgrid1.columns[0].title.caption" msgid "Title" msgstr "Título" #: tformsymbol.stringgrid1.columns[1].title.caption msgctxt "tformsymbol.stringgrid1.columns[1].title.caption" msgid "Title" msgstr "Título" #: tformsync.buttoncancel.caption msgctxt "tformsync.buttoncancel.caption" msgid "Cancel" msgstr "Cancelar" #: tformsync.buttonclose.caption msgctxt "tformsync.buttonclose.caption" msgid "Close" msgstr "Cerrar" #: tformsync.buttonsave.caption msgid "Save and Sync" msgstr "Guardar y sincronizar" #: tformsync.caption msgctxt "tformsync.caption" msgid "Sync" msgstr "Sincronizar" #: tformsync.listviewreport.columns[0].caption msgid "Action" msgstr "Acción" #: tformsync.listviewreport.columns[1].caption msgctxt "tformsync.listviewreport.columns[1].caption" msgid "Title" msgstr "Título" # ¿Demasiado largo? #: tformsync.listviewreport.columns[2].caption msgid "Note ID" msgstr "ID de la nota" #: tmainform.bitbtnhide.caption msgid "Hide" msgstr "Ocultar" #: tmainform.bitbtnquit.caption msgctxt "tmainform.bitbtnquit.caption" msgid "Quit" msgstr "Salir" #: tmainform.buttmenu.caption msgctxt "tmainform.buttmenu.caption" msgid "Menu" msgstr "Menú" #: tmainform.buttsystrayhelp.caption msgid "SysTray Help" msgstr "Ayuda, SysTray" #: tmainform.caption msgid "tomboy-ng" msgstr "tomboy-ng" #: tmainform.checkboxdontshow.caption msgid "Don't Show for normal startup" msgstr "No mostrar al inicio" # Creo #: tmainform.checkboxdontshow.hint msgid "You can reverse this from Settings" msgstr "Puede dehacerlo desde las Preferencias" #: tmainform.hint msgid "If the yellow tomboy-ng icon is visible in your System Tray, you can dismiss this window." msgstr "Si el icono amarillo de tomboy-ng se puede ver in la bandeja del sistema, puede despachar esta ventana." #: tmainform.label3.caption msgid "Dictionary Config (optional)" msgstr "Configurar diccionario (opcional)" #: tmainform.label4.caption msgid "Sync Config (optional)" msgstr "Configurar sincronización (opcional)" #: tmainform.label5.caption msgid "Welcome to tomboy-ng !" msgstr "¡Bienvenido a tomboy-ng!" #: tmainform.labelerror.hint msgid "Launch from commandline to see errors or see Config->SnapShot->Recover ..." msgstr "Lanzar desde la terminal para ver errores o ir a Preferencias->Instantánea->Recuperar ..." #: tnotebookpick.button1.caption msgctxt "tnotebookpick.button1.caption" msgid "Cancel" msgstr "Cancelar" #: tnotebookpick.buttonok.caption msgctxt "tnotebookpick.buttonok.caption" msgid "OK" msgstr "OK" #: tnotebookpick.label4.caption msgid "Name of the New Notebook" msgstr "Nombre del cuaderno nuevo" #: tnotebookpick.label5.caption msgid "Press OK and we will make the Note Book AND add this note to it." msgstr "Pulse OK y crearemos el cuaderno y añadiremos esta nota a ello." #: tnotebookpick.label6.caption msgid "Existing Name" msgstr "Nombre actual" #: tnotebookpick.label8.caption msgid "New Name" msgstr "Nuevo nombre" #: tnotebookpick.label9.caption msgid "If you sync and are not absolutely sure its up to date, Cancel now !" msgstr "Si no está seguro que todo está al día, cancele la sincronización ¡ahora!" #: tnotebookpick.tabchangename.caption msgid "Change Notebook Name" msgstr "Cambiar nombre del cuaderno" #: tnotebookpick.tabexisting.caption msgid "Existing Note Books" msgstr "Cuadernos actuales" #: tnotebookpick.tabnewnotebook.caption msgid "New Note Book" msgstr "Cuaderno nuevo" #: tnotebookpick.tabsetnotes.caption msgid "Set Notes" msgstr "Establecer notas" #: tsearchform.bitbtnmenu.caption msgctxt "tsearchform.bitbtnmenu.caption" msgid "Menu" msgstr "Menú" #: tsearchform.buttonclearfilters.caption msgctxt "tsearchform.buttonclearfilters.caption" msgid "Clear" msgstr "Limpiar" #: tsearchform.buttonclearsearch.caption msgctxt "tsearchform.buttonclearsearch.caption" msgid "Clear" msgstr "Limpiar" #: tsearchform.buttonsearchoptions.caption msgctxt "tsearchform.buttonsearchoptions.caption" msgid "Options" msgstr "Opciones" #: tsearchform.caption msgid "tomboy-ng_Search" msgstr "Búsqueda de tombo-ng" #: tsearchform.listboxnotebooks.hint msgid "Right Click to manage Notebooks" msgstr "Clic derecho para gestionar cuadernos" #: tsearchform.menucreatenotebook.caption msgid "Create new Note Book" msgstr "Crear cuaderno nuevo" #: tsearchform.menudeletenotebook.caption msgid "Delete Notebook" msgstr "Eliminar cuaderno" #: tsearchform.menueditnotebooktemplate.caption msgid "Edit Notebook Template" msgstr "Editar plantilla del cuaderno" #: tsearchform.menuitemcasesensitive.caption msgctxt "tsearchform.menuitemcasesensitive.caption" msgid "Case Sensitive" msgstr "Sensible a mayúsculas" #: tsearchform.menuitemimportnote.caption msgid "Import File" msgstr "Importar archivo" #: tsearchform.menuitemmanagenbook.caption msgid "Manage Notes in Note Book" msgstr "Gestionar las notas del cuaderno" #: tsearchform.menuitemswyt.caption msgid "Search While You Type" msgstr "Buscar mientras escriba" #: tsearchform.menunewnotefromtemplate.caption msgid "Create New Note from Template" msgstr "Crear nota nueva desde una plantilla" #: tsearchform.menurenamenotebook.caption msgid "Rename NoteBook" msgstr "Renombrar cuaderno" #: tsearchform.panel2.caption msgctxt "tsearchform.panel2.caption" msgid "Notebooks" msgstr "Cuadernos" #: tsett.buttonfixedfont.caption msgid "Fixed Font" msgstr "Fuente monoespaciada" #: tsett.buttonfont.caption msgid "Usual Font" msgstr "Fuente habitual" #: tsett.buttonmanualsnap.caption msgid "Take a Manual Snapshot" msgstr "Hacer una instantánea manual" #: tsett.buttonmanualsnap.hint msgid "Take a time stamped snapshot of notes and config" msgstr "Hacer una instantánea de notas y preferencias con la fecha" #: tsett.buttonsetcolours.caption msgctxt "tsett.buttonsetcolours.caption" msgid "Set Colours" msgstr "Establecer colores" #: tsett.buttonsetdictionary.caption msgid "Set Dictionary" msgstr "Establecer Diccionario" #: tsett.buttonsetnotepath.caption msgid "Set Path to Note Files" msgstr "Establecer ruta a las notas" #: tsett.buttonsetnotepath.hint msgid "If you have notes somewhere else" msgstr "Si tienes notas en otro sitio" #: tsett.buttonsetspelllibrary.caption msgid "Set Spell Library" msgstr "Establecer diccionario ortográfico" #: tsett.buttonshowbackup.caption msgid "Show Me" msgstr "Ver nota(s)" #: tsett.buttonsnaprecover.caption msgid "Recover Lost Notes" msgstr "Recuperar notas perdidas" #: tsett.buttonsnaprecover.hint msgid "If you have previously taken a snapshot ..." msgstr "Si has hecho una instantánia antes ..." #: tsett.checkautosnapenabled.caption msgid "Use auto snapshots" msgstr "Use instantáneas automáticas" #: tsett.checkautostart.caption msgid "Autostart at Logon" msgstr "Ejecutar al iniciar sesión" #: tsett.checkescclosesnote.caption msgid "Esc Closes Note" msgstr "ESC cierra la nota" # Creo #: tsett.checkfindtoggles.caption msgid "Find Command Toggles" msgstr "Buscar conmutadores" #: tsett.checkfindtoggles.hint msgctxt "tsett.checkfindtoggles.hint" msgid "eg Ctrl-F opens and closes Find Window" msgstr "ej., Ctrl-F abre y cierre la ventana de búsqueda" #: tsett.checkmanynotebooks.caption msgid "Allow a Note to be in Multiple Notebooks." msgstr "Permitir enlazar una nota a más de un cuaderno." #: tsett.checkmanynotebooks.hint msgid "This may adversly affect traditional Tomboy, take care." msgstr "Puede que perjudique Tomboy tradicional. Tenga cuidado." #: tsett.checknotifications.caption msgid "Show Notifications" msgstr "Mostrar Notificaciones" #: tsett.checkshowextlinks.caption msgid "Show External Links" msgstr "Mostrar Enlaces Externos" #: tsett.checkshowintlinks.caption msgid "Show Internal Links" msgstr "Mostrar enlaces internos" #: tsett.checkshowsearchatstart.caption msgid "Show Search at Start" msgstr "Mostrar Búsqueda al iniciar" #: tsett.checkshowsplash.caption msgid "Show Splash at Start" msgstr "Mostrar Bienvenida al iniciar" #: tsett.checkshowsplash.hint msgid "Always shown if error loading notes." msgstr "Se muestra siempre si hay un error al cargar las notas." #: tsett.checkstampbold.caption msgctxt "tsett.checkstampbold.caption" msgid "Bold" msgstr "Negrita" #: tsett.checkstampitalics.caption msgid "Italics" msgstr "Cursiva" #: tsett.checkstampsmall.caption msgctxt "tsett.checkstampsmall.caption" msgid "Small" msgstr "Pequeña" #: tsett.checkuseundo.caption msgid "Use Undo Redo (may slow editing)" msgstr "Usar Deshacer-Rehacer (podría ralentizar redacción)" #: tsett.checkuseundo.hint msgid "Close and reopen a note to take effect. Use Ctrl-Z Ctrl-Y" msgstr "Cierre y reabra una nota para que tenga efecto. Use Ctrl-Z Ctrl-Y" #: tsett.combosynctiming.text msgid "ComboSyncTiming" msgstr "ComboSyncTiming" #: tsett.combosynctype.hint msgid "Github or File Sync" msgstr "Sincronización de Archivos o Github" #: tsett.groupbox4.caption msgctxt "tsett.groupbox4.caption" msgid "When a conflict is detected between a local note and remote one :" msgstr "Al detectar un conflicto entre una nota local y una remota:" #: tsett.groupbox5.caption msgid "Font Size" msgstr "Tamaño de la fuente" #: tsett.groupboxsync.caption msgid " Sync " msgstr " Sincronizar " #: tsett.groupboxtoken.caption msgctxt "tsett.groupboxtoken.caption" msgid "Token" msgstr "Autentificador" #: tsett.groupboxuser.caption msgctxt "tsett.groupboxuser.caption" msgid "User" msgstr "Usuario" #: tsett.groupnotespath.caption msgid "Notes Path" msgstr "Ruta a las notas" #: tsett.label1.caption msgid "Settings will be saved in :" msgstr "Preferencias se guardarán en:" #: tsett.label10.caption msgid "Help Notes Language" msgstr "Idioma de las notas de ayuda" #: tsett.label11.caption msgid "Backup Files" msgstr "Archivos de seguridad" #: tsett.label13.caption msgid "Spell Check requires the Hunspell Libraries and" msgstr "Revisión ortográfica requiere las bibliotecas de Hunspell y" #: tsett.label14.caption msgid "an appropriate Hunspell Dictionary set." msgstr "un diccionario Hunspell establecido." #: tsett.label16.caption msgid "Maximum number of snapshots" msgstr "Número máximo de instantáneas" #: tsett.label17.caption msgid "Date Stamp Format" msgstr "Formato del sello con la fecha" #: tsett.label2.caption msgid "Notes will be looked for and saved in :" msgstr "Se buscarán y se guardarám las notas en:" #: tsett.label4.caption msgid "Repo : " msgstr "Repositorio:" #: tsett.label5.caption msgid "Days per snapshot" msgstr "Días por instantánea" #: tsett.label6.caption msgid "Backup files are made when you delete a note or the sync system" msgstr "Se crean copias de seguridad cuando se borra una nota o el sistema de sincronización" #: tsett.label7.caption msgid "is about to overwrite one. " msgstr "está a punto de sobreescribir una." #: tsett.label8.caption msgid "They remain, forever, unless you do something about them." msgstr "Estas notas se quedan para siempre, al meno que haga algo al respecto." #: tsett.label9.caption msgid "A snaphot is a copy of your current note directory." msgstr "Una instantánea es una copia de sus notas actuales." #: tsett.labelsnapdir.caption msgid "Snap dir" msgstr "Directorio, instantáneas" #: tsett.labelsyncrepo.caption msgctxt "tsett.labelsyncrepo.caption" msgid "not configured" msgstr "sin configurar" #: tsett.labelsynctiming.caption msgid "Sync Timing" msgstr "Programación" # ¿Se puede ser más corto? ¿como solamente tipo? #: tsett.labelsynctype.caption msgid "Sync Type" msgstr "Tipo sincronización" #: tsett.menuitemcopytoken.caption msgid "Copy Existing Token" msgstr "Copiar autentificador actual" #: tsett.menuitemgettoken.caption msgid "Get a Token in your Browser" msgstr "Recibir un autenticador con el navegador" #: tsett.menuitempastetoken.caption msgid "Paste a New Token" msgstr "Pegar un autenticador nuevo" #: tsett.radioalwaysask.caption msgid "Always Ask me what to do." msgstr "Siempre preguntarme que hacer." #: tsett.radiochoose.caption msgid "Choose" msgstr "Elegir" #: tsett.radiofontbig.caption msgid "Big" msgstr "Grande" #: tsett.radiofonthuge.caption msgctxt "tsett.radiofonthuge.caption" msgid "Huge" msgstr "Enorme" #: tsett.radiofontmedium.caption msgid "Medium" msgstr "Media" #: tsett.radiofontsmall.caption msgctxt "tsett.radiofontsmall.caption" msgid "Small" msgstr "Pequeña" #: tsett.radiotomboydefault.caption msgid "Old Tomboy Default" msgstr "Predeterminado antiguo de Tomboy" #: tsett.radiotomboyngdefault.caption msgid "tomboy-ng Default" msgstr "Predeterminado tomboy-ng" #: tsett.radiouselocal.caption msgid "Use Local Note and Overwrite Server Note." msgstr "Usar la nota local y sobrescribir la nota del servidor." #: tsett.radiouseserver.caption msgid "Use Server Note and Rename Local Note." msgstr "Usar la nota del servidor y renombrar la nota local." #: tsett.speedbuthelp.caption msgctxt "tsett.speedbuthelp.caption" msgid "Help" msgstr "Ayuda" #: tsett.speedbuthide.caption msgctxt "tsett.speedbuthide.caption" msgid "Close" msgstr "Cerrar" #: tsett.speedbutttbmenu.caption msgctxt "tsett.speedbutttbmenu.caption" msgid "Menu" msgstr "Menú" #: tsett.speedsetupsync.caption msgctxt "tsett.speedsetupsync.caption" msgid "Setup" msgstr "Configurar" #: tsett.speedtokenactions.caption msgid "Actions" msgstr "Acciones" #: tsett.tabbackup.caption msgid "BackUp" msgstr "Copia de Seguridad" #: tsett.tabbasic.caption msgid "Basic" msgstr "Básico" #: tsett.tabdisplay.caption msgid "Notes" msgstr "Notas" #: tsett.tabrecover.caption msgctxt "tsett.tabrecover.caption" msgid "Recover" msgstr "Recuperar" #: tsett.tabspell.caption msgctxt "tsett.tabspell.caption" msgid "Spell" msgstr "Ortografía" #: tsett.tabsync.caption msgctxt "tsett.tabsync.caption" msgid "Sync" msgstr "Sync" tomboy-ng_0.39-1/po/tomboy-ng.pot0000644000175000017500000010355714551457644016527 0ustar dbannondbannonmsgid "" msgstr "Content-Type: text/plain; charset=UTF-8" #: editbox.rsunabletoevaluate msgid "Unable to find an expression to evaluate" msgstr "" #: fpttf.rsmissingfontfile #, object-pascal-format msgid "The font file <%s> can't be found." msgstr "" #: fpttf.rsnofontfilename msgid "The FileName property is empty, so we can't load font data." msgstr "" #: fpttf.rsnosearchpathdefined msgid "No search path was defined" msgstr "" #: fpttf.serrfontnotfound #, object-pascal-format msgid "The font <%s> can't be found" msgstr "" #: mainunit.rsabout msgid "tomboy-ng notes - cross platform, sync and manage notes." msgstr "" #: mainunit.rsaboutbdate msgid "Build date" msgstr "" #: mainunit.rsaboutcpu msgid "TargetCPU" msgstr "" #: mainunit.rsaboutoperatingsystem msgid "OS" msgstr "" #: mainunit.rsaboutver msgid "Version" msgstr "" #: mainunit.rsfailedtoindex msgid "Failed to index one or more notes." msgstr "" #: resourcestr.rsaddnotestonotebook msgid "Add notes to this Notebook" msgstr "" #: resourcestr.rsalldone msgctxt "resourcestr.rsalldone" msgid "All Done" msgstr "" #: resourcestr.rsallrestored msgctxt "resourcestr.rsallrestored" msgid "Notes and config files Restored, restart suggested." msgstr "" #: resourcestr.rsautosnapshotrun msgid "Completed autosnapshot run." msgstr "" #: resourcestr.rsautosyncnotpossible msgid "Auto sync not possible right now" msgstr "" #: resourcestr.rsbadnotes #, object-pascal-format msgctxt "resourcestr.rsbadnotes" msgid "You have %d bad notes in Notes Directory" msgstr "" #: resourcestr.rsbadnotesfound1 msgctxt "resourcestr.rsbadnotesfound1" msgid "Please go to Settings -> Recover -> Recover Notes" msgstr "" #: resourcestr.rsbadnotesfound2 msgctxt "resourcestr.rsbadnotesfound2" msgid "You should do so to ensure your notes are safe." msgstr "" #: resourcestr.rscannotdelete msgctxt "resourcestr.rscannotdelete" msgid "Cannot delete " msgstr "" #: resourcestr.rscannotfindnote msgctxt "resourcestr.rscannotfindnote" msgid "ERROR, cannot find " msgstr "" #: resourcestr.rschangenameofnotebook msgid "Change the name of this Notebook" msgstr "" #: resourcestr.rschangesync msgid "Change Sync Repository" msgstr "" #: resourcestr.rsclickbadnote msgctxt "resourcestr.rsclickbadnote" msgid "Double click on any Bad Notes" msgstr "" #: resourcestr.rsclicksnapshot msgctxt "resourcestr.rsclicksnapshot" msgid "Click an Available Snapshot" msgstr "" #: resourcestr.rscontentdated msgid "Content Dated" msgstr "" #: resourcestr.rscopyfailed msgctxt "resourcestr.rscopyfailed" msgid "Copying orig to Backup directory failed" msgstr "" #: resourcestr.rscreatenewrepo msgctxt "resourcestr.rscreatenewrepo" msgid "Create a new Repository ?" msgstr "" #: resourcestr.rsdeleteandreplace_1 msgctxt "resourcestr.rsdeleteandreplace_1" msgid "Notes at risk !" msgstr "" #: resourcestr.rsdeleteandreplace_2 #, object-pascal-format msgctxt "resourcestr.rsdeleteandreplace_2" msgid "Delete all notes in %s and replace with snapshot dated %s ?" msgstr "" #: resourcestr.rsdeleteddamaged #, object-pascal-format msgid "OK, deleted %d damaged notes" msgstr "" #: resourcestr.rsdownloaded msgid "Downloaded" msgstr "" #: resourcestr.rsdownloadnotes msgid "Downloading notes" msgstr "" #: resourcestr.rsenterhexvalue msgctxt "resourcestr.rsenterhexvalue" msgid "Enter the Hexadecimal value for a UTF8 character" msgstr "" #: resourcestr.rsenternewnotebook msgctxt "resourcestr.rsenternewnotebook" msgid "Enter a new Notebook name please" msgstr "" #: resourcestr.rserrorcopyfile msgctxt "resourcestr.rserrorcopyfile" msgid "Failed to copy file, does destination dir exist ?" msgstr "" #: resourcestr.rsfilesyncinfo1 msgid "tomboy-ng uses File Sync to sync to eg DropBox, Google Drive, a USB drive" msgstr "" #: resourcestr.rsfilesyncinfo2 msgid "or uses a remote server over the internet with sshfs" msgstr "" #: resourcestr.rsfindnavlefthint msgid "Backward Find : Shift-F3 or Shift-Ctrl-G" msgstr "" #: resourcestr.rsfindnavlefthintmac msgid "Backward Find : Shift-Command-G" msgstr "" #: resourcestr.rsfindnavrighthint msgid "Find : F3 or Ctrl-G" msgstr "" #: resourcestr.rsfindnavrighthintmac msgid "Find : Command-G" msgstr "" #: resourcestr.rsfound msgctxt "resourcestr.rsfound" msgid "Found" msgstr "" #: resourcestr.rsgithubsyncinfo1 msgid "tomboy-ng can use Github to both sync and display or edit notes" msgstr "" #: resourcestr.rsgithubsyncinfo2 msgid "you should read the tomboy-ng wiki page for instructions." msgstr "" #: resourcestr.rsgithubtokenexpired msgid "Github Token may have expired" msgstr "" #: resourcestr.rshelpconfig msgctxt "resourcestr.rshelpconfig" msgid "Create or use an alternative config" msgstr "" #: resourcestr.rshelpdebug msgctxt "resourcestr.rshelpdebug" msgid "Direct debug output to SOME.LOG." msgstr "" #: resourcestr.rshelpdebugindex msgctxt "resourcestr.rshelpdebugindex" msgid "Show debug msgs while indexing notes" msgstr "" #: resourcestr.rshelpdebugspell msgctxt "resourcestr.rshelpdebugspell" msgid "Show debug messages while spell setup" msgstr "" #: resourcestr.rshelpdebugsync msgctxt "resourcestr.rshelpdebugsync" msgid "Show debug messages during Sync" msgstr "" #: resourcestr.rshelpdelay msgctxt "resourcestr.rshelpdelay" msgid "Delay startup 2 sec to allow OS to settle" msgstr "" #: resourcestr.rshelphelp msgctxt "resourcestr.rshelphelp" msgid "Show this help message and exit." msgstr "" #: resourcestr.rshelpimportfile msgid "Import file into Note Directory" msgstr "" #: resourcestr.rshelplang msgctxt "resourcestr.rshelplang" msgid "Force Language, en, es, uk, fr, nl" msgstr "" #: resourcestr.rshelpnosplash msgctxt "resourcestr.rshelpnosplash" msgid "Do not show small status/splash window" msgstr "" #: resourcestr.rshelpsaveexit msgctxt "resourcestr.rshelpsaveexit" msgid "After import single note, save & exit" msgstr "" #: resourcestr.rshelpsinglenote msgctxt "resourcestr.rshelpsinglenote" msgid "Open indicated note, switch is optional" msgstr "" #: resourcestr.rshelptitleisfname msgid "Use Filename as title for import txt & md" msgstr "" #: resourcestr.rshelpversion msgctxt "resourcestr.rshelpversion" msgid "Print version and exit" msgstr "" #: resourcestr.rshexcharrequired msgid "2, 4, 6 or 8 Hex Characters Required" msgstr "" #: resourcestr.rslastchange msgid "Last Change" msgstr "" #: resourcestr.rslastsync msgid "Last Sync" msgstr "" #: resourcestr.rslookingatnotes msgctxt "resourcestr.rslookingatnotes" msgid "Looking at notes ...." msgstr "" #: resourcestr.rslookingserverid msgid "Looking for ServerID" msgstr "" #: resourcestr.rsmenuabout msgctxt "resourcestr.rsmenuabout" msgid "About" msgstr "" #: resourcestr.rsmenuhelp msgctxt "resourcestr.rsmenuhelp" msgid "Help" msgstr "" #: resourcestr.rsmenunewnote msgctxt "resourcestr.rsmenunewnote" msgid "New Note" msgstr "" #: resourcestr.rsmenuquit msgctxt "resourcestr.rsmenuquit" msgid "Quit" msgstr "" #: resourcestr.rsmenusearch msgctxt "resourcestr.rsmenusearch" msgid "Search" msgstr "" #: resourcestr.rsmenusettings msgctxt "resourcestr.rsmenusettings" msgid "Settings" msgstr "" #: resourcestr.rsmenusync msgctxt "resourcestr.rsmenusync" msgid "Synchronise" msgstr "" #: resourcestr.rsmetadirwarning msgid "Please remember that to ensure a reliable sync, you must not change files in the Meta directory." msgstr "" #: resourcestr.rsmultiplenotebooks msgctxt "resourcestr.rsmultiplenotebooks" msgid "Settings allow multiple Notebooks" msgstr "" #: resourcestr.rsname msgid "Name" msgstr "" #: resourcestr.rsnewerversionexits msgctxt "resourcestr.rsnewerversionexits" msgid "A newer version exists in main repo" msgstr "" #: resourcestr.rsnoothernotes msgid "No other notes link to this one" msgstr "" #: resourcestr.rsnotavailable msgid "Not Available" msgstr "" #: resourcestr.rsnotealreadyinrepo msgctxt "resourcestr.rsnotealreadyinrepo" msgid "Note already in Repository" msgstr "" #: resourcestr.rsnotebookoptionctrl msgid "Ctrl click for Notebook Options" msgstr "" #: resourcestr.rsnotebookoptionright msgid "Right click for Notebook Options" msgstr "" #: resourcestr.rsnotebooks msgctxt "resourcestr.rsnotebooks" msgid "Notebooks" msgstr "" #: resourcestr.rsnoteopen msgctxt "resourcestr.rsnoteopen" msgid "You have that note open, please close and try again" msgstr "" #: resourcestr.rsnotes msgctxt "resourcestr.rsnotes" msgid "notes" msgstr "" #: resourcestr.rsnotesdeleted msgid "Note or notes deleted" msgstr "" #: resourcestr.rsnotesinsnap msgctxt "resourcestr.rsnotesinsnap" msgid "Notes in Snapshot" msgstr "" #: resourcestr.rsnoteslinked msgid "Notes that link to this one" msgstr "" #: resourcestr.rsnotpresent msgctxt "resourcestr.rsnotpresent" msgid "Not present in main repo" msgstr "" #: resourcestr.rsnumbnotesaffected #, object-pascal-format msgid "This will affect %d notes" msgstr "" #: resourcestr.rsonenotebook msgctxt "resourcestr.rsonenotebook" msgid "Settings allow only one Notebook" msgstr "" #: resourcestr.rsoverwritenote msgctxt "resourcestr.rsoverwritenote" msgid "Overwrite newer version of that note" msgstr "" #: resourcestr.rspressclose msgctxt "resourcestr.rspressclose" msgid "Press Close" msgstr "" #: resourcestr.rsrecoverok msgctxt "resourcestr.rsrecoverok" msgid "OK, File recovered." msgstr "" #: resourcestr.rsrenamefailed msgctxt "resourcestr.rsrenamefailed" msgid "ERROR, could not rename Backup File " msgstr "" #: resourcestr.rsrollbackintro msgid "You can roll back to previous version of this note" msgstr "" #: resourcestr.rsrunningsync msgctxt "resourcestr.rsrunningsync" msgid "Running Sync" msgstr "" #: resourcestr.rssaveandsync msgctxt "resourcestr.rssaveandsync" msgid "Press Save and Sync if this looks OK" msgstr "" #: resourcestr.rsscanremote msgid "Scanning remote files" msgstr "" #: resourcestr.rssearchhint msgid "Exact matches for terms between \" \"" msgstr "" #: resourcestr.rssetthenotebooks msgctxt "resourcestr.rssetthenotebooks" msgid "Set the Notebooks this note is a member of" msgstr "" #: resourcestr.rssetup msgctxt "resourcestr.rssetup" msgid "Setup" msgstr "" #: resourcestr.rssetupnotesdirfirst msgctxt "resourcestr.rssetupnotesdirfirst" msgid "Please setup a notes directory first" msgstr "" #: resourcestr.rssetupsyncfirst msgctxt "resourcestr.rssetupsyncfirst" msgid "Please config sync system first" msgstr "" #: resourcestr.rssnapshotcreated msgctxt "resourcestr.rssnapshotcreated" msgid "created, do you want to copy it elsewhere ?" msgstr "" #: resourcestr.rssyncclash msgid "A Sync Clash has occurred" msgstr "" #: resourcestr.rssyncclashadvice msgid "Run the Sync from Main Menu to resolve" msgstr "" #: resourcestr.rssyncerror msgctxt "resourcestr.rssyncerror" msgid "A Sync Error occurred" msgstr "" #: resourcestr.rssyncnotconfig msgctxt "resourcestr.rssyncnotconfig" msgid "not configured" msgstr "" #: resourcestr.rssynctypefile msgid "File Sync - local or shared filesystem" msgstr "" #: resourcestr.rssynctypegithub msgid "Github - free Github account required" msgstr "" #: resourcestr.rstestingcredentials msgid "Testing Credentials" msgstr "" #: resourcestr.rstestingrepo msgctxt "resourcestr.rstestingrepo" msgid "Testing Repository ...." msgstr "" #: resourcestr.rstestingsync msgctxt "resourcestr.rstestingsync" msgid "Testing Sync" msgstr "" #: resourcestr.rstryrecover_1 msgid "Try to recover a bad note by double clicking below," msgstr "" #: resourcestr.rstryrecover_2 msgctxt "resourcestr.rstryrecover_2" msgid "if that fails, you may be able to recover it from a Snapshot." msgstr "" #: resourcestr.rsunabletoproceed msgctxt "resourcestr.rsunabletoproceed" msgid "Unable to proceed because" msgstr "" #: resourcestr.rsunabletosync msgctxt "resourcestr.rsunabletosync" msgid "Unable to sync because " msgstr "" #: resourcestr.rsuploaded msgid "Uploaded" msgstr "" #: resourcestr.rsuploading msgid "Uploading" msgstr "" #: resourcestr.rsutf8charlist msgid "Click here to browse to full list" msgstr "" #: resourcestr.rswarnnossystray msgid "WARNING, your Desktop might not display SysTray" msgstr "" #: resourcestr.rswehavesnapshots #, object-pascal-format msgid "We have %d snapshots" msgstr "" #: settings.rsdictionaryfailed msgid "Library Not Loaded" msgstr "" #: settings.rsdictionaryloaded msgid "Dictionary Loaded OK" msgstr "" #: settings.rsdictionarynotfound msgid "No Dictionary Found" msgstr "" #: settings.rsdirhasnonotes msgid "That directory does not contain any notes. That is OK, if I can make my own there." msgstr "" #: settings.rserrorcannotwrite msgid "Cannot write into" msgstr "" #: settings.rserrorcreatedir msgid "Unable to Create Directory" msgstr "" #: settings.rsselectdictionary msgid "Select the dictionary you want to use" msgstr "" #: settings.rsselectlibrary msgid "Select your hunspell library" msgstr "" #: spelling.rscheckingfull msgid "Checking full document" msgstr "" #: spelling.rscheckingselection msgid "Checking selection" msgstr "" #: spelling.rsreplace_with_1 msgid "replace" msgstr "" #: spelling.rsreplace_with_2 msgid "with" msgstr "" #: spelling.rsspellcomplete msgid "Spell check complete" msgstr "" #: spelling.rsspellnotconfig msgid "Spelling not configured" msgstr "" #: syncutils.rschangeexistingsync msgid "Change existing sync connection ?" msgstr "" #: syncutils.rsclashes msgid "Clashes " msgstr "" #: syncutils.rsdonothing msgid "Do Nothing " msgstr "" #: syncutils.rsdownloads msgid "Downloads " msgstr "" #: syncutils.rsedituploads msgid "Edit Uploads " msgstr "" #: syncutils.rslocaldeletes msgid "Local Deletes " msgstr "" #: syncutils.rsnewuploads msgid "New Uploads " msgstr "" #: syncutils.rsnextbitslow msgid "Next bit can be a bit slow, please wait" msgstr "" #: syncutils.rsnonotesneededsync msgid "No notes needed syncing. You need to write more." msgstr "" #: syncutils.rsnotesweredealt msgid " notes were dealt with." msgstr "" #: syncutils.rsnotrecommend msgid "Generally not recommended." msgstr "" #: syncutils.rsremotedeletes msgid "Remote Deletes " msgstr "" #: syncutils.rssyncerrors msgid "ERRORS (see console log) " msgstr "" #: teditboxform.buttmaintbmenu.caption msgctxt "teditboxform.buttmaintbmenu.caption" msgid "Menu" msgstr "" #: teditboxform.editfind.text msgid "EditFind" msgstr "" #: teditboxform.label2.caption msgid "Read Only" msgstr "" #: teditboxform.label3.caption msgid "This note has been changed by the Sync Process" msgstr "" #: teditboxform.label4.caption msgid "Please close it (and re-open if it was a download)" msgstr "" #: teditboxform.menubold.caption msgctxt "teditboxform.menubold.caption" msgid "Bold" msgstr "" #: teditboxform.menufindnext.caption msgid "Find Next" msgstr "" #: teditboxform.menufindprev.caption msgctxt "teditboxform.menufindprev.caption" msgid "Find Prev" msgstr "" #: teditboxform.menufixedwidth.caption msgid "Fixed Width" msgstr "" #: teditboxform.menuhighlight.caption msgctxt "teditboxform.menuhighlight.caption" msgid "Highlight" msgstr "" #: teditboxform.menuhuge.caption msgctxt "teditboxform.menuhuge.caption" msgid "Huge" msgstr "" #: teditboxform.menuitalic.caption msgid "Italic" msgstr "" #: teditboxform.menuitembulletleft.caption msgid "Bullet -" msgstr "" #: teditboxform.menuitembulletright.caption msgid "Bullet +" msgstr "" #: teditboxform.menuitemcopy.caption msgid "Copy" msgstr "" #: teditboxform.menuitemcopyplain.caption msgid "Copy Plain" msgstr "" #: teditboxform.menuitemcut.caption msgid "Cut" msgstr "" #: teditboxform.menuitemdelete.caption msgctxt "teditboxform.menuitemdelete.caption" msgid "Delete" msgstr "" #: teditboxform.menuitemevaluate.caption msgid "Evaluate" msgstr "" #: teditboxform.menuitemexport.caption msgid "Export" msgstr "" #: teditboxform.menuitemexportmarkdown.caption msgid "Export Markdown" msgstr "" #: teditboxform.menuitemexportpdf.caption msgid "Export PDF" msgstr "" #: teditboxform.menuitemexportplaintext.caption msgid "Export Plain Text" msgstr "" #: teditboxform.menuitemexportrtf.caption msgid "Export RTF" msgstr "" #: teditboxform.menuitemfind.caption msgid "Find in this Note" msgstr "" #: teditboxform.menuitemindex.caption msgid "Index" msgstr "" #: teditboxform.menuitempaste.caption msgid "Paste" msgstr "" #: teditboxform.menuitemprint.caption msgid "Print" msgstr "" #: teditboxform.menuitemselectall.caption msgid "Select All" msgstr "" #: teditboxform.menuitemsettings.caption msgctxt "teditboxform.menuitemsettings.caption" msgid "Settings" msgstr "" #: teditboxform.menuitemspell.caption msgid "Spell Check" msgstr "" #: teditboxform.menuitemsync.caption msgid "Synchronize" msgstr "" #: teditboxform.menularge.caption msgid "Large Font" msgstr "" #: teditboxform.menunormal.caption msgid "Normal Font" msgstr "" #: teditboxform.menusmall.caption msgid "Small Font" msgstr "" #: teditboxform.menustayontop.caption msgid "Stay On Top" msgstr "" #: teditboxform.menustrikeout.caption msgid "Strikeout" msgstr "" #: teditboxform.menuunderline.caption msgid "Underline" msgstr "" #: teditboxform.speedbuttondelete.hint msgid "Delete this note" msgstr "" #: teditboxform.speedbuttonlink.hint msgid "Create new linked note (text selected) or display Backlinks." msgstr "" #: teditboxform.speedbuttonnotebook.hint msgid "Manage Notebooks" msgstr "" #: teditboxform.speedbuttonsearch.hint msgid "Search All Notes Ctrl-Shift-F" msgstr "" #: teditboxform.speedbuttontext.hint msgid "Font size, bold, italics etc" msgstr "" #: teditboxform.speedbuttontools.hint msgid "Tools - Sync, Export, Spell" msgstr "" #: teditboxform.speedclose.caption msgctxt "teditboxform.speedclose.caption" msgid "Close" msgstr "" #: teditboxform.speedrollback.hint msgid "Roll Back" msgstr "" #: teditboxform.speedsymbol.hint msgid "Insert extended character or symbol" msgstr "" #: tformbackupview.buttondelete.caption msgctxt "tformbackupview.buttondelete.caption" msgid "Delete" msgstr "" #: tformbackupview.buttondelete.hint msgid "Really, totally delete this note." msgstr "" #: tformbackupview.buttonok.caption msgctxt "tformbackupview.buttonok.caption" msgid "Close" msgstr "" #: tformbackupview.buttonok.hint msgid "My work here is done." msgstr "" #: tformbackupview.buttonopen.caption msgid "View" msgstr "" #: tformbackupview.buttonopen.hint msgid "Open and view the whole note" msgstr "" #: tformbackupview.buttonrecover.caption msgctxt "tformbackupview.buttonrecover.caption" msgid "Recover" msgstr "" #: tformbackupview.buttonrecover.hint msgid "Restore this note to main repo" msgstr "" #: tformbackupview.caption msgid "View, recover or delete Backup Files" msgstr "" #: tformbackupview.listbox1.hint msgid "Use Ctrl or Shift to select multiple entries" msgstr "" #: tformcolours.label1.caption msgid "Sample" msgstr "" #: tformcolours.label2.caption msgctxt "tformcolours.label2.caption" msgid "Set Colours" msgstr "" #: tformcolours.speedbackground.caption msgid "Background" msgstr "" #: tformcolours.speedcancel.caption msgctxt "tformcolours.speedcancel.caption" msgid "Cancel" msgstr "" #: tformcolours.speeddefault.caption msgid "Default" msgstr "" #: tformcolours.speedhighlight.caption msgctxt "tformcolours.speedhighlight.caption" msgid "Highlight" msgstr "" #: tformcolours.speedlinks.caption msgid "Links" msgstr "" #: tformcolours.speedok.caption msgctxt "tformcolours.speedok.caption" msgid "OK" msgstr "" #: tformcolours.speedtext.caption msgid "Text" msgstr "" #: tformcolours.speedtitle.caption msgctxt "tformcolours.speedtitle.caption" msgid "Title" msgstr "" #: tformindex.caption msgid "Heading in this Note" msgstr "" #: tformindex.panel1.caption msgid "Single lines, all Huge, Large Bold or Large" msgstr "" #: tformkmemo2pdf.caption msgid "PDF Issues" msgstr "" #: tformrecover.buttondeletebadnotes.caption msgid "Delete Bad Notes" msgstr "" #: tformrecover.buttonmakesafetysnap.caption msgid "Take a manual Snapshot" msgstr "" #: tformrecover.buttonmakesafetysnap.hint msgid "Take a initial snapshot of your notes and config. Overwritten each time." msgstr "" #: tformrecover.buttonrecoversnap.caption msgctxt "tformrecover.buttonrecoversnap.caption" msgid "Recover" msgstr "" #: tformrecover.buttonsnaphelp.caption msgid "Snapshot Help" msgstr "" #: tformrecover.label10.caption msgid "Please close any notes you may have open." msgstr "" #: tformrecover.label12.caption msgid "Don't even consider this unless you have a backup Snapshot, Intro Tab." msgstr "" #: tformrecover.label14.caption msgid "Click an available snapshot to see its contents." msgstr "" #: tformrecover.label15.caption msgid "Click an available snapshot, click Recover" msgstr "" #: tformrecover.label16.caption msgid "You may chose to view, copy and paste into a new note." msgstr "" #: tformrecover.label2.caption msgid "Please be careful, this is a dangerous place!" msgstr "" #: tformrecover.label3.caption msgid "Restore any notes in the snapshot that are not in the existing notes directory." msgstr "" #: tformrecover.label4.caption msgid "Remove all existing notes and use the ones in the Snapshot." msgstr "" #: tformrecover.label5.caption msgid "Looking for notes with damaged XML" msgstr "" #: tformrecover.label6.caption msgid "This tool might help you recover lost or damaged notes." msgstr "" #: tformrecover.label7.caption msgid "Before you start, take a Snapshot of your notes directory." msgstr "" #: tformrecover.label9.caption msgid "From here you can view snapshot notes, one by one." msgstr "" #: tformrecover.listboxsnapshots.hint msgid "These are the currently known snapshots. " msgstr "" #: tformrecover.panelsnapshots.caption msgid "Available Snapshots" msgstr "" #: tformrecover.tabsheetbadnotes.caption msgid "Bad Notes" msgstr "" #: tformrecover.tabsheetintro.caption msgid "Introduction" msgstr "" #: tformrecover.tabsheetmergesnapshot.caption msgid "Merge Snapshot" msgstr "" #: tformrecover.tabsheetrecovernotes.caption msgid "Recover Notes" msgstr "" #: tformrecover.tabsheetrecoversnapshot.caption msgid "Recover Snapshot" msgstr "" #: tformrollback.speedcancel.caption msgctxt "tformrollback.speedcancel.caption" msgid "Cancel" msgstr "" #: tformrollback.speedrolltoopen.caption msgid "Opening Backup" msgstr "" #: tformrollback.speedrolltotitle.caption msgid "Title Change Backup" msgstr "" #: tformsdiff.bitbtnuselocal.caption msgid "Use Local" msgstr "" #: tformsdiff.bitbtnuseremote.caption msgid "Use Remote" msgstr "" #: tformsdiff.buttalllocal.caption msgid "Local" msgstr "" #: tformsdiff.buttallnewest.caption msgid "Newest" msgstr "" #: tformsdiff.buttalloldest.caption msgid "Oldest" msgstr "" #: tformsdiff.buttallremote.caption msgid "Remote" msgstr "" #: tformsdiff.caption msgid "A Note Sync Clash has been Detected" msgstr "" #: tformsdiff.label1.caption msgid "Or make a choice for remainder of this run" msgstr "" #: tformsdiff.label3.caption msgid "Remote Changed" msgstr "" #: tformsdiff.label4.caption msgid "Local Changed" msgstr "" #: tformsdiff.radiolong.caption msgid "Long Lines" msgstr "" #: tformsdiff.radiolong.hint msgid "Maybe necessary to show difference" msgstr "" #: tformsdiff.radioshort.caption msgid "Short Lines" msgstr "" #: tformsdiff.radioshort.hint msgid "Easier to read" msgstr "" #: tformspell.buttonignore.caption msgid "Ignore" msgstr "" #: tformspell.buttonignore.hint msgid "Ignore all instances for the run" msgstr "" #: tformspell.buttonskip.caption msgid "Skip" msgstr "" #: tformspell.buttonskip.hint msgid "Skip just this instance" msgstr "" #: tformspell.buttonuseandnextword.caption msgid "Use and Next Word" msgstr "" #: tformspell.caption msgctxt "tformspell.caption" msgid "Spell" msgstr "" #: tformspell.label4.caption msgid "Suspect word -" msgstr "" #: tformspell.labelprompt.caption msgid "Click a word to use it." msgstr "" #: tformsymbol.bitbtnrevert.caption msgid "Revert" msgstr "" #: tformsymbol.caption msgid "Symbol" msgstr "" #: tformsymbol.stringgrid1.columns[0].title.caption msgctxt "tformsymbol.stringgrid1.columns[0].title.caption" msgid "Title" msgstr "" #: tformsymbol.stringgrid1.columns[1].title.caption msgctxt "tformsymbol.stringgrid1.columns[1].title.caption" msgid "Title" msgstr "" #: tformsync.buttoncancel.caption msgctxt "tformsync.buttoncancel.caption" msgid "Cancel" msgstr "" #: tformsync.buttonclose.caption msgctxt "tformsync.buttonclose.caption" msgid "Close" msgstr "" #: tformsync.buttonsave.caption msgid "Save and Sync" msgstr "" #: tformsync.caption msgctxt "tformsync.caption" msgid "Sync" msgstr "" #: tformsync.listviewreport.columns[0].caption msgid "Action" msgstr "" #: tformsync.listviewreport.columns[1].caption msgctxt "tformsync.listviewreport.columns[1].caption" msgid "Title" msgstr "" #: tformsync.listviewreport.columns[2].caption msgid "Note ID" msgstr "" #: tmainform.bitbtnhide.caption msgid "Hide" msgstr "" #: tmainform.bitbtnquit.caption msgctxt "tmainform.bitbtnquit.caption" msgid "Quit" msgstr "" #: tmainform.buttmenu.caption msgctxt "tmainform.buttmenu.caption" msgid "Menu" msgstr "" #: tmainform.buttsystrayhelp.caption msgid "SysTray Help" msgstr "" #: tmainform.caption msgid "tomboy-ng" msgstr "" #: tmainform.checkboxdontshow.caption msgid "Don't Show for normal startup" msgstr "" #: tmainform.checkboxdontshow.hint msgid "You can reverse this from Settings" msgstr "" #: tmainform.hint msgid "If the yellow tomboy-ng icon is visible in your System Tray, you can dismiss this window." msgstr "" #: tmainform.label3.caption msgid "Dictionary Config (optional)" msgstr "" #: tmainform.label4.caption msgid "Sync Config (optional)" msgstr "" #: tmainform.label5.caption msgid "Welcome to tomboy-ng !" msgstr "" #: tmainform.labelerror.hint msgid "Launch from commandline to see errors or see Config->SnapShot->Recover ..." msgstr "" #: tnotebookpick.button1.caption msgctxt "tnotebookpick.button1.caption" msgid "Cancel" msgstr "" #: tnotebookpick.buttonok.caption msgctxt "tnotebookpick.buttonok.caption" msgid "OK" msgstr "" #: tnotebookpick.caption msgctxt "tnotebookpick.caption" msgid "Notebooks" msgstr "" #: tnotebookpick.label4.caption msgid "Name of the New Notebook" msgstr "" #: tnotebookpick.label5.caption msgid "Press OK and we will make the Notebook AND add this note to it." msgstr "" #: tnotebookpick.label6.caption msgid "Existing Name" msgstr "" #: tnotebookpick.label8.caption msgid "New Name" msgstr "" #: tnotebookpick.label9.caption msgid "If you sync and are not absolutely sure it is up to date, Cancel now !" msgstr "" #: tnotebookpick.tabchangename.caption msgid "Change Notebook Name" msgstr "" #: tnotebookpick.tabexisting.caption msgid "Existing Note Books" msgstr "" #: tnotebookpick.tabnewnotebook.caption msgid "New Note Book" msgstr "" #: tnotebookpick.tabsetnotes.caption msgid "Set Notes" msgstr "" #: tsearchform.bitbtnmenu.caption msgctxt "tsearchform.bitbtnmenu.caption" msgid "Menu" msgstr "" #: tsearchform.buttonclearfilters.caption msgctxt "tsearchform.buttonclearfilters.caption" msgid "Clear" msgstr "" #: tsearchform.buttonclearsearch.caption msgctxt "tsearchform.buttonclearsearch.caption" msgid "Clear" msgstr "" #: tsearchform.buttonsearchoptions.caption msgctxt "tsearchform.buttonsearchoptions.caption" msgid "Options" msgstr "" #: tsearchform.caption msgid "tomboy-ng_Search" msgstr "" #: tsearchform.listboxnotebooks.hint msgid "Right Click to manage Notebooks" msgstr "" #: tsearchform.menucreatenotebook.caption msgid "Create new Notebook" msgstr "" #: tsearchform.menudeletenotebook.caption msgid "Delete Notebook" msgstr "" #: tsearchform.menueditnotebooktemplate.caption msgid "Edit Notebook Template" msgstr "" #: tsearchform.menuitemcasesensitive.caption msgctxt "tsearchform.menuitemcasesensitive.caption" msgid "Case Sensitive" msgstr "" #: tsearchform.menuitemimportnote.caption msgid "Import File" msgstr "" #: tsearchform.menuitemmanagenbook.caption msgid "Manage Notes in Notebook" msgstr "" #: tsearchform.menuitemswyt.caption msgid "Search While You Type" msgstr "" #: tsearchform.menunewnotefromtemplate.caption msgid "Create New Note from Template" msgstr "" #: tsearchform.menurenamenotebook.caption msgid "Rename Notebook" msgstr "" #: tsearchform.panel2.caption msgctxt "tsearchform.panel2.caption" msgid "Notebooks" msgstr "" #: tsett.buttonfixedfont.caption msgid "Fixed Font" msgstr "" #: tsett.buttonfont.caption msgid "Usual Font" msgstr "" #: tsett.buttonmanualsnap.caption msgid "Take a Manual Snapshot" msgstr "" #: tsett.buttonmanualsnap.hint msgid "Take a time stamped snapshot of notes and config" msgstr "" #: tsett.buttonsetcolours.caption msgctxt "tsett.buttonsetcolours.caption" msgid "Set Colours" msgstr "" #: tsett.buttonsetdictionary.caption msgid "Set Dictionary" msgstr "" #: tsett.buttonsetnotepath.caption msgid "Set Path to Note Files" msgstr "" #: tsett.buttonsetnotepath.hint msgid "If you have notes somewhere else" msgstr "" #: tsett.buttonsetspelllibrary.caption msgid "Set Spell Library" msgstr "" #: tsett.buttonshowbackup.caption msgid "Show Me" msgstr "" #: tsett.buttonsnaprecover.caption msgid "Recover Lost Notes" msgstr "" #: tsett.buttonsnaprecover.hint msgid "If you have previously taken a snapshot ..." msgstr "" #: tsett.checkautosnapenabled.caption msgid "Use auto snapshots" msgstr "" #: tsett.checkautostart.caption msgid "Autostart at Logon" msgstr "" #: tsett.checkescclosesnote.caption msgid "ESC Closes Note" msgstr "" #: tsett.checkfindtoggles.caption msgid "Find Command Toggles" msgstr "" #: tsett.checkfindtoggles.hint msgctxt "tsett.checkfindtoggles.hint" msgid "eg Ctrl-F opens and closes Find Window" msgstr "" #: tsett.checkmanynotebooks.caption msgid "Allow a Note to be in Multiple Notebooks." msgstr "" #: tsett.checkmanynotebooks.hint msgid "This may adversly affect traditional Tomboy, take care." msgstr "" #: tsett.checknotifications.caption msgid "Show Notifications" msgstr "" #: tsett.checkshowextlinks.caption msgid "Show External Links" msgstr "" #: tsett.checkshowintlinks.caption msgid "Show Internal Links" msgstr "" #: tsett.checkshowsearchatstart.caption msgid "Show Search at Start" msgstr "" #: tsett.checkshowsplash.caption msgid "Show Splash at Start" msgstr "" #: tsett.checkshowsplash.hint msgid "Always shown if error loading notes." msgstr "" #: tsett.checkstampbold.caption msgctxt "tsett.checkstampbold.caption" msgid "Bold" msgstr "" #: tsett.checkstampitalics.caption msgid "Italics" msgstr "" #: tsett.checkstampsmall.caption msgctxt "tsett.checkstampsmall.caption" msgid "Small" msgstr "" #: tsett.checkuseundo.caption msgid "Use Undo Redo (may slow editing)" msgstr "" #: tsett.checkuseundo.hint msgid "Close and reopen a note to take effect. Use Ctrl-Z Ctrl-Y" msgstr "" #: tsett.combosynctiming.text msgid "ComboSyncTiming" msgstr "" #: tsett.combosynctype.hint msgid "Github or File Sync" msgstr "" #: tsett.groupbox4.caption msgctxt "tsett.groupbox4.caption" msgid "When a conflict is detected between a local note and remote one :" msgstr "" #: tsett.groupbox5.caption msgid "Font Size" msgstr "" #: tsett.groupboxsync.caption msgid " Sync " msgstr "" #: tsett.groupboxtoken.caption msgctxt "tsett.groupboxtoken.caption" msgid "Token" msgstr "" #: tsett.groupboxuser.caption msgctxt "tsett.groupboxuser.caption" msgid "User" msgstr "" #: tsett.groupnotespath.caption msgid "Notes Path" msgstr "" #: tsett.label1.caption msgid "Settings will be saved in :" msgstr "" #: tsett.label10.caption msgid "Help Notes Language" msgstr "" #: tsett.label11.caption msgid "Backup Files" msgstr "" #: tsett.label13.caption msgid "Spell Check requires the Hunspell Libraries and" msgstr "" #: tsett.label14.caption msgid "an appropriate Hunspell Dictionary set." msgstr "" #: tsett.label16.caption msgid "Maximum number of snapshots" msgstr "" #: tsett.label17.caption msgid "Date Stamp Format" msgstr "" #: tsett.label2.caption msgid "Notes will be looked for and saved in :" msgstr "" #: tsett.label4.caption msgid "Repo : " msgstr "" #: tsett.label5.caption msgid "Days per snapshot" msgstr "" #: tsett.label6.caption msgid "Backup files are made when you delete a note or the sync system" msgstr "" #: tsett.label7.caption msgid "is about to overwrite one. " msgstr "" #: tsett.label8.caption msgid "They remain, forever, unless you do something about them." msgstr "" #: tsett.label9.caption msgid "A snaphot is a copy of your current note directory." msgstr "" #: tsett.labelsnapdir.caption msgid "Snap dir" msgstr "" #: tsett.labelsyncrepo.caption msgctxt "tsett.labelsyncrepo.caption" msgid "not configured" msgstr "" #: tsett.labelsynctiming.caption msgid "Sync Timing" msgstr "" #: tsett.labelsynctype.caption msgid "Sync Type" msgstr "" #: tsett.menuitemcopytoken.caption msgid "Copy Existing Token" msgstr "" #: tsett.menuitemgettoken.caption msgid "Get a Token in your Browser" msgstr "" #: tsett.menuitempastetoken.caption msgid "Paste a New Token" msgstr "" #: tsett.radioalwaysask.caption msgid "Always Ask me what to do." msgstr "" #: tsett.radiochoose.caption msgid "Choose" msgstr "" #: tsett.radiofontbig.caption msgid "Big" msgstr "" #: tsett.radiofonthuge.caption msgctxt "tsett.radiofonthuge.caption" msgid "Huge" msgstr "" #: tsett.radiofontmedium.caption msgid "Medium" msgstr "" #: tsett.radiofontsmall.caption msgctxt "tsett.radiofontsmall.caption" msgid "Small" msgstr "" #: tsett.radiotomboydefault.caption msgid "Old Tomboy Default" msgstr "" #: tsett.radiotomboyngdefault.caption msgid "tomboy-ng Default" msgstr "" #: tsett.radiouselocal.caption msgid "Use Local Note and Overwrite Server Note." msgstr "" #: tsett.radiouseserver.caption msgid "Use Server Note and Rename Local Note." msgstr "" #: tsett.speedbuthelp.caption msgctxt "tsett.speedbuthelp.caption" msgid "Help" msgstr "" #: tsett.speedbuthide.caption msgctxt "tsett.speedbuthide.caption" msgid "Close" msgstr "" #: tsett.speedbutttbmenu.caption msgctxt "tsett.speedbutttbmenu.caption" msgid "Menu" msgstr "" #: tsett.speedsetupsync.caption msgctxt "tsett.speedsetupsync.caption" msgid "Setup" msgstr "" #: tsett.speedtokenactions.caption msgid "Actions" msgstr "" #: tsett.tabbackup.caption msgid "BackUp" msgstr "" #: tsett.tabbasic.caption msgid "Basic" msgstr "" #: tsett.tabdisplay.caption msgid "Notes" msgstr "" #: tsett.tabrecover.caption msgctxt "tsett.tabrecover.caption" msgid "Recover" msgstr "" #: tsett.tabspell.caption msgctxt "tsett.tabspell.caption" msgid "Spell" msgstr "" #: tsett.tabsync.caption msgctxt "tsett.tabsync.caption" msgid "Sync" msgstr "" tomboy-ng_0.39-1/po/tomboy-ng.nl.po0000644000175000017500000013265514551457644016754 0ustar dbannondbannon# Heimen Stoffels , 2019. msgid "" msgstr "" "Project-Id-Version: \n" "POT-Creation-Date: \n" "PO-Revision-Date: 2022-10-29 12:18+0200\n" "Last-Translator: Heimen Stoffels \n" "Language-Team: Dutch \n" "Language: nl\n" "MIME-Version: 1.0\n" "Content-Type: text/plain; charset=UTF-8\n" "Content-Transfer-Encoding: 8bit\n" "Plural-Forms: nplurals=2; plural=(n != 1);\n" "X-Generator: Poedit 3.2.1\n" #: editbox.rsunabletoevaluate msgid "Unable to find an expression to evaluate" msgstr "Geen te evalueren uitdrukking aangetroffen" #: fpttf.rsmissingfontfile #, object-pascal-format msgid "The font file <%s> can't be found." msgstr "" #: fpttf.rsnofontfilename msgid "The FileName property is empty, so we can't load font data." msgstr "" #: fpttf.rsnosearchpathdefined msgid "No search path was defined" msgstr "" #: fpttf.serrfontnotfound #, object-pascal-format msgid "The font <%s> can't be found" msgstr "" #: mainunit.rsabout msgid "tomboy-ng notes - cross platform, sync and manage notes." msgstr "tomboy-ng-notities - platform-onafhankelijk, met synchronisatie en beheermogelijkheden." #: mainunit.rsaboutbdate msgid "Build date" msgstr "Gebouwd op" #: mainunit.rsaboutcpu msgid "TargetCPU" msgstr "Doel-cpu" #: mainunit.rsaboutoperatingsystem msgid "OS" msgstr "Best.syst." #: mainunit.rsaboutver msgid "Version" msgstr "Versie" #: mainunit.rsfailedtoindex msgid "Failed to index one or more notes." msgstr "Kan één of meerdere notities niet indexeren." #: resourcestr.rsaddnotestonotebook msgid "Add notes to this Notebook" msgstr "Voeg notities toe aan dit notitieboek" #: resourcestr.rsalldone msgctxt "resourcestr.rsalldone" msgid "All Done" msgstr "Voltooid" #: resourcestr.rsallrestored msgctxt "resourcestr.rsallrestored" msgid "Notes and config files Restored, restart suggested." msgstr "Notities en configuratiebestanden hersteld; herstart tomboy-ng." #: resourcestr.rsautosnapshotrun msgid "Completed autosnapshot run." msgstr "Er is een automatische reservekopie gemaakt." #: resourcestr.rsautosyncnotpossible msgid "Auto sync not possible right now" msgstr "Automatisch synchroniseren is momenteel niet mogelijk" #: resourcestr.rsbadnotes #, object-pascal-format msgctxt "resourcestr.rsbadnotes" msgid "You have %d bad notes in Notes Directory" msgstr "U heeft %d beschadigde notities" #: resourcestr.rsbadnotesfound1 msgctxt "resourcestr.rsbadnotesfound1" msgid "Please go to Settings -> Recover -> Recover Notes" msgstr "Ga naar Instellingen --> Herstellen --> Notities herstellen" #: resourcestr.rsbadnotesfound2 msgctxt "resourcestr.rsbadnotesfound2" msgid "You should do so to ensure your notes are safe." msgstr "Zorg er voor dat uw notities beveiligd zijn." #: resourcestr.rscannotdelete msgctxt "resourcestr.rscannotdelete" msgid "Cannot delete " msgstr "Verwijderen mislukt: " #: resourcestr.rscannotfindnote msgctxt "resourcestr.rscannotfindnote" msgid "ERROR, cannot find " msgstr "FOUTMELDING! Niet aangetroffen: " #: resourcestr.rschangenameofnotebook msgid "Change the name of this Notebook" msgstr "Wijzig de naam van dit notitieboek" #: resourcestr.rschangesync #, fuzzy #| msgid "Change Sync Repo" msgid "Change Sync Repository" msgstr "Synchronisatierepo aanpassen" #: resourcestr.rsclickbadnote msgctxt "resourcestr.rsclickbadnote" msgid "Double click on any Bad Notes" msgstr "Dubbelklik op de beschadigde notities" #: resourcestr.rsclicksnapshot msgctxt "resourcestr.rsclicksnapshot" msgid "Click an Available Snapshot" msgstr "Klik op een beschikbare reservekopie" #: resourcestr.rscontentdated msgid "Content Dated" msgstr "Datum van inhoud" #: resourcestr.rscopyfailed msgctxt "resourcestr.rscopyfailed" msgid "Copying orig to Backup directory failed" msgstr "Kan origineel niet kopiëren naar reservekopiemap" #: resourcestr.rscreatenewrepo #, fuzzy #| msgid "Create a new Repo ?" msgctxt "resourcestr.rscreatenewrepo" msgid "Create a new Repository ?" msgstr "Wilt u een nieuwe repo aanmaken?" #: resourcestr.rsdeleteandreplace_1 msgctxt "resourcestr.rsdeleteandreplace_1" msgid "Notes at risk !" msgstr "Beveiligingsprobleem!" #: resourcestr.rsdeleteandreplace_2 #, object-pascal-format msgctxt "resourcestr.rsdeleteandreplace_2" msgid "Delete all notes in %s and replace with snapshot dated %s ?" msgstr "Wilt u alle notities in %s vervangen door de reservekopie van %s?" #: resourcestr.rsdeleteddamaged #, object-pascal-format msgid "OK, deleted %d damaged notes" msgstr "Er zijn %d beschadigde notities verwijderd" #: resourcestr.rsdownloaded msgid "Downloaded" msgstr "Gedownload" #: resourcestr.rsdownloadnotes msgid "Downloading notes" msgstr "Bezig met downloaden…" #: resourcestr.rsenterhexvalue msgctxt "resourcestr.rsenterhexvalue" msgid "Enter the Hexadecimal value for a UTF8 character" msgstr "" #: resourcestr.rsenternewnotebook #, fuzzy #| msgid "Enter a new notebook name please" msgctxt "resourcestr.rsenternewnotebook" msgid "Enter a new Notebook name please" msgstr "Voer een nieuwe naam in voor het notitieboek" #: resourcestr.rserrorcopyfile msgctxt "resourcestr.rserrorcopyfile" msgid "Failed to copy file, does destination dir exist ?" msgstr "Kan bestand niet kopiëren. Bestaat de bestemmingsmap wel?" #: resourcestr.rsfilesyncinfo1 msgid "tomboy-ng uses File Sync to sync to eg DropBox, Google Drive, a USB drive" msgstr "tomboy-ng maakt gebruik van File Sync om te synchroniseren met onder meer DropBox, Google Drive en usb-schijven" #: resourcestr.rsfilesyncinfo2 msgid "or uses a remote server over the internet with sshfs" msgstr "of een externe internetserver voorzien van sshfs" #: resourcestr.rsfindnavlefthint msgid "Backward Find : Shift-F3 or Shift-Ctrl-G" msgstr "Achterwaarts zoeken: Shift+F3 of Shift+Ctrl+G" #: resourcestr.rsfindnavlefthintmac msgid "Backward Find : Shift-Command-G" msgstr "Achterwaarts zoeken: Shift+Command+G" #: resourcestr.rsfindnavrighthint msgid "Find : F3 or Ctrl-G" msgstr "Zoeken: F3 of Ctrl+G" #: resourcestr.rsfindnavrighthintmac msgid "Find : Command-G" msgstr "Zoeken: Command+G" #: resourcestr.rsfound msgctxt "resourcestr.rsfound" msgid "Found" msgstr "Aangetroffen" #: resourcestr.rsgithubsyncinfo1 msgid "tomboy-ng can use Github to both sync and display or edit notes" msgstr "tomboy-ng kan gebruikmaken van Github voor het synchroniseren van notities" #: resourcestr.rsgithubsyncinfo2 msgid "you should read the tomboy-ng wiki page for instructions." msgstr "Instructies hiervoor zijn te vinden op de wikipagina van tomboy-ng." #: resourcestr.rsgithubtokenexpired msgid "Github Token may have expired" msgstr "De GitHub-toegangssleutel is mogelijk verlopen" #: resourcestr.rshelpconfig msgctxt "resourcestr.rshelpconfig" msgid "Create or use an alternative config" msgstr "Alternatieve configuratie aanmaken of gebruiken" #: resourcestr.rshelpdebug msgctxt "resourcestr.rshelpdebug" msgid "Direct debug output to SOME.LOG." msgstr "Foutopsporingsuitvoer vastleggen in SOME.LOG." #: resourcestr.rshelpdebugindex msgctxt "resourcestr.rshelpdebugindex" msgid "Show debug msgs while indexing notes" msgstr "Foutopsporingsberichten tonen tijdens indexeren" #: resourcestr.rshelpdebugspell msgctxt "resourcestr.rshelpdebugspell" msgid "Show debug messages while spell setup" msgstr "Foutopsporingsberichten tonen tijdens instellen van spellingcontrole" #: resourcestr.rshelpdebugsync msgctxt "resourcestr.rshelpdebugsync" msgid "Show debug messages during Sync" msgstr "Foutopsporingsberichten tonen tijdens synchronisatie" #: resourcestr.rshelpdelay msgctxt "resourcestr.rshelpdelay" msgid "Delay startup 2 sec to allow OS to settle" msgstr "Opstarten met 2 sec. vertragen i.v.m. opstart van systeemdiensten" #: resourcestr.rshelphelp msgctxt "resourcestr.rshelphelp" msgid "Show this help message and exit." msgstr "Toon dit hulpbericht en sluit af." #: resourcestr.rshelpimportfile #, fuzzy #| msgid "Import file into Note Repo" msgid "Import file into Note Directory" msgstr "Bestand importeren naar repo" #: resourcestr.rshelplang msgctxt "resourcestr.rshelplang" msgid "Force Language, en, es, uk, fr, nl" msgstr "Dwing een taal af: en, es, uk, fr, nl" #: resourcestr.rshelpnosplash msgctxt "resourcestr.rshelpnosplash" msgid "Do not show small status/splash window" msgstr "Geen klein status-/opstartscherm tonen" #: resourcestr.rshelpsaveexit msgctxt "resourcestr.rshelpsaveexit" msgid "After import single note, save & exit" msgstr "Importeer een losse notitie, sla op en sluit af" #: resourcestr.rshelpsinglenote msgctxt "resourcestr.rshelpsinglenote" msgid "Open indicated note, switch is optional" msgstr "Aangegeven notitie openen; overschakelen optioneel" #: resourcestr.rshelptitleisfname msgid "Use Filename as title for import txt & md" msgstr "Bestandsnaam gebruiken als titel bij importeren van txt en md" #: resourcestr.rshelpversion msgctxt "resourcestr.rshelpversion" msgid "Print version and exit" msgstr "Toon de versie en sluit af" #: resourcestr.rshexcharrequired msgid "2, 4, 6 or 8 Hex Characters Required" msgstr "" #: resourcestr.rslastchange msgid "Last Change" msgstr "Recentste wijziging" #: resourcestr.rslastsync msgid "Last Sync" msgstr "Recentste synchronisatie" #: resourcestr.rslookingatnotes msgctxt "resourcestr.rslookingatnotes" msgid "Looking at notes ...." msgstr "Bezig met inspecteren van notities…" #: resourcestr.rslookingserverid msgid "Looking for ServerID" msgstr "Bezig met zoeken naar server-id…" #: resourcestr.rsmenuabout msgctxt "resourcestr.rsmenuabout" msgid "About" msgstr "Over" #: resourcestr.rsmenuhelp msgctxt "resourcestr.rsmenuhelp" msgid "Help" msgstr "Hulp" #: resourcestr.rsmenunewnote msgctxt "resourcestr.rsmenunewnote" msgid "New Note" msgstr "Nieuwe notitie" #: resourcestr.rsmenuquit msgctxt "resourcestr.rsmenuquit" msgid "Quit" msgstr "Afsluiten" #: resourcestr.rsmenusearch msgctxt "resourcestr.rsmenusearch" msgid "Search" msgstr "Zoeken" #: resourcestr.rsmenusettings msgctxt "resourcestr.rsmenusettings" msgid "Settings" msgstr "Instellingen" #: resourcestr.rsmenusync msgctxt "resourcestr.rsmenusync" msgid "Synchronise" msgstr "Synchroniseren" #: resourcestr.rsmetadirwarning msgid "Please remember that to ensure a reliable sync, you must not change files in the Meta directory." msgstr "Let op: pas geen bestanden in de metamap aan om synchronisatieproblemen te voorkomen." #: resourcestr.rsmultiplenotebooks msgctxt "resourcestr.rsmultiplenotebooks" msgid "Settings allow multiple Notebooks" msgstr "Er is ondersteuning voor meerdere notitieboeken" #: resourcestr.rsname msgid "Name" msgstr "Naam" #: resourcestr.rsnewerversionexits msgctxt "resourcestr.rsnewerversionexits" msgid "A newer version exists in main repo" msgstr "Er is een nieuwere versie aanwezig in de hoofdrepo" #: resourcestr.rsnoothernotes msgid "No other notes link to this one" msgstr "" #: resourcestr.rsnotavailable msgid "Not Available" msgstr "Niet beschikbaar" #: resourcestr.rsnotealreadyinrepo #, fuzzy #| msgid "Note already in Repo" msgctxt "resourcestr.rsnotealreadyinrepo" msgid "Note already in Repository" msgstr "Deze notitie bestaat al" #: resourcestr.rsnotebookoptionctrl msgid "Ctrl click for Notebook Options" msgstr "Ctrl+klik om de notitieboekopties te tonen" #: resourcestr.rsnotebookoptionright msgid "Right click for Notebook Options" msgstr "Rechtsklik om de notitieboekopties te tonen" #: resourcestr.rsnotebooks msgctxt "resourcestr.rsnotebooks" msgid "Notebooks" msgstr "Notitieboeken" #: resourcestr.rsnoteopen msgctxt "resourcestr.rsnoteopen" msgid "You have that note open, please close and try again" msgstr "Deze notitie is geopend. Sluit hem en probeer het opnieuw." #: resourcestr.rsnotes msgctxt "resourcestr.rsnotes" msgid "notes" msgstr "notities" #: resourcestr.rsnotesdeleted msgid "Note or notes deleted" msgstr "Notitie(s) verwijderd" #: resourcestr.rsnotesinsnap msgctxt "resourcestr.rsnotesinsnap" msgid "Notes in Snapshot" msgstr "Notities in reservekopie" #: resourcestr.rsnoteslinked msgid "Notes that link to this one" msgstr "" #: resourcestr.rsnotpresent msgctxt "resourcestr.rsnotpresent" msgid "Not present in main repo" msgstr "Niet aanwezig in hoofdrepo" #: resourcestr.rsnumbnotesaffected #, object-pascal-format msgid "This will affect %d notes" msgstr "Dit is van invloed op %d notities" #: resourcestr.rsonenotebook msgctxt "resourcestr.rsonenotebook" msgid "Settings allow only one Notebook" msgstr "Er is ondersteuning voor één notitieboek" #: resourcestr.rsoverwritenote msgctxt "resourcestr.rsoverwritenote" msgid "Overwrite newer version of that note" msgstr "Nieuwere versie overschrijven" #: resourcestr.rspressclose msgctxt "resourcestr.rspressclose" msgid "Press Close" msgstr "Sluit het venster" #: resourcestr.rsrecoverok msgctxt "resourcestr.rsrecoverok" msgid "OK, File recovered." msgstr "Het bestand is hersteld." #: resourcestr.rsrenamefailed msgctxt "resourcestr.rsrenamefailed" msgid "ERROR, could not rename Backup File " msgstr "FOUTMELDING: kan naam van reservekopiebestand niet wijzigen " #: resourcestr.rsrollbackintro msgid "You can roll back to previous version of this note" msgstr "U kunt de vorige versie van deze notitie herstellen" #: resourcestr.rsrunningsync msgctxt "resourcestr.rsrunningsync" msgid "Running Sync" msgstr "Bezig met synchroniseren…" #: resourcestr.rssaveandsync msgctxt "resourcestr.rssaveandsync" msgid "Press Save and Sync if this looks OK" msgstr "Als dit in orde is, klik dan op ‘Opslaan en synchroniseren’" #: resourcestr.rsscanremote msgid "Scanning remote files" msgstr "Bezig met scannen van externe bestanden…" #: resourcestr.rssearchhint msgid "Exact matches for terms between \" \"" msgstr "Exacte overeenkomsten voor zoekopdrachten tussen \" \"" #: resourcestr.rssetthenotebooks #, fuzzy #| msgid "Set the notebooks this note is a member of" msgctxt "resourcestr.rssetthenotebooks" msgid "Set the Notebooks this note is a member of" msgstr "Stel in in welke notitieboeken deze notitie moet worden geplaatst" #: resourcestr.rssetup msgctxt "resourcestr.rssetup" msgid "Setup" msgstr "Instellen" #: resourcestr.rssetupnotesdirfirst msgctxt "resourcestr.rssetupnotesdirfirst" msgid "Please setup a notes directory first" msgstr "Stel eerst een notitiemap in" #: resourcestr.rssetupsyncfirst msgctxt "resourcestr.rssetupsyncfirst" msgid "Please config sync system first" msgstr "Stel eerst de synchronisatie in" #: resourcestr.rssnapshotcreated msgctxt "resourcestr.rssnapshotcreated" msgid "created, do you want to copy it elsewhere ?" msgstr "Aangemaakt. Wilt u ergens een kopie opslaan?" #: resourcestr.rssyncclash msgid "A Sync Clash has occurred" msgstr "" #: resourcestr.rssyncclashadvice msgid "Run the Sync from Main Menu to resolve" msgstr "" #: resourcestr.rssyncerror msgctxt "resourcestr.rssyncerror" msgid "A Sync Error occurred" msgstr "Synchronisatiefout" #: resourcestr.rssyncnotconfig msgctxt "resourcestr.rssyncnotconfig" msgid "not configured" msgstr "niet ingesteld" #: resourcestr.rssynctypefile msgid "File Sync - local or shared filesystem" msgstr "" #: resourcestr.rssynctypegithub msgid "Github - free Github account required" msgstr "" #: resourcestr.rstestingcredentials msgid "Testing Credentials" msgstr "Bezig met verifiëren van inloggegevens…" #: resourcestr.rstestingrepo #, fuzzy #| msgid "Testing Repo ...." msgctxt "resourcestr.rstestingrepo" msgid "Testing Repository ...." msgstr "Bezig met testen van repo…" #: resourcestr.rstestingsync msgctxt "resourcestr.rstestingsync" msgid "Testing Sync" msgstr "Bezig met testen van synchronisatie…" #: resourcestr.rstryrecover_1 msgid "Try to recover a bad note by double clicking below," msgstr "Dubbelklik hieronder om te trachten een beschadigde notitie te herstellen" #: resourcestr.rstryrecover_2 msgctxt "resourcestr.rstryrecover_2" msgid "if that fails, you may be able to recover it from a Snapshot." msgstr "Als dit mislukt, dan kunt u wellicht een reservekopie herstellen." #: resourcestr.rsunabletoproceed msgctxt "resourcestr.rsunabletoproceed" msgid "Unable to proceed because" msgstr "Kan niet doorgaan vanwege" #: resourcestr.rsunabletosync msgctxt "resourcestr.rsunabletosync" msgid "Unable to sync because " msgstr "Kan niet synchroniseren vanwege " #: resourcestr.rsuploaded msgid "Uploaded" msgstr "Geüpload" #: resourcestr.rsuploading msgid "Uploading" msgstr "Bezig met uploaden…" #: resourcestr.rsutf8charlist msgid "Click here to browse to full list" msgstr "" #: resourcestr.rswarnnossystray msgid "WARNING, your Desktop might not display SysTray" msgstr "LET OP: mogelijk heeft u geen systeemvak" #: resourcestr.rswehavesnapshots #, object-pascal-format msgid "We have %d snapshots" msgstr "Er zijn %d reservekopieën" #: settings.rsdictionaryfailed msgid "Library Not Loaded" msgstr "Geen bibliotheek geladen" #: settings.rsdictionaryloaded msgid "Dictionary Loaded OK" msgstr "Woordenboek is geladen" #: settings.rsdictionarynotfound msgid "No Dictionary Found" msgstr "Geen woordenboek aangetroffen" #: settings.rsdirhasnonotes msgid "That directory does not contain any notes. That is OK, if I can make my own there." msgstr "Deze map bevat geen notities. Dat is niet erg, want nu kan deze worden gebruikt voor nieuwe notities." #: settings.rserrorcannotwrite msgid "Cannot write into" msgstr "Kan niet wegschrijven naar" #: settings.rserrorcreatedir msgid "Unable to Create Directory" msgstr "Kan map niet aanmaken" #: settings.rsselectdictionary msgid "Select the dictionary you want to use" msgstr "Kies de te gebruiken map" #: settings.rsselectlibrary msgid "Select your hunspell library" msgstr "Kies een hunspell-bibliotheek" #: spelling.rscheckingfull msgid "Checking full document" msgstr "Bezig met controleren van document…" #: spelling.rscheckingselection msgid "Checking selection" msgstr "Bezig met controleren van selectie…" #: spelling.rsreplace_with_1 msgid "replace" msgstr "vervangen" #: spelling.rsreplace_with_2 msgid "with" msgstr "door" #: spelling.rsspellcomplete msgid "Spell check complete" msgstr "Spellingcontrole voltooid" #: spelling.rsspellnotconfig msgid "Spelling not configured" msgstr "Spellingcontrole is niet ingesteld" #: syncutils.rschangeexistingsync msgid "Change existing sync connection ?" msgstr "Wilt u de bestaande synchronisatieverbinding aanpassen?" #: syncutils.rsclashes msgid "Clashes " msgstr "Conflicten " #: syncutils.rsdonothing msgid "Do Nothing " msgstr "Niets doen " #: syncutils.rsdownloads msgid "Downloads " msgstr "Downloads " #: syncutils.rsedituploads msgid "Edit Uploads " msgstr "Uploads aanpassen " #: syncutils.rslocaldeletes msgid "Local Deletes " msgstr "Lokale prullenbak " #: syncutils.rsnewuploads msgid "New Uploads " msgstr "Nieuwe uploads " #: syncutils.rsnextbitslow msgid "Next bit can be a bit slow, please wait" msgstr "Het volgende onderdeel kan even duren…" #: syncutils.rsnonotesneededsync msgid "No notes needed syncing. You need to write more." msgstr "Geen synchronisatie benodigd. Maak meer notities :-)" #: syncutils.rsnotesweredealt msgid " notes were dealt with." msgstr " notities behandeld." #: syncutils.rsnotrecommend msgid "Generally not recommended." msgstr "Meestal niet aanbevolen." #: syncutils.rsremotedeletes msgid "Remote Deletes " msgstr "Externe prullenbak" #: syncutils.rssyncerrors msgid "ERRORS (see console log) " msgstr "FOUTMELDINGEN (zie terminaluitvoer) " #: teditboxform.buttmaintbmenu.caption msgctxt "teditboxform.buttmaintbmenu.caption" msgid "Menu" msgstr "Menu" #: teditboxform.editfind.text msgid "EditFind" msgstr "EditFind" #: teditboxform.label2.caption msgid "Read Only" msgstr "Alleen-lezen" #: teditboxform.label3.caption msgid "This note has been changed by the Sync Process" msgstr "Deze notitie is tijdens het synchroniseren gewijzigd" #: teditboxform.label4.caption msgid "Please close it (and re-open if it was a download)" msgstr "Sluit het venster (en heropen het als het een download betrof)" #: teditboxform.menubold.caption msgctxt "teditboxform.menubold.caption" msgid "Bold" msgstr "Vetgedrukt" #: teditboxform.menufindnext.caption msgid "Find Next" msgstr "Volgende zoeken" #: teditboxform.menufindprev.caption msgctxt "teditboxform.menufindprev.caption" msgid "Find Prev" msgstr "Vorige zoeken" #: teditboxform.menufixedwidth.caption msgid "Fixed Width" msgstr "Vaste breedte" #: teditboxform.menuhighlight.caption msgctxt "teditboxform.menuhighlight.caption" msgid "Highlight" msgstr "Markeren" #: teditboxform.menuhuge.caption msgctxt "teditboxform.menuhuge.caption" msgid "Huge" msgstr "Enorm" #: teditboxform.menuitalic.caption msgid "Italic" msgstr "Cursief" #: teditboxform.menuitembulletleft.caption #, fuzzy #| msgid "Bullet <<" msgid "Bullet -" msgstr "Opsommingsteken <<" #: teditboxform.menuitembulletright.caption #, fuzzy #| msgid "Bullet >>" msgid "Bullet +" msgstr "Opsommingsteken >>" #: teditboxform.menuitemcopy.caption msgid "Copy" msgstr "Kopiëren" #: teditboxform.menuitemcopyplain.caption msgid "Copy Plain" msgstr "" #: teditboxform.menuitemcut.caption msgid "Cut" msgstr "Knippen" #: teditboxform.menuitemdelete.caption msgctxt "teditboxform.menuitemdelete.caption" msgid "Delete" msgstr "Verwijderen" #: teditboxform.menuitemevaluate.caption msgid "Evaluate" msgstr "Evalueren" #: teditboxform.menuitemexport.caption msgid "Export" msgstr "Exporteren" #: teditboxform.menuitemexportmarkdown.caption msgid "Export Markdown" msgstr "Exporteren als markdown" #: teditboxform.menuitemexportpdf.caption msgid "Export PDF" msgstr "" #: teditboxform.menuitemexportplaintext.caption msgid "Export Plain Text" msgstr "Exporteren als platte tekst" #: teditboxform.menuitemexportrtf.caption msgid "Export RTF" msgstr "Exporteren als rtf" #: teditboxform.menuitemfind.caption msgid "Find in this Note" msgstr "Notitie doorzoeken" #: teditboxform.menuitemindex.caption msgid "Index" msgstr "Index" #: teditboxform.menuitempaste.caption msgid "Paste" msgstr "Plakken" #: teditboxform.menuitemprint.caption msgid "Print" msgstr "Afdrukken" #: teditboxform.menuitemselectall.caption msgid "Select All" msgstr "Alles selecteren" #: teditboxform.menuitemsettings.caption msgctxt "teditboxform.menuitemsettings.caption" msgid "Settings" msgstr "Instellingen" #: teditboxform.menuitemspell.caption msgid "Spell Check" msgstr "Spellingcontrole" #: teditboxform.menuitemsync.caption msgid "Synchronize" msgstr "Synchroniseren" #: teditboxform.menularge.caption msgid "Large Font" msgstr "Groot lettertype" #: teditboxform.menunormal.caption msgid "Normal Font" msgstr "Normaal lettertype" #: teditboxform.menusmall.caption msgid "Small Font" msgstr "Klein lettertype" #: teditboxform.menustayontop.caption msgid "Stay On Top" msgstr "Altijd bovenaan" #: teditboxform.menustrikeout.caption msgid "Strikeout" msgstr "Doorhalen" #: teditboxform.menuunderline.caption msgid "Underline" msgstr "Onderstrepen" #: teditboxform.speedbuttondelete.hint msgid "Delete this note" msgstr "Notitie verwijderen" #: teditboxform.speedbuttonlink.hint #, fuzzy #| msgid "Link highlighted text to a new note" msgid "Create new linked note (text selected) or display Backlinks." msgstr "Gemarkeerde tekst koppelen aan nieuwe notitie" #: teditboxform.speedbuttonnotebook.hint msgid "Manage Notebooks" msgstr "Notitieboeken beheren" #: teditboxform.speedbuttonsearch.hint msgid "Search All Notes Ctrl-Shift-F" msgstr "Alle notities doorzoeken (Ctrl+Shift+F)" #: teditboxform.speedbuttontext.hint msgid "Font size, bold, italics etc" msgstr "Tekstgrootte, vetgedrukt, cursief, etc." #: teditboxform.speedbuttontools.hint msgid "Tools - Sync, Export, Spell" msgstr "Hulpmiddelen (synchroniseren, exporteren, spellingcontrole)" #: teditboxform.speedclose.caption #, fuzzy msgctxt "teditboxform.speedclose.caption" msgid "Close" msgstr "Sluiten" #: teditboxform.speedrollback.hint msgid "Roll Back" msgstr "Reservekopie herstellen" #: teditboxform.speedsymbol.hint msgid "Insert extended character or symbol" msgstr "" #: tformbackupview.buttondelete.caption msgctxt "tformbackupview.buttondelete.caption" msgid "Delete" msgstr "Verwijderen" #: tformbackupview.buttondelete.hint msgid "Really, totally delete this note." msgstr "Ja, écht verwijderen." #: tformbackupview.buttonok.caption msgctxt "tformbackupview.buttonok.caption" msgid "Close" msgstr "Sluiten" #: tformbackupview.buttonok.hint msgid "My work here is done." msgstr "Mijn werk zit er op." #: tformbackupview.buttonopen.caption msgid "View" msgstr "Bekijken" #: tformbackupview.buttonopen.hint msgid "Open and view the whole note" msgstr "Open en bekijk de gehele notitie" #: tformbackupview.buttonrecover.caption msgctxt "tformbackupview.buttonrecover.caption" msgid "Recover" msgstr "Herstellen" #: tformbackupview.buttonrecover.hint msgid "Restore this note to main repo" msgstr "Herstel deze notitie vanuit de hoofdrepo" #: tformbackupview.caption msgid "View, recover or delete Backup Files" msgstr "Bekijk, herstel of verwijder reservekopieën" #: tformbackupview.listbox1.hint msgid "Use Ctrl or Shift to select multiple entries" msgstr "Gebruik Ctrl of Shift om meerdere items te verwijderen" #: tformcolours.label1.caption msgid "Sample" msgstr "Voorbeeld" #: tformcolours.label2.caption msgctxt "tformcolours.label2.caption" msgid "Set Colours" msgstr "Kleuren instellen" #: tformcolours.speedbackground.caption msgid "Background" msgstr "Achtergrond" #: tformcolours.speedcancel.caption msgctxt "tformcolours.speedcancel.caption" msgid "Cancel" msgstr "Annuleren" #: tformcolours.speeddefault.caption msgid "Default" msgstr "Standaard" #: tformcolours.speedhighlight.caption msgctxt "tformcolours.speedhighlight.caption" msgid "Highlight" msgstr "Markeren" #: tformcolours.speedlinks.caption msgid "Links" msgstr "" #: tformcolours.speedok.caption msgctxt "tformcolours.speedok.caption" msgid "OK" msgstr "Oké" #: tformcolours.speedtext.caption msgid "Text" msgstr "Tekst" #: tformcolours.speedtitle.caption msgctxt "tformcolours.speedtitle.caption" msgid "Title" msgstr "Titel" #: tformindex.caption msgid "Heading in this Note" msgstr "Kop in van deze notitie" #: tformindex.panel1.caption msgid "Single lines, all Huge, Large Bold or Large" msgstr "Losse regels, groot, alles groot, groot en vetgedrukt" #: tformkmemo2pdf.caption msgid "PDF Issues" msgstr "" #: tformrecover.buttondeletebadnotes.caption msgid "Delete Bad Notes" msgstr "Beschadigde notities verwijderen" #: tformrecover.buttonmakesafetysnap.caption msgid "Take a manual Snapshot" msgstr "Reservekopie maken" #: tformrecover.buttonmakesafetysnap.hint msgid "Take a initial snapshot of your notes and config. Overwritten each time." msgstr "Maak een reservekopie van uw notities en instellingen. Let op: deze wordt telkens overschreven." #: tformrecover.buttonrecoversnap.caption msgctxt "tformrecover.buttonrecoversnap.caption" msgid "Recover" msgstr "Herstellen" #: tformrecover.buttonsnaphelp.caption msgid "Snapshot Help" msgstr "Hulp omtrent reservekopieën" #: tformrecover.label10.caption msgid "Please close any notes you may have open." msgstr "Sluit alle geopende notities." #: tformrecover.label12.caption msgid "Don't even consider this unless you have a backup Snapshot, Intro Tab." msgstr "Let op: overweeg dit pas als u een reservekopie hebt gemaakt." #: tformrecover.label14.caption msgid "Click an available snapshot to see its contents." msgstr "Klik op een reservekopie om de inhoud ervan te bekijken." #: tformrecover.label15.caption msgid "Click an available snapshot, click Recover" msgstr "Klik op een beschikbare reservekopie en vervolgens op ‘Herstellen’" #: tformrecover.label16.caption msgid "You may chose to view, copy and paste into a new note." msgstr "U kunt kiezen uit bekijken, kopiëren en plakken naar een nieuwe notitie." #: tformrecover.label2.caption msgid "Please be careful, this is a dangerous place!" msgstr "Let op: dit is een gevaarlijke sectie!" #: tformrecover.label3.caption msgid "Restore any notes in the snapshot that are not in the existing notes directory." msgstr "Herstel alle notities uit de reservekopie die niet aanwezig zijn in de notitiemap." #: tformrecover.label4.caption msgid "Remove all existing notes and use the ones in the Snapshot." msgstr "Verwijder alle bestaande notities en vervang ze door die uit de reservekopie." #: tformrecover.label5.caption msgid "Looking for notes with damaged XML" msgstr "Notities met onjuiste xml-opmaak" #: tformrecover.label6.caption msgid "This tool might help you recover lost or damaged notes." msgstr "Hiermee kunt u ontbrekende of beschadigde notities herstellen." #: tformrecover.label7.caption msgid "Before you start, take a Snapshot of your notes directory." msgstr "Maak eerst een reservekopie van uw notitiemap." #: tformrecover.label9.caption msgid "From here you can view snapshot notes, one by one." msgstr "Vanaf hier kunt u een voor een notities uit de reservekopie bekijken." #: tformrecover.listboxsnapshots.hint msgid "These are the currently known snapshots. " msgstr "Hier vindt u de huidige reservekopieën. " #: tformrecover.panelsnapshots.caption msgid "Available Snapshots" msgstr "Beschikbare reservekopieën" #: tformrecover.tabsheetbadnotes.caption msgid "Bad Notes" msgstr "Beschadigde notities" #: tformrecover.tabsheetintro.caption msgid "Introduction" msgstr "Introductie" #: tformrecover.tabsheetmergesnapshot.caption msgid "Merge Snapshot" msgstr "Reservekopie samenvoegen" #: tformrecover.tabsheetrecovernotes.caption msgid "Recover Notes" msgstr "Notities herstellen" #: tformrecover.tabsheetrecoversnapshot.caption msgid "Recover Snapshot" msgstr "Reservekopie herstellen" #: tformrollback.speedcancel.caption msgctxt "tformrollback.speedcancel.caption" msgid "Cancel" msgstr "Annuleren" #: tformrollback.speedrolltoopen.caption msgid "Opening Backup" msgstr "Bezig met openen van reservekopie…" #: tformrollback.speedrolltotitle.caption msgid "Title Change Backup" msgstr "Naam van reservekopie wijzigen" #: tformsdiff.bitbtnuselocal.caption msgid "Use Local" msgstr "Lokaal" #: tformsdiff.bitbtnuseremote.caption msgid "Use Remote" msgstr "Extern" #: tformsdiff.buttalllocal.caption msgid "Local" msgstr "Lokaal" #: tformsdiff.buttallnewest.caption msgid "Newest" msgstr "Nieuwste" #: tformsdiff.buttalloldest.caption msgid "Oldest" msgstr "Oudste" #: tformsdiff.buttallremote.caption msgid "Remote" msgstr "Extern" #: tformsdiff.caption msgid "A Note Sync Clash has been Detected" msgstr "Er heeft zich een conflict voorgedaan" #: tformsdiff.label1.caption msgid "Or make a choice for remainder of this run" msgstr "Of maak een keuze voor de rest van deze opdracht" #: tformsdiff.label3.caption msgid "Remote Changed" msgstr "Extern gewijzigd" #: tformsdiff.label4.caption msgid "Local Changed" msgstr "Lokaal gewijzigd" #: tformsdiff.radiolong.caption msgid "Long Lines" msgstr "Lange regels" #: tformsdiff.radiolong.hint msgid "Maybe necessary to show difference" msgstr "Dit kan handig zijn om verschillen te tonen" #: tformsdiff.radioshort.caption msgid "Short Lines" msgstr "Korte regels" #: tformsdiff.radioshort.hint msgid "Easier to read" msgstr "Dit is makkelijk te lezen" #: tformspell.buttonignore.caption msgid "Ignore" msgstr "Negeren" #: tformspell.buttonignore.hint msgid "Ignore all instances for the run" msgstr "Negeer alles tijdens deze opdracht" #: tformspell.buttonskip.caption msgid "Skip" msgstr "Overslaan" #: tformspell.buttonskip.hint msgid "Skip just this instance" msgstr "Sla eenmalig over" #: tformspell.buttonuseandnextword.caption msgid "Use and Next Word" msgstr "Gebruiken en ga naar volgende woord" #: tformspell.caption msgctxt "tformspell.caption" msgid "Spell" msgstr "Spellingcontrole" #: tformspell.label4.caption msgid "Suspect word -" msgstr "Voorgesteld woord -" #: tformspell.labelprompt.caption msgid "Click a word to use it." msgstr "Klik op een woord om het te gebruiken." #: tformsymbol.bitbtnrevert.caption msgid "Revert" msgstr "" #: tformsymbol.caption msgid "Symbol" msgstr "" #: tformsymbol.stringgrid1.columns[0].title.caption #, fuzzy msgctxt "tformsymbol.stringgrid1.columns[0].title.caption" msgid "Title" msgstr "Titel" #: tformsymbol.stringgrid1.columns[1].title.caption #, fuzzy msgctxt "tformsymbol.stringgrid1.columns[1].title.caption" msgid "Title" msgstr "Titel" #: tformsync.buttoncancel.caption msgctxt "tformsync.buttoncancel.caption" msgid "Cancel" msgstr "Annuleren" #: tformsync.buttonclose.caption msgctxt "tformsync.buttonclose.caption" msgid "Close" msgstr "Sluiten" #: tformsync.buttonsave.caption msgid "Save and Sync" msgstr "Opslaan en synchroniseren" #: tformsync.caption msgctxt "tformsync.caption" msgid "Sync" msgstr "Synchroniseren" #: tformsync.listviewreport.columns[0].caption msgid "Action" msgstr "Actie" #: tformsync.listviewreport.columns[1].caption msgctxt "tformsync.listviewreport.columns[1].caption" msgid "Title" msgstr "Titel" #: tformsync.listviewreport.columns[2].caption msgid "Note ID" msgstr "Notitie-id" #: tmainform.bitbtnhide.caption msgid "Hide" msgstr "Verbergen" #: tmainform.bitbtnquit.caption msgctxt "tmainform.bitbtnquit.caption" msgid "Quit" msgstr "Afsluiten" #: tmainform.buttmenu.caption msgctxt "tmainform.buttmenu.caption" msgid "Menu" msgstr "Menu" #: tmainform.buttsystrayhelp.caption msgid "SysTray Help" msgstr "Hulp omtrent systeemvak" #: tmainform.caption msgid "tomboy-ng" msgstr "tomboy-ng" #: tmainform.checkboxdontshow.caption msgid "Don't Show for normal startup" msgstr "Niet tonen tijdens normaal opstarten" #: tmainform.checkboxdontshow.hint msgid "You can reverse this from Settings" msgstr "U kunt dit aanpassen in de instellingen" #: tmainform.hint msgid "If the yellow tomboy-ng icon is visible in your System Tray, you can dismiss this window." msgstr "Als het gele tomboy-ng-pictogram niet in het systeemvak verschijnt, dan kunt u dit venster sluiten." #: tmainform.label3.caption msgid "Dictionary Config (optional)" msgstr "Woordenboekinstellingen (optioneel)" #: tmainform.label4.caption msgid "Sync Config (optional)" msgstr "Synchronisatie-instellingen (optioneel)" #: tmainform.label5.caption msgid "Welcome to tomboy-ng !" msgstr "Welkom bij tomboy-ng!" #: tmainform.labelerror.hint msgid "Launch from commandline to see errors or see Config->SnapShot->Recover ..." msgstr "Start vanaf de opdrachtregel om foutmeldingen te tonen of ga naar Instellingen → Reservekopie → Herstellen" #: tnotebookpick.button1.caption msgctxt "tnotebookpick.button1.caption" msgid "Cancel" msgstr "Annuleren" #: tnotebookpick.buttonok.caption msgctxt "tnotebookpick.buttonok.caption" msgid "OK" msgstr "Oké" #: tnotebookpick.caption #, fuzzy msgctxt "tnotebookpick.caption" msgid "Notebooks" msgstr "Notitieboeken" #: tnotebookpick.label4.caption msgid "Name of the New Notebook" msgstr "Naam van nieuw notitieboek" #: tnotebookpick.label5.caption #, fuzzy #| msgid "Press OK and we will make the Note Book AND add this note to it." msgid "Press OK and we will make the Notebook AND add this note to it." msgstr "Klik op oké om het notitieboek aan te maken én deze notitie er aan toe te voegen." #: tnotebookpick.label6.caption msgid "Existing Name" msgstr "Huidige naam" #: tnotebookpick.label8.caption msgid "New Name" msgstr "Nieuwe naam" #: tnotebookpick.label9.caption #, fuzzy #| msgid "If you sync and are not absolutely sure its up to date, Cancel now !" msgid "If you sync and are not absolutely sure it is up to date, Cancel now !" msgstr "Let op: als u gebruikmaakt van synchronisatie en twijfelt over de bijwerkdatum, breek het proces dan nu af!" #: tnotebookpick.tabchangename.caption msgid "Change Notebook Name" msgstr "Notitieboeknaam wijzigen" #: tnotebookpick.tabexisting.caption msgid "Existing Note Books" msgstr "Bestaande notitieboeken" #: tnotebookpick.tabnewnotebook.caption msgid "New Note Book" msgstr "Nieuw notitieboek" #: tnotebookpick.tabsetnotes.caption msgid "Set Notes" msgstr "Notities instellen" #: tsearchform.bitbtnmenu.caption #, fuzzy msgctxt "tsearchform.bitbtnmenu.caption" msgid "Menu" msgstr "Menu" #: tsearchform.buttonclearfilters.caption msgctxt "tsearchform.buttonclearfilters.caption" msgid "Clear" msgstr "Wissen" #: tsearchform.buttonclearsearch.caption #, fuzzy msgctxt "tsearchform.buttonclearsearch.caption" msgid "Clear" msgstr "Wissen" #: tsearchform.buttonsearchoptions.caption #, fuzzy msgctxt "tsearchform.buttonsearchoptions.caption" msgid "Options" msgstr "Opties" #: tsearchform.caption msgid "tomboy-ng_Search" msgstr "tomboy-ng_Zoeken" #: tsearchform.listboxnotebooks.hint msgid "Right Click to manage Notebooks" msgstr "Klik rechts om notitieboeken te beheren" #: tsearchform.menucreatenotebook.caption #, fuzzy #| msgid "Create new Note Book" msgid "Create new Notebook" msgstr "Nieuw notitieboek" #: tsearchform.menudeletenotebook.caption msgid "Delete Notebook" msgstr "Notitieboek verwijderen" #: tsearchform.menueditnotebooktemplate.caption msgid "Edit Notebook Template" msgstr "Notitieboeksjabloon aanpassen" #: tsearchform.menuitemcasesensitive.caption msgctxt "tsearchform.menuitemcasesensitive.caption" msgid "Case Sensitive" msgstr "Hoofdlettergevoelig" #: tsearchform.menuitemimportnote.caption msgid "Import File" msgstr "Bestand importeren" #: tsearchform.menuitemmanagenbook.caption #, fuzzy #| msgid "Manage Notes in Note Book" msgid "Manage Notes in Notebook" msgstr "Notities in notitieboek beheren" #: tsearchform.menuitemswyt.caption msgid "Search While You Type" msgstr "Zoeken tijdens het typen" #: tsearchform.menunewnotefromtemplate.caption msgid "Create New Note from Template" msgstr "Nieuwe notitie uit sjabloon" #: tsearchform.menurenamenotebook.caption #, fuzzy #| msgid "Rename NoteBook" msgid "Rename Notebook" msgstr "Notitieboeknaam wijzigen" #: tsearchform.panel2.caption msgctxt "tsearchform.panel2.caption" msgid "Notebooks" msgstr "Notitieboeken" #: tsett.buttonfixedfont.caption msgid "Fixed Font" msgstr "Vastebreedtelettertype" #: tsett.buttonfont.caption msgid "Usual Font" msgstr "Normaal lettertype" #: tsett.buttonmanualsnap.caption msgid "Take a Manual Snapshot" msgstr "Reservekopie maken" #: tsett.buttonmanualsnap.hint msgid "Take a time stamped snapshot of notes and config" msgstr "Maak een reservekopie met tijdstip van de notities en instellingen" #: tsett.buttonsetcolours.caption msgctxt "tsett.buttonsetcolours.caption" msgid "Set Colours" msgstr "Kleuren instellen" #: tsett.buttonsetdictionary.caption msgid "Set Dictionary" msgstr "Woordenboek instellen" #: tsett.buttonsetnotepath.caption msgid "Set Path to Note Files" msgstr "Locatie van notitiebestanden instellen" #: tsett.buttonsetnotepath.hint msgid "If you have notes somewhere else" msgstr "Als u uw notities ergens anders bewaart" #: tsett.buttonsetspelllibrary.caption msgid "Set Spell Library" msgstr "Spellingcontrole instellen" #: tsett.buttonshowbackup.caption msgid "Show Me" msgstr "Instructies tonen" #: tsett.buttonsnaprecover.caption msgid "Recover Lost Notes" msgstr "Notities herstellen" #: tsett.buttonsnaprecover.hint msgid "If you have previously taken a snapshot ..." msgstr "Als u eerder een reservekopie heeft gemaakt" #: tsett.checkautosnapenabled.caption msgid "Use auto snapshots" msgstr "Automatische reservekopieën maken" #: tsett.checkautostart.caption msgid "Autostart at Logon" msgstr "Automatisch opstarten" #: tsett.checkescclosesnote.caption #, fuzzy #| msgid "Esc Closes Note" msgid "ESC Closes Note" msgstr "Notities sluiten met Esc-toets" #: tsett.checkfindtoggles.caption msgid "Find Command Toggles" msgstr "Zoekopdracht schakelt:" #: tsett.checkfindtoggles.hint msgctxt "tsett.checkfindtoggles.hint" msgid "eg Ctrl-F opens and closes Find Window" msgstr "bijv. Ctrl+F om het zoekvenster te tonen/verbergen" #: tsett.checkmanynotebooks.caption msgid "Allow a Note to be in Multiple Notebooks." msgstr "Bewaar een notitie in meerdere notitieboeken." #: tsett.checkmanynotebooks.hint msgid "This may adversly affect traditional Tomboy, take care." msgstr "Let op: dit kan averechts werken in het klassieke Tomboy-programma." #: tsett.checknotifications.caption msgid "Show Notifications" msgstr "Meldingen tonen" #: tsett.checkshowextlinks.caption #, fuzzy #| msgid "Show External Links" msgid "Show External Links" msgstr "Externe links tonen" #: tsett.checkshowintlinks.caption msgid "Show Internal Links" msgstr "Interne links tonen" #: tsett.checkshowsearchatstart.caption msgid "Show Search at Start" msgstr "Zoekvenster openen na opstarten" #: tsett.checkshowsplash.caption msgid "Show Splash at Start" msgstr "Opstartscherm tonen" #: tsett.checkshowsplash.hint msgid "Always shown if error loading notes." msgstr "Dit scherm wordt altijd getoond als er een foutmelding optreedt." #: tsett.checkstampbold.caption msgctxt "tsett.checkstampbold.caption" msgid "Bold" msgstr "Vetgedrukt" #: tsett.checkstampitalics.caption msgid "Italics" msgstr "Cursief" #: tsett.checkstampsmall.caption msgctxt "tsett.checkstampsmall.caption" msgid "Small" msgstr "Klein" #: tsett.checkuseundo.caption msgid "Use Undo Redo (may slow editing)" msgstr "Ongedaan maken/Opnieuw uitvoeren gebruiken (kan vertragend werken)" #: tsett.checkuseundo.hint msgid "Close and reopen a note to take effect. Use Ctrl-Z Ctrl-Y" msgstr "Ctrl+Z en Ctrl+Y. Sluit en heropen de notitie om toe te passen." #: tsett.combosynctiming.text msgid "ComboSyncTiming" msgstr "" #: tsett.combosynctype.hint msgid "Github or File Sync" msgstr "" #: tsett.groupbox4.caption msgctxt "tsett.groupbox4.caption" msgid "When a conflict is detected between a local note and remote one :" msgstr "Bij conflicten tussen een lokale en externe notitie:" #: tsett.groupbox5.caption msgid "Font Size" msgstr "Tekstgrootte" #: tsett.groupboxsync.caption msgid " Sync " msgstr " Synchronisatie " #: tsett.groupboxtoken.caption msgctxt "tsett.groupboxtoken.caption" msgid "Token" msgstr "Toegangssleutel" #: tsett.groupboxuser.caption msgctxt "tsett.groupboxuser.caption" msgid "User" msgstr "Gebruiker" #: tsett.groupnotespath.caption msgid "Notes Path" msgstr "" #: tsett.label1.caption msgid "Settings will be saved in :" msgstr "De instellingen worden opgeslagen in " #: tsett.label10.caption msgid "Help Notes Language" msgstr "Taal van handleiding" #: tsett.label11.caption msgid "Backup Files" msgstr "Reservekopieën" #: tsett.label13.caption msgid "Spell Check requires the Hunspell Libraries and" msgstr "Voor spellingcontrole is Hunspell vereist, evenals" #: tsett.label14.caption msgid "an appropriate Hunspell Dictionary set." msgstr "een bijbehorend Hunspell-woordenboek." #: tsett.label16.caption msgid "Maximum number of snapshots" msgstr "Maximaal aantal reservekopieën" #: tsett.label17.caption msgid "Date Stamp Format" msgstr "Opmaak van datumstempel" #: tsett.label2.caption msgid "Notes will be looked for and saved in :" msgstr "Notities worden gezocht en opgeslagen in " #: tsett.label4.caption msgid "Repo : " msgstr "Repo: " #: tsett.label5.caption msgid "Days per snapshot" msgstr "Aantal dagen per reservekopie" #: tsett.label6.caption msgid "Backup files are made when you delete a note or the sync system" msgstr "Reservekopieën worden automatisch gemaakt zodra u een notitie verwijderd of als" #: tsett.label7.caption msgid "is about to overwrite one. " msgstr "de synchronisatie een oudere versie overschrijft. " #: tsett.label8.caption msgid "They remain, forever, unless you do something about them." msgstr "Reservekopieën worden in principe permanent bewaard." #: tsett.label9.caption msgid "A snaphot is a copy of your current note directory." msgstr "Een reservekopie is een kopie van uw huidige notitiemap." #: tsett.labelsnapdir.caption msgid "Snap dir" msgstr "Reservekopiemap" #: tsett.labelsyncrepo.caption msgctxt "tsett.labelsyncrepo.caption" msgid "not configured" msgstr "niet ingesteld" #: tsett.labelsynctiming.caption msgid "Sync Timing" msgstr "" #: tsett.labelsynctype.caption msgid "Sync Type" msgstr "Synchronisatietype" #: tsett.menuitemcopytoken.caption msgid "Copy Existing Token" msgstr "Huidige toegangssleutel kopiëren" #: tsett.menuitemgettoken.caption msgid "Get a Token in your Browser" msgstr "Nieuwe toegangssleutel ophalen via webbrowser" #: tsett.menuitempastetoken.caption msgid "Paste a New Token" msgstr "Plak de nieuwe sleutel" #: tsett.radioalwaysask.caption msgid "Always Ask me what to do." msgstr "Altijd om een actie vragen" #: tsett.radiochoose.caption msgid "Choose" msgstr "" #: tsett.radiofontbig.caption msgid "Big" msgstr "Groot" #: tsett.radiofonthuge.caption msgctxt "tsett.radiofonthuge.caption" msgid "Huge" msgstr "Enorm" #: tsett.radiofontmedium.caption msgid "Medium" msgstr "Gemiddeld" #: tsett.radiofontsmall.caption msgctxt "tsett.radiofontsmall.caption" msgid "Small" msgstr "Klein" #: tsett.radiotomboydefault.caption msgid "Old Tomboy Default" msgstr "" #: tsett.radiotomboyngdefault.caption msgid "tomboy-ng Default" msgstr "" #: tsett.radiouselocal.caption msgid "Use Local Note and Overwrite Server Note." msgstr "Overschrijf een servernotitie met een lokale notitie." #: tsett.radiouseserver.caption msgid "Use Server Note and Rename Local Note." msgstr "Gebruik een servernotitie en wijzig de naam van een lokale notitie." #: tsett.speedbuthelp.caption msgctxt "tsett.speedbuthelp.caption" msgid "Help" msgstr "Hulp" #: tsett.speedbuthide.caption msgctxt "tsett.speedbuthide.caption" msgid "Close" msgstr "Sluiten" #: tsett.speedbutttbmenu.caption msgctxt "tsett.speedbutttbmenu.caption" msgid "Menu" msgstr "Menu" #: tsett.speedsetupsync.caption msgctxt "tsett.speedsetupsync.caption" msgid "Setup" msgstr "Instellen" #: tsett.speedtokenactions.caption msgid "Actions" msgstr "Acties" #: tsett.tabbackup.caption msgid "BackUp" msgstr "Reservekopie" #: tsett.tabbasic.caption msgid "Basic" msgstr "Algemeen" #: tsett.tabdisplay.caption msgid "Notes" msgstr "Notities" #: tsett.tabrecover.caption msgctxt "tsett.tabrecover.caption" msgid "Recover" msgstr "Herstellen" #: tsett.tabspell.caption msgctxt "tsett.tabspell.caption" msgid "Spell" msgstr "Spellingcontrole" #: tsett.tabsync.caption msgctxt "tsett.tabsync.caption" msgid "Sync" msgstr "Synchroniseren" tomboy-ng_0.39-1/LICENSE.txt0000644000175000017500000000340314551457644015262 0ustar dbannondbannon The Clear BSD License Copyright (c) 2022 David Bannon All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted (subject to the limitations in the disclaimer below) provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. NO EXPRESS OR IMPLIED LICENSES TO ANY PARTY'S PATENT RIGHTS ARE GRANTED BY THIS LICENSE. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. Some part of this project are covered by other licenses, please see the debian/copyright file for details. tomboy-ng_0.39-1/scripts/0000755000175000017500000000000014551457644015126 5ustar dbannondbannontomboy-ng_0.39-1/scripts/prepare.ppa0000755000175000017500000003572214551457644017302 0ustar dbannondbannon#!/bin/bash set -e # copyright David Bannon, 2019, 2020, use as you see fit, but retain this statement. # This stript is useful to prepare the tomboy-ng source tree to make an # Ubuntu PPA # For detailed instructions including ready to copy command lines see- # https://github.com/tomboy-notes/tomboy-ng/blob/master/prepare.md # If you submit it to PPA and get an error, or a revision of the packaing # is requested, DO NOT DELETE THE WORKING Build* DIR, you need it to generaate # fixes (run prepare.debian again, this time without the -n. Totally different # behaviour ! # Fine to blow it away if its not been uploaded with dput ! # we make, hard wired a Focal 20.04 Qt5 or a Bionic 18.04 GTK2 depending on -q # Made one at a time. # Most of code does not alter the PACKVER, only in PrepExistingOrigFile() # Remember that we don't build a Qt5 for Bionic, its libqt5pas is too old. # So, -Dbionic and -Q -Dfocal # David Bannon, July 2020 # History - # 2020-09-02 Added -D distro switch # 2020-12-17 Restructed the multi control system to make it clearer. # 2021-02-23 Allow for fact that we keep changelog (for Debian). # Remove some Debian specific things # 2021-06-19 cleanup and move how to doc to github # 2021-11-12 Now update changelog with whatsnew contents # 2022-11-17 Clearly defined the two modes we might work in, new or repackage # 2023-04-07 Build only for Focal, 20.04 now. Bionic a compiler problem. # --------------------------------------------------------- DISTROQT5="focal" DISTROGTK2="focal" VER="unknown" # this is what it should be for normal use, gets numb from src ! # Warning, nasty fudge follows, debugging measure, use with very great care, overrides # version no in source tree for packaging, but does not change the numb hard wired in binary # VER="0.35a" # These are mine, they are used as defaults if NOT set in env. Ignored unless signing. DEF_EMAIL="tomboy-ng@bannons.id.au" # This matches cert I use to sign tomboy-ng stuff DEF_FULLNAME="David Bannon" # # UBUNTU_FULLNAME="tomboy-ng" # My stuff up, different cert with different name in Ubuntu PPA ! # Housekeeping stuff, helpers for debugging etc. Set with command line, not here ! LAZ_BLD="" UFILES="NO" # debug tool, update Makefile CLEAN="NO" # debug tool, remove files from previous run. WIDGET="" # empty says make a GTK2, only other possibility is Qt5 QT5INNAME="" # May have content we add to qt5 package name (when -Q) PACKVER="-1" # -1 is normal, do not edit, its inc'ed if no -n. NEWORIG="no" # if set to YES its a release and we create new .orig.tar.gz" DISTRO1="$DISTROGTK2" APP="tomboy-ng" TB_SOURCE="master" # might be, eg, 0.35 etc, valid github tag, set with command line # Looks for fpc and lazbuild on PATH, if in root space, do nothing, # if in user space, because debuild will miss them, makes two files. function CheckFPC_LAZ () { FPC=`which fpc` if [ -x "$FPC" ]; then PREFIX="${FPC:0:4}" if [ "$PREFIX" = "/usr" ]; then echo "---------- root space fpc, all good" else echo "---------- Leaving a fpc file for buildit" echo "$FPC" > WHICHFPC fi else echo "----------- ERROR, no fpc found ------------" exit 1 fi if [ "$LAZ_BLD" = "" ]; then # we had better try to find it LAZ_BLD=`which lazbuild` fi if [ -x "$LAZ_BLD" ]; then PREFIX="${LAZ_BLD:0:4}" if [ "$PREFIX" = "/usr" ]; then echo "---------- root space Lazarus, all good" else echo "---------- Leaving a lazbuild file for buildit" echo "$LAZ_BLD" > WHICHLAZ fi else echo " --- ERROR, no lazbuild found, try -l ? ---" exit 1 fi } # Here we remove file that are not needed in the Debian SRC kit. function CleanSource () { rm -Rf experimental rm -Rf patches rm -Rf doc/gallery rm -Rf doc/html rm -Rf doc/wiki rm -Rf po/*.mo rm -f doc/*.svg doc/*.png doc/*.note rm -f glyphs/*.png glyphs/*.ico glyphs/*.svg glyphs/*.icns rm -fR glyphs/help rm -fR glyphs/demos KC="kcontrols" KCS="$KC/source" rm -fR "$KC"/demos rm -fR "$KC"/help rm -Rf "$KC"/packages kcontrols/tools rm -Rf "$KC"/resource_src/khexeditor_icons "$KC"/resource_src/kgrid_icons rm "$KCS"/kbuttons.pas "$KCS"/kdbgrids.pas "$KCS"/kgrids.* "$KCS"/kicon.pas rm "$KCS"/klabels.pas "$KCS"/kmemodlg*.* "$KCS"/kxml.pas "$KCS"/kwidewinprocs.pas rm "$KCS"/kmemofrm.* "$KCS"/kpagecontrol.* "$KCS"/kprogress.* "$KCS"/ksplitter.pas rm "$KC"/*.txt "$KC"/*.json "$KC"/*.bat rm -Rf "$KC"/packages "$KC"/tools "$KC"/resource_src/khexeditor_icons "$KC"/resource_src/kgrid_icons } function KControls () { if [ -e "master.zip" ]; then echo "Note: removing stray master.zip ???" rm -f master.zip fi if [ -e "KControls.zip" ]; then echo "Note: reusing existing KControls." else # wget https://github.com/kryslt/KControls/archive/master.zip # watch this name does not change. wget https://github.com/davidbannon/KControls/archive/master.zip # watch this name does not change. mv master.zip KControls.zip fi unzip -q KControls.zip # rm -f master.zip mv KControls-master "$APP"_"$VER""$PACKVER"/kcontrols } function ShowHelp () { echo " " echo "Use this script to make Ubuntu PPA (or plain binary), works in two modes -" echo "1. New Release, always make .orig.tar.gz file." echo "2. Repackage Mode, no -n, expects to find the files used for a previous" echo " sunmission to PPA" echo "So, important that you keep the files from a submission in case of a repack" echo "Assumes FPC 3.2.0 or Later in path. Will no longer build with FPC304." echo "Needs Lazarus, <=2.0.10 in root space or specified with -l option." echo "Needs devscripts preinstalled and maybe an edit of email address above if" echo "it is to be used in the DEB SRC tool chain. Its role there is just to create" echo "an initial tarball and working directory (including inserting kcontrols)." echo "David Bannon, December 2020" echo "-h print help message" echo "-l a full path to a viable lazbuild executable, eg also lcl dir is." echo "-C clean out deb files from previous run, debug use only." echo "-t tomboy-ng source, defaults to master or github tag, eg, 0.35 etc" echo "-U update Makefile and/or buildit.bash, debug use only." echo "-Q Make a Qt5 version instead of default GTK2" echo "-p Pause before creating .orig. to change content, use another term." echo "-n Make a new source package, as opposed to repackaging" echo "" echo "eg bash ./prepare.bash -n [-Q] ; cd tomboy[tab] " echo " debuild -S // check for errors !" echo " cd .. ; dput ppa:d-bannon/ppa-tomboy-ng *.changes [enter]" echo " ----- or, just build a binary ---------" echo "eg bash ./prepare.bash -n [-Q] ; cd tomboy[tab] " echo " bash ./buildit.bash " exit } function PrepExistingOrigFile { # Assume we are in a previously used dir, it will have orig and eg tomboy-ng_0.35-1 dir. # We are one level down, eg Build35 and can see the orig file and tomboy-ng_0.35-1 dir # Rename that dir, -2 .... # remove previous *.dsc, .buildinfo, .changes # Append an entry to the changelog # tell user to fix stuff and rerun debuild -S # you achive a similar position by extracting out .orig. with dpkg-source -x .... # tomboy-ng_0.35.orig.tar.gz echo "in PrepExistingOrigFile APP is $APP" EXDIRNAME=`find . -maxdepth 1 -type d -name "tomboy*" ` # there should be only one .... echo "in PrepExistingOrigFile 2 APP is $APP" if [ "$VER" == "unknown" ]; then VER=`cat "$EXDIRNAME"/package/version` fi echo "in PrepExistingOrigFile 3 APP is $APP" if [ -f "$APP""_""$VER"".orig.tar.gz" ]; then echo "Orig file present, thats good" else echo "in PrepExistingOrigFile 4 APP is $APP_$VER" echo "Orig file not present, ""$APP""_""$VER"".orig.tar.gz" echo "Giving up and going home ....." exit fi NEWDIRNAME=`echo "$EXDIRNAME" | rev | cut -c2- | rev ` # chop of last char PACKVER=`echo "$EXDIRNAME" | rev | cut -b 1 | rev ` # This is last char ((PACKVER=PACKVER+1)) # rev it, should test its not > 9 NEWDIRNAME="$NEWDIRNAME""$PACKVER" mv $EXDIRNAME $NEWDIRNAME rm -Rf *.dsc *.buildinfo *.changes *.debian.tar.xz if [ "$DEBEMAIL" = "" ]; then DEBEMAIL="$DEF_EMAIL" export DEBEMAIL fi if [ "$DEBFULLNAME" = "" ]; then DEBFULLNAME="$DEF_FULLNAME" export DEBFULLNAME fi VER="$VER""-""$PACKVER" # eg 0.35-2 cd "$NEWDIRNAME" pwd dch -v "$VER" -D"$DISTRO1" "$DISTRO2" "Repackage" cd .. pwd echo "If no errrors, you should now cd $NEWDIRNAME" echo "Make what ever changes seem appropriate and run debuild -S; cd .." exit # My work here is done } # End of function # --------------- S T A R T S H E R E ----------------- while getopts "nhpQUCl:D:t:" opt; do case $opt in h) ShowHelp ;; l) LAZ_BLD="$OPTARG" ;; U) UFILES="YES" ;; C) CLEAN="YES" ;; p) PAUSE="YES" ;; t) TB_SOURCE="$OPTARG" ;; Q) WIDGET="Qt5" APP="$APP""-qt5" DISTRO1="$DISTROQT5" ;; D) DISTRO1="$OPTARG" # DISTRO1="-D""$OPTARG" DISTRO2="--force-distribution" ;; n) NEWORIG="YES" ;; \?) echo "Invalid option: -$OPTARG" >&2 ShowHelp ;; esac done ORIGFILE=`find . -maxdepth 1 -name "*.orig.tar.gz" ` echo "orig file = $ORIGFILE and NEWORIG = $NEWORIG and APP = $APP" if [ "$NEWORIG" == "no" ]; then # if no -n, we always exit here. if [ "$ORIGFILE" == "" ]; then echo "Sorry, this directory does not contain a .orig.tar.gz file and we" echo "cannot work in repackage mode without one, if a new release, -n ?" else PrepExistingOrigFile fi exit fi if [ "$ORIGFILE" == "" ]; then echo "No orig.tar.gz file found, confirming New Build" else echo "An orig.tar.gz was found, you might need it to revise submitted packaging" echo "then blow the dir away and start a New Release, maybe you don't want the -n ?" exit fi # If to here, its make a new release echo "---------- laz_bld is $LAZ_BLD" echo "---------- CLEAN is $CLEAN" echo "---------- UFILES is $UFILES" rm -f WHICHFPC WHICHLAZ if [ ! -f tomboy-ng-master.zip ]; then # We need download TB source echo "---------- Downloading a new tomboy-ng, $TB_SOURCE" if [ "$TB_SOURCE" == "master" ]; then wget https://github.com/tomboy-notes/tomboy-ng/archive/master.zip mv master.zip tomboy-ng-master.zip else # note, github plays with the file name ???? Some pressure to be consistent with tag names ! wget https://github.com/tomboy-notes/tomboy-ng/archive/refs/tags/v"$TB_SOURCE".zip mv tomboy-ng-"$TB_SOURCE".zip tomboy-ng-master.zip # we download https://github.com/tomboy-notes/tomboy-ng/archive/refs/tags/v0.35.zip # but end up with tomboy-ng-0.35.zip, note the 'v' disappeared, gee ! fi fi if [ -f tomboy-ng-master.zip ]; then CheckFPC_LAZ # In practise, we should have these env set, my defaults just in case. if [ "$DEBEMAIL" = "" ]; then DEBEMAIL="$DEF_EMAIL" export DEBEMAIL fi if [ "$DEBFULLNAME" = "" ]; then DEBFULLNAME="$UBUNTU_FULLNAME" export DEBFULLNAME fi unzip -q tomboy-ng-master.zip if [ "$UFILES" = "YES" ]; then if [ "Makefile" -nt "tomboy-ng-master/Makefile" ]; then echo "---------- UPDATING Makefile" cp Makefile tomboy-ng-master/Makefile fi if [ "buildit.bash" -nt "tomboy-ng-master/buildit.bash" ]; then echo "---------- UPDATING buildit.bash" cp buildit.bash tomboy-ng-master/buildit.bash fi fi echo "+++++++++++ UNSET VER = $VER ++++++++++++" if [ "$VER" == "unknown" ]; then VER=`cat tomboy-ng-master/package/version` else echo "===================================================================" echo "============= WARNING - Hard Wired Version = $VER =================" echo "===================================================================" fi if [ "$CLEAN" = "YES" ]; then echo "---------- Removing existing DEB files" rm -Rf "$APP"_"$VER""$PACKVER" rm -f *.changes *.buildinfo *.orig.tar.gz *.dsc *.tar.gz *.tar.xz *.upload fi mv "tomboy-ng-master" "$APP"_"$VER""$PACKVER" KControls cd "$APP"_"$VER""$PACKVER" CleanSource # https://bugs.debian.org/cgi-bin/bugreport.cgi?bug=897688 # dch "$DISTRO1" "$DISTRO2" --create --package="$APP" --newversion="$VER""$PACKVER" "Initial release. (Closes: #897688)" # because we use the same changelog, we need to tweak the qt5 one if [ "$WIDGET" = "Qt5" ]; then sed -i 's/tomboy-ng\ /tomboy-ng-qt5\ /g' debian/changelog fi echo "------- Calling dch ""$DISTRO1"" and ""$DISTROQT5" dch -v "$VER""$PACKVER" -D"$DISTRO1" "$DISTRO2" "Release of new version" if [ -f whatsnew ]; then echo "---------- Including whatsnew in changelog" while IFS= read -r Line; do dch --append "$Line" done < whatsnew fi dch --append "Please see github for details" if [ "$WIDGET" = "Qt5" ]; then dch --append "Qt5 version" cp debian/rules.qt5 debian/rules # we must force qt5 app to use qt5ct because of a bug in qt5.tsavedialog # note ugly syntax, qt5 strips it off (and anything after it) before app sees it. # this changes the desktop file in source tree and is not reversed. # sed -i "s/Exec=tomboy-ng %f/Exec=env QT_QPA_PLATFORMTHEME=qt5ct tomboy-ng %f/" "glyphs"/"$APP".desktop # cp debian/control.qt5 debian/control # sed "s/#REPLACEME_QT5/DESTDIR += -qt5/" Makefile > Makefile.temp # mv Makefile.temp Makefile scripts/mkcontrol.bash debian/ "$DISTRO1" qt5 touch Qt5 else scripts/mkcontrol.bash debian/ "$DISTRO1" fi rm debian/control.template dch --release "blar" cd .. if [ "$PAUSE" = "YES" ]; then read -p "Edit things in another term, press Enter." fi # Next block is to avoid the dreaded lintian no-debian-changes # The copyright file in there alone does not generate that error mv "$APP"_"$VER""$PACKVER"/debian ./debian # tuck a copy away for later mkdir "$APP"_"$VER""$PACKVER"/debian cp debian/copyright "$APP"_"$VER""$PACKVER"/debian/. # we must have copyright tar czf "$APP"_"$VER".orig.tar.gz "$APP"_"$VER""$PACKVER" # create the orig file # OK, we have our .orig. file, put most of it back. rm -Rf "$APP"_"$VER""$PACKVER"/debian # dump that one for simplicity rm debian/control.qt5-DEBIAN debian/control.qt5 # we don't need that rm debian/rules.qt5 # or that mv ./debian "$APP"_"$VER""$PACKVER"/. # put remainder back where it belongs echo "If no errrors, you should now cd ""$APP"_"$VER""$PACKVER; debuild -S; cd .." echo "After that, try test-debs.bash and then maybe, dput ....." else echo "" echo " Sorry, I cannot see or get a tomboy-ng-master.zip file. This script can" echo " be run in a directory containing that file or will try to download it" echo " from github, seems even that failed." echo " If you used wget to download tomboy-ng, it will be named master.zip," echo " you should rename it tomboy-ng-master.zip to avoid confusion." echo "" fi tomboy-ng_0.39-1/scripts/PKGBUILD0000644000175000017500000000623514551457644016260 0ustar dbannondbannon# This file is used to build a pacman usable gtk2 package for tomboy-ng # Requirments : sudo pacman -S base-devel fpc lazarus-gtk2 unzip # # Run a pacman equiped VM (such as my Manjaro21.2-X) # that has Lazarus installed. It will download a copy # of src and kcontrols and built it all. Note that if # you build master (ie as a snapshot) pacman thinks of its # version as "master" but tomboy-ng still reports the # version according to the version file. # # Usage : VER=0.34 makepkg --skipinteg # VER=master makepkg --skipinteg # # Install # sudo pacman -U ./tomboy-ng-master-1-x86_64.pkg.tar.zst # Maintainer tomboy-ng@bannons.id.au # Note : buildit.bash in 0.34 and earlier will not work on non-Debian systems # so necessary to replace with later buildit.bash. # The only way I can find to get the sha256 for the downloaded tar/zip # balls is to download them, run e.g. shasum -a 256 kc-master.zip on each # and manually add that sha to this file. I really don't see the point. # maybe for tagged releases, certainly not for master. # So, passing the version number on the command line will not work unless # we skip the checksum check. And it really is pretty useless anyway. # Deal with this when and if its every important. pkgname=tomboy-ng pkgver="$VER" # Remember to set VER when calling makepkg pkgrel=1 # inc this if releasing a re-package of same ver pkgdesc="Manage a large or small set of notes with a range of fonts and markup." arch=('x86_64') url="https://github.com/tomboy-notes/tomboy-ng" license=('BSD' 'GPL2' 'LGPL3') depends=('gtk2' 'wmctrl') makedepends=('fpc' 'lazarus-gtk2') provides=('tomboy-ng') # we want to get the taged release version, could also target master # https://github.com/tomboy-notes/tomboy-ng/archive/refs/tags/v0.34.tar.gz if [ "$pkgver" == "master" ]; then echo "doing if" source=("tb-master.zip::https://github.com/tomboy-notes/$pkgname/archive/refs/heads/master.zip" "kc-master.zip::https://github.com/davidbannon/KControls/archive/master.zip") # the first sha is skipped because it changes with every commit I make. sha256sums=(SKIP 97d974a11c645be3025b80ef0383c160d9869d2b8449482b8ece6fc4ffd27dc1 ) else echo "doing else" source=("https://github.com/tomboy-notes/$pkgname/archive/refs/tags/v$pkgver.tar.gz" "kc-master.zip::https://github.com/davidbannon/KControls/archive/master.zip") # Once we have a working tagged release, use shasum to get the shar..... # NO, this is crap, I cannot change the release on the command line without also # changing the sha here ?? - the whole thing is pointless. # sha256sums=( # f9deb76984ac445711c4524f2324b4f7a692e8d2a43ddf70ae63d17fb39880b4 # 97d974a11c645be3025b80ef0383c160d9869d2b8449482b8ece6fc4ffd27dc1 ) sha256sums=(SKIP 97d974a11c645be3025b80ef0383c160d9869d2b8449482b8ece6fc4ffd27dc1 ) fi echo "========= source ========" echo "$source" echo "=========================" noextract=('master.zip') # leave kcontrols alone, I'll deal with it. prepare() { cd "$pkgname-$pkgver" unzip ../kc-master.zip mv KControls-master kcontrols } build() { cd "$pkgname-$pkgver" # ./configure --prefix=/usr make } package() { cd "$pkgname-$pkgver" make DESTDIR="$pkgdir/" install } tomboy-ng_0.39-1/scripts/test-deb.bash0000755000175000017500000000060614551457644017501 0ustar dbannondbannon#!/usr/bin/bash set -e TESTDIR=`pwd` TESTDIR="$TESTDIR""-TEST" if [ -d "$TESTDIR" ]; then rm -Rf "$TESTDIR" fi mkdir "$TESTDIR" cp *.xz *.gz *.dsc "$TESTDIR"/. cd "$TESTDIR" dpkg-source -x *.dsc SRCDIRNAME=`find . -maxdepth 1 -type d -name "tomboy*" ` cd "$SRCDIRNAME" dpkg-buildpackage -us -uc cd .. echo "------ Calling lintian -IiE *.changes -------" lintian -IiE *.changes pwd ls -l tomboy-ng_0.39-1/scripts/mkcontrol.bash0000755000175000017500000000513514551457644020004 0ustar dbannondbannon#!/usr/bin/bash # A small script to replace critical parameters in control.template # With every target release/distro requiring a different control # file, this is an attempt to concentrate all the variation into # one place. # copyright David Bannon tomboy-ng@bannons.id.au # License Do what you want but mention the copyright above. WDIR="../" PACKAGE="tomboy-ng" # note, in debian QT5 its still called tomboy-ng FPCVER=">=3.2.2" LAZVER=">=2.2.2" DEBHVER="=13" STDVER="4.6.2" DESC="This is the GTK2 based version." DEPENDS="libgtk2.0-0 (>= 2.6), libcanberra-gtk-module" BUILDDEPENDS="libgtk2.0-dev" function AdjustValues () { if [ "$2" == "qt5" ]; then # Note : we ignore anything else DESC="This is the QT5 based version." DEPENDS="libqt5pas1" BUILDDEPENDS="libqt5pas-dev, lcl-qt5, libcairo2-dev, libpango1.0-dev" PACKAGE="tomboy-ng-qt5" # but reverse that in Debian (don't do yet anyway) fi case $1 in "bionic") FPCVER=">=3.2.0" LAZVER=">=2.0.10c" DEBHVER="=11" STDVER="4.5.0" ;; "focal") DEBHVER="=12" STDVER="4.5.0" ;; "unstable") # ie Debian, as set above PACKAGE="tomboy-ng" # in case its a Debian QT5 build, always tomboy-ng in Debian ;; esac } function ReplaceToken () { sed "s/$1/$2/" "$WDIR"control > "$WDIR"control.new mv "$WDIR"control.new "$WDIR"control } # ------ It starts here -------------- # $1=dir to work in $2=Target Distro [$3=qt5] if [ -f "$1""control.template" ]; then if [ "$2" != "" ]; then if [ "$2" != "help" ]; then if [ "$2" != "-h" ]; then WDIR="$1" cp "$WDIR""control.template" "$WDIR"control AdjustValues $2 $3 ReplaceToken "%PACKAGE%" "$PACKAGE" ReplaceToken "%FPCVER%" "$FPCVER" ReplaceToken "%LAZVER%" "$LAZVER" ReplaceToken "%DEBHVER%" "$DEBHVER" ReplaceToken "%STDVER%" "$STDVER" ReplaceToken "%DESC%" "$DESC" ReplaceToken "%DEPENDS%" "$DEPENDS" ReplaceToken "%BUILD-DEPENDS%" "$BUILDDEPENDS" exit fi fi fi else echo "ERROR - $0 did not find ""$1""control.template" fi echo "Usage : $0 Valid_Working_Dir [bionic focal unstable] [qt5]" echo " eg : $0 ../ focal" # sed "s/(= \${binary:Version}/(>= 3.2.2/g" "$CFILE" > "$CFILE.temp" # rm "$CFILE" # mv "$CFILE.temp" "$CFILE" tomboy-ng_0.39-1/scripts/dot-dput.cf0000644000175000017500000000027314551457644017202 0ustar dbannondbannon[mentors] fqdn = mentors.debian.net incoming = /upload method = https allow_unsigned_uploads = 0 progress_indicator = 2 # Allow uploads for UNRELEASED packages allowed_distributions = .* tomboy-ng_0.39-1/scripts/prepare.debian0000644000175000017500000003536114551457644017740 0ustar dbannondbannon#!/bin/bash set -e # copyright David Bannon, 2019, 2020, 2021 use as you see fit, but retain this statement. # # This stript is useful to prepare the tomboy-ng source tree to make an # Debian Source Package # If you submit it to Debian Mentors and get an error, or a revision of the packaging # is requested, DO NOT DELETE THE WORKING Build* DIR, you need it to generate # fixes (run prepare.debian again, this time without the -n. Totally different # behaviour ! # Fine to blow it away if its not been uploaded with dput ! # Possibly fine to blow it away if it has not migrated from Mentors to unstable. # But that needs clarification. # For detailed instructions including ready to copy command lines see- # https://github.com/tomboy-notes/tomboy-ng/blob/master/prepare.md # # David Bannon, Jan 2021 # History - # 2020-09-02 Added -D distro switch # 2020-12-17 Restructed the multi control system to make it clearer. # 2020-12-29 Split script into seperate Debian one, only Qt5. # 2021-01-27 More detailed instructions on use. # 2021-02-03 Include enough of first changelog to keep lintian off my back # 2021-06-19 Made swichable between GTK2 and Qt5 # Moved Howto docs to github # 2022-11-17 Now two seperate behavious, with -n, "new release" we download a new # set of files and generate a new .orig.tar.gz that must be uploaded. # Secondly, without the -n, we assume we are using an existing .orig. # and just repackaging. The Package version number is manually incremented and # the src dir renamed. Most of the code is skipped. # 2022-11-30 Don't try to imcrement pack numb, must be done manually. APP="tomboy-ng" # These are mine, they are used as defaults if NOT set in env. Ignored unless signing. DEF_EMAIL="tomboy-ng@bannons.id.au" # This matches cert I use to sign tomboy-ng stuff DEF_FULLNAME="David Bannon" # and this ... UBUNTU_FULLNAME="tomboy-ng" # My stuff up, different cert with different name in Ubuntu PPA ! DEBVER="-1" # Package version, not source, starts at 1, is auto set if repackage mode, don't edit NEWORIG="no" # set to yes if -n on command line DISTRO1="unstable" TB_SOURCE="master" # might be, eg, 0.35 etc, valid github tag, set with command line # Housekeeping stuff, helpers for debugging etc. Set with command line, not here ! VER="unknown" LAZ_BLD="" UFILES="NO" # debug tool, update Makefile CLEAN="NO" # debug tool, remove files from previous run, assume same ver. WIDGET="" # empty says make a GTK2, only other possibility is Qt5 REPACK_REASON="" # set with -r, few words about why repackaging necessary # Looks for fpc and lazbuild on PATH, if in root space, do nothing, # if in user space, because debuild will miss them, makes two files. function CheckFPC_LAZ () { FPC=`which fpc` if [ -x "$FPC" ]; then PREFIX="${FPC:0:4}" if [ "$PREFIX" = "/usr" ]; then echo "---------- root space fpc, all good" else echo "---------- Leaving a fpc file for buildit" echo "$FPC" > WHICHFPC fi else echo "----------- ERROR, no fpc found ------------" exit 1 fi if [ "$LAZ_BLD" = "" ]; then # we had better try to find it LAZ_BLD=`which lazbuild` fi if [ -x "$LAZ_BLD" ]; then PREFIX="${LAZ_BLD:0:4}" if [ "$PREFIX" = "/usr" ]; then echo "---------- root space Lazarus, all good" else echo "---------- Leaving a lazbuild file for buildit" echo "$LAZ_BLD" > WHICHLAZ fi else echo " --- ERROR, no lazbuild found, try -l ? ---" exit 1 fi } # End of function # Here we remove file that are not needed in the Debian SRC kit. function CleanSource () { rm -Rf experimental rm -Rf patches rm -Rf doc/gallery rm -Rf doc/html rm -Rf doc/wiki rm -Rf po/*.mo rm -f doc/*.svg doc/*.png doc/*.note rm -f glyphs/*.png glyphs/*.ico glyphs/*.svg glyphs/*.icns rm -fR glyphs/help rm -fR glyphs/demos KC="kcontrols" KCS="$KC/source" rm -fR "$KC"/demos rm -fR "$KC"/help rm -Rf "$KC"/packages kcontrols/tools rm -Rf "$KC"/resource_src/khexeditor_icons "$KC"/resource_src/kgrid_icons rm "$KCS"/kbuttons.pas "$KCS"/kdbgrids.pas "$KCS"/kgrids.* "$KCS"/kicon.pas rm "$KCS"/klabels.pas "$KCS"/kmemodlg*.* "$KCS"/kxml.pas "$KCS"/kwidewinprocs.pas rm "$KCS"/kmemofrm.* "$KCS"/kpagecontrol.* "$KCS"/kprogress.* "$KCS"/ksplitter.pas rm "$KC"/*.txt "$KC"/*.json "$KC"/*.bat rm -Rf "$KC"/packages "$KC"/tools "$KC"/resource_src/khexeditor_icons "$KC"/resource_src/kgrid_icons chmod 664 doc/HELP/EN/* chmod 664 doc/HELP/ES/* chmod 664 doc/HELP/FR/* } # End of function function KControls () { if [ -e "kcontrols-master.zip" ]; then echo "---------- Note: reusing KControls zip" else wget https://github.com/davidbannon/KControls/archive/master.zip # watch this name does not change. mv master.zip kcontrols-master.zip fi unzip -q kcontrols-master.zip # rm -f master.zip mv KControls-master "$APP"_"$VER""$DEBVER"/kcontrols } # End of function function ShowHelp () { echo " " echo "Prepares to generate changes from existing .orig file in Debian." echo "Assumes FPC of some sort in path, available and working, ideally 3.2.0." echo "Needs Lazarus, <=2.0.10 in root space or specified with -l option." echo "Needs devscripts preinstalled and maybe an edit of email address above." echo "If doing a tomboy-ng release, provide -n and a new orig file is made." echo "(Else, repackaging - see the Repackaging section in prepare.md)" echo "Will download kcontrols, cleanup and prepare to run debuild -S" echo "REMEMBER to feed changlog back to github tree" echo "David Bannon, June 2021" echo "-h print help message" echo "-l a path to a viable lazbuild, eg at least where lazbuild and lcl is." echo "-C clean deb files from previous run, exit, debug use only, Unreliable" echo "-t tomboy-ng source, defaults to master or github tag, eg, 0.35 etc" echo "-D distro, defaults to unstable" echo "-n New orig file, required for fresh release" echo "-r Reason for repackage, use inverted commas, only if not -n" echo "-q Make a Qt5 version instead of GTK2, ignored in repackage mode." echo "" echo " Typically, new release bash ./prepare.debian -n -q" exit } # End of function function MakeOrigFile () { echo "---------- Creating a new .orig file" # Note, when called we are in the unzipped and renamed tomboy-ng dir. # We move most of the debian dir out of harms way and tar up the dir. cd .. mv "$APP"_"$VER""$DEBVER"/debian ./debian mkdir "$APP"_"$VER""$DEBVER"/debian cp debian/copyright "$APP"_"$VER""$DEBVER"/debian/. tar czf "$APP"_"$VER".orig.tar.gz "$APP"_"$VER""$DEBVER" # OK, we now have our .orig. file, put most of it back. rm -Rf "$APP"_"$VER""$DEBVER"/debian mv ./debian "$APP"_"$VER""$DEBVER"/. } # End of function function PrepExistingOrigFile { # Assume we are in a previously used dir, it will have orig and eg tomboy-ng_0.35-1 dir. # Read the Repackaging section of prepare.md # you achive a similar position by extracting out .orig. with dpkg-source -x .... # tomboy-ng_0.35.orig.tar.gz NEWDIRNAME=`find . -maxdepth 1 -type d -name "tomboy*" ` # there should be only one and it must include a new packaging number VER=`cat "$NEWDIRNAME"/package/version` if [ -f "tomboy-ng_""$VER"".orig.tar.gz" ]; then echo "Orig file present, thats good" else echo "Orig file not present, ""tomboy-ng_""$VER"".orig.tar.gz" echo "Giving up and going home ....." fi if [ -d "tomboy-ng-""$VER" ]; then echo "tomboy-ng_""$VER"" exists, you have not added a packaging number, EXITING" exit fi PACKVER=`echo "$NEWDIRNAME" | rev | cut -b 1 | rev ` # This is last char, wrong if user has not rev'ed #NEWDIRNAME=`echo "$EXDIRNAME" | rev | cut -c2- | rev ` # chop off last char #PACKVER=`echo "$EXDIRNAME" | rev | cut -b 1 | rev ` # This is last char #((PACKVER=PACKVER+1)) # rev it, should test its not > 9 #NEWDIRNAME="$NEWDIRNAME""$PACKVER" #mv $EXDIRNAME $NEWDIRNAME rm -Rf *.dsc *.buildinfo *.changes *.debian.tar.xz if [ "$DEBEMAIL" = "" ]; then DEBEMAIL="$DEF_EMAIL" export DEBEMAIL fi if [ "$DEBFULLNAME" = "" ]; then DEBFULLNAME="$DEF_FULLNAME" export DEBFULLNAME fi VER="$VER""-""$PACKVER" # eg 0.35-2 cd "$NEWDIRNAME" pwd dch -v "$VER" -D"$DISTRO1" "$DISTRO2" "Repackage" if [ -n "$REPACK_REASON" ]; then dch --append "$REPACK_REASON" fi cd .. pwd echo "If no errrors, you should now cd $NEWDIRNAME" echo "Make what ever changes seem appropriate and run debuild -S; cd .." exit # My work here is done } # End of function while getopts "hUCl:D:nqQt:r:" opt; do case $opt in h) ShowHelp ;; l) LAZ_BLD="$OPTARG" ;; C) CLEAN="YES" ;; D) DISTRO1="$OPTARG" # DISTRO1="-D""$OPTARG" DISTRO2="--force-distribution" ;; n) NEWORIG="YES" ;; r) REPACK_REASON="$OPTARG" ;; t) TB_SOURCE="$OPTARG" ;; Q) WIDGET="Qt5" ;; q) WIDGET="Qt5" ;; \?) echo "Invalid option: -$OPTARG" >&2 ShowHelp ;; esac done ORIGFILE=`find . -maxdepth 1 -name "*.orig.tar.gz" ` echo "orig file is $ORIGFILE and NEWORIG is ""$NEWORIG" if [ "$NEWORIG" == "no" ]; then # if no -n, we always exit here. if [ "$ORIGFILE" == "" ]; then echo "Sorry, this directory does not contain a .orig.tar.gz file and we" echo "cannot work in repackage mode without one, if a new release, -n ?" exit else PrepExistingOrigFile fi exit fi if [ "$ORIGFILE" == "" ]; then echo "No orig.tar.gz file found, confirming New Build" else echo "An orig.tar.gz was found, you might need it to revise submitted packaging, drop" echo "the -n. Otherwise blow old files away and start a New Release" exit fi echo "---------- laz_bld is $LAZ_BLD" echo "---------- CLEAN is $CLEAN" echo "---------- UFILES is $UFILES" echo "---------- Target is $DISTRO1" echo "---------- WIDGET is $WIDGET" echo "---------- NEWORIG is $NEWORIG" echo "---------- DebVer is $DebVer" rm -f WHICHFPC WHICHLAZ # remove any existing semaphore files if [ ! -f tomboy-ng-master.zip ]; then # We need download TB source echo "---------- Downloading a new tomboy-ng, $TB_SOURCE" if [ "$TB_SOURCE" == "master" ]; then wget https://github.com/tomboy-notes/tomboy-ng/archive/master.zip mv master.zip tomboy-ng-master.zip else # note, github plays with the file name ???? Some pressure to be consistent with tag names ! wget https://github.com/tomboy-notes/tomboy-ng/archive/refs/tags/v"$TB_SOURCE".zip mv tomboy-ng-"$TB_SOURCE".zip tomboy-ng-master.zip # we download https://github.com/tomboy-notes/tomboy-ng/archive/refs/tags/v0.35.zip # but end up with tomboy-ng-0.35.zip, note the 'v' disappeared, gee ! fi fi # https://github.com/tomboy-notes/tomboy-ng/archive/refs/tags/v0.35.zip if [ -f tomboy-ng-master.zip ]; then CheckFPC_LAZ # In practise, we should have these env set, my defaults just in case. if [ "$DEBEMAIL" = "" ]; then DEBEMAIL="$DEF_EMAIL" export DEBEMAIL fi if [ "$DEBFULLNAME" = "" ]; then DEBFULLNAME="$DEF_FULLNAME" export DEBFULLNAME fi if [ "$CLEAN" = "YES" ]; then rm -Rf "tomboy-ng-master" # probably not here anyway .... fi unzip -q tomboy-ng-master.zip # But, if we are trying to make an old version and renamed the TB source then # the new dir created above might be called something like tomboy-ng-0.34 if [ ! -e "tomboy-ng-master" ]; then EXDIRNAME=`find . -maxdepth 1 -type d -name "tomboy-ng-0*" ` # there should be only one, I hope ... echo " --------- mv $EXDIRNAME tomboy-ng-master" mv "$EXDIRNAME" "tomboy-ng-master" fi # risky, hacky code follows, versions 0.34 and earlier did not have mkcontrol.bash, slip one in if [ -e "mkcontrol.bash" ]; then echo "-------- WARNING, using local mkcontrol.bash because its here !" cp mkcontrol.bash tomboy-ng-master/scripts/. cp control.template tomboy-ng-master/debian/. fi VER=`cat tomboy-ng-master/package/version` if [ "$CLEAN" = "YES" ]; then rm -Rf "tomboy-ng-master" echo "---------- Removing existing DEB files" rm -Rf "$APP"_"$VER"-? rm -f "tomboy-ng_$VER-"?_source.buildinfo rm -f "tomboy-ng_$VER-"?_source.changes rm -f "tomboy-ng_$VER-"?_amd64.deb rm -f "tomboy-ng_$VER-"?.debian.tar.xz rm -f "tomboy-ng_$VER-"?.dsc rm -f "tomboy-ng_$VER.orig.tar.gz" # echo "Like a coward, not removing .orig file, tomboy-ng_$VER.orig.tar.gz" exit fi mv "tomboy-ng-master" "$APP"_"$VER""$DEBVER" KControls #echo ----------------------------------------------------------------------- #echo Disabling use of UseAppIndVar because probably still using Laz226 #echo ----------------------------------------------------------------------- #sed -i "s/define APPINDPATCH/ignore/" "$APP"_"$VER""$DEBVER"/source/Tomboy_NG.lpr # Remove the above line when Debian moves to Laz300 cd "$APP"_"$VER""$DEBVER" # This is orig tomboy-ng dir made from zip if [ "$WIDGET" = "Qt5" ]; then touch Qt5 # leave semaphore file scripts/mkcontrol.bash debian/ "$DISTRO1" qt5 # we must force qt5 app to use qt5ct because of a bug in qt5.tsavedialog #sed -i "s/Exec=tomboy-ng %f/Exec=env QT_QPA_PLATFORMTHEME=qt5ct tomboy-ng %f/" "glyphs"/"$APP".desktop # sed -i "s/Exec=tomboy-ng %f/Exec=QT_QPA_PLATFORMTHEME=qt5ct tomboy-ng %f/" "glyphs"/"$APP".desktop # NO, we don't. Bug is not present in L226 or L300, only intermediate ones. else scripts/mkcontrol.bash debian/ "$DISTRO1" fi # Note : if not NEWORIG, we cannot possibly be here ! if [ "$NEWORIG" = "YES" ]; then CleanSource MakeOrigFile # create new .orig (and no longer a new change log) fi cd "$APP"_"$VER""$DEBVER" dch -v "$VER""$DEBVER" -D"$DISTRO1" "$DISTRO2" "Release of new version." if [ -f whatsnew ]; then echo "---------- Including whatsnew in changelog" while IFS= read -r Line; do dch --append " $Line" done < whatsnew fi dch --append " Please see github for further change details." #cp debian/control.debian debian/control # thats the GTK2 version #if [ "$WIDGET" = "Qt5" ]; then # cp debian/control.qt5-DEBIAN debian/control # thats the Qt5 version #fi rm -f debian/control.qt5 rm -f debian/rules.qt5 # never need that here, its for PPA where qt5 has different name rm -f debian/control.qt5-DEBIAN rm -f debian/control.debian cd .. echo "If no errrors, you should now cd ""$APP"_"$VER""$DEBVER""; debuild -S; cd .." else echo "" echo " Sorry, I cannot see a tomboy-ng-master.zip file. This" echo " script must be run in a directory containing that file" echo " obtained from github and probably little else." echo " If you used wget to download tomboy-ng, it will be named master.zip," echo " you should rename it tomboy-ng-master.zip to avoid confusion." echo "-" fi tomboy-ng_0.39-1/prepare.md0000644000175000017500000002417214551457644015425 0ustar dbannondbannonBuilding Debian or PPA source packages. =========== This document is about building the source packages that are uploaded to either Debian Mentors or Launchpad PPA. With tomboy-ng, we use scripts (in the scripts dir) to do the initial setup prior to building and then instructions here to complete the processes. In all cases, we upload a source package, it must build on their remote system. These notes are primarly for my, David's, use and assume that we are using the already configured VM's for this job. There is, however, a section on configuring VMs for this purpose, setting up ID and certificates. **debhelper version** Debian Bullseye requires 13, building the PPA on U20.04 requires 12 but because we target U18.04 for GTK2, must be 11 there. The PPA for the Qt5 version is 12 because we target Focal as a starting point (U18.04 will not run Qt5 apps easily). This, and other variations are all covered in the mkcontrol.bash script. **IMPORTANT** ====== While fiddling around, making sure its all going to build, easy to blow away the working dir and start again. BUT, once you have ***submitted something to Mentors or the PPA*** you cannot "start again", a package rebuild must use the original files, the scripts help here but only if you have the original files ! So, do not, delete a failed build from Launchpad, ever ! **Debian Source** ======== Understand that there are two distinct build processes for making a Deb Src. The first, used initially or when releasing a new version of tomboy-ng, involves downloading the tomboy-ng tree from github, making some changes and generating a new .orig file. Then making a .changes and .dsc file. In this model, the resulting package always has a -1 debian suffix. The other building model is when a build problem is noted, the tomboy-ng source has not changed, just something cleaned up in the build. Here we take the previous .orig file and associated files, ideally safely tucked away, or downloaded .orig. and other files andextract its contents. Make whatever change is necessary and rebuild. The .orig file is not re-uploaded and the resulting package will have -2 or -3, -4 on a really bad day. See the Repackaging section below for details. The process is download (or extract) tomboy-ng source, remove unnecessary content, build the SRC package, copy files to a clean directory, do a test build (that makes the .deb file) and run an pedantic lintian. If thats all satisfactory, we upload to Mentors. **Debian SRC Build step by step** -------- (all assuming you are David and using a pre configured VM (see below), DebTestMate0922, rev the release number as required, it has no effect on product, just a convienance while building). The Debian script makes a src package that targets unstable, that name does not change. And, note, the Debian build machines run unstable, not testing ! See the VM Setup section below. This, as of Nov 2022, now makes a Qt5 version. export DebVer="34g" mkdir "Build""$DebVer"; cd "Build""$DebVer" wget https://raw.githubusercontent.com/tomboy-notes/tomboy-ng/master/scripts/prepare.debian bash ./prepare.debian -n -q cd tomboy-ng [tab] debuild -S cd .. OK, if everything is OK, both build VMs have a script, test-debs.bash in ~/bin, run it in the working directory, where, eg, the .orig.tar.gz file is, and it will take the necessary files to a new dir, build the binary deb and run Lintian. If its still all good, go back and and upload the src packages. cd ../"Build""$DebVer" dput mentors *.changes Find it at - https://mentors.debian.net/package/tomboy-ng/ If you don't get a response, did you include 'mentors' in the dput line ? ***REMEMBER to feed changlog back to github tree !*** ...after doing the PPA stuff or you must edit the PPA changleog ! **Launchpad PPA** ======== Is built on a different VM, U2004mQt. A little more complicated because we also build the Qt5 version, changelog needs to be 'adjusted'. There is a script that automates the whole build SRC packages, unpack and build binaries. The PPA script will make a Qt5 Focal package or a GTK2 Bionic package depending on the -Q switch. You need to make both so add a -Q the export var below. At some time in the future, it will be necessary to adjust those distro names. Note with v0.36a, I have stopped building Bionic, 18.04 packages as becoming harder to get current compiler running there. So, gtk2 and Qt5 are built from Focal, 20.04 and will continue that way as long as possible. **WARNING - ppa prepare.ppa script is wrong if a package needs to be repackaged, it cannot, itself, increment the package number, must be done manually. See the debian one.** **PPA build Steps** **Note** that if there are errors in changelog, because, eg, you feed the Debian changlog back before grabbing the PPA version and you have duplicate entries in the changelog, thats a fatal error, not trapped, and will cause a reject from Launchpad (because orig was not included ??). Use -p to pause and edit changlelog. -------- export PPAVer="PPAv33" mkdir "Build""$PPAVer"; cd "Build""$PPAVer" wget https://raw.githubusercontent.com/tomboy-notes/tomboy-ng/master/scripts/prepare.ppa bash ./prepare.ppa -n // -n says new release cd tomboy-ng [tab] debuild -S; cd ... Watch to see the message about *including full source in upload*, else you have a problem ! OK, if all looks OK, go back and upload with dput ppa:d-bannon/ppa-tomboy-ng *.changes Now, the QT5 version Important, we target focal not bionic cd .. export PPAVer="PPAv33QT" mkdir "Build""$PPAVer"; cd "Build""$PPAVer" wget https://raw.githubusercontent.com/tomboy-notes/tomboy-ng/master/scripts/prepare.ppa bash ./prepare.ppa -n -Q // the -Q says make a Qt5 version [-Q] cd tomboy-ng [tab] debuild -S; cd .. OK, if all looks OK, go back and upload dput ppa:d-bannon/ppa-tomboy-ng *.changes Did you follow that about versions ? To target u18.04 we must specify (in control) debhelper 11, in Focal 12, in Bullseye 13. **Repackaging** ======= Many problems that happen can be fixed with a repackage, you must keep the original files and its easy. In the directory where they are (or where you extract downloaded ones) you again use one of the prepare.* scripts, leave off the -n and but retaining the **-Q** in the Qt5 ones. The script will find the src working dir, rename it with a newer packaging number, make the all too important addition to the change log and set you on your way. eg, first repackage, from -1 to -2 mkdir ../Build35-2qt5 cp *.gz *.xz *.dsc prepare.debian ../Build35-2qt5 cd ../Build35-2qt5 dpkg-source -x *.dsc mv tomboy-ng-0.35 tomboy-ng-0.35-2 bash ./prepare.debian -q -r "Added new dependencies" // Now, make whatever changes are necessary to packaging (not source) and then // in the tomboy-ng-0.35-2 directory, run - debuild -S Test and submit as above, remember, send to mentors (dput defaults to ftp.debian and it gets dropped on the floor). **PPA: **If you don't have the initial files, .orig.tar.gz, .dsc and .xz then you can download them from Launchpad (even if deleted), use the Package Name Contains filter, left of screen. Then, in a dir with just those three files (and perhapse prepare.ppa) run dpkg -x *.dsc But that will extract a dir called, eg tomboy-ng-qt5-0.35, **you must add the -1 to that dir name** and then use prepare.ppa as mentioned above. **Building just a tomboy-ng Binary** ======== If all you want is the binary, not building src packages at all, not cross compiling, then don't worry about signing etc, just - * install FPC (>=3.2.2), Lazarus (>=2.2.4), libnotify-dev * install libqt5pas-dev if building a QT5 version * `wget https://raw.githubusercontent.com/tomboy-notes/tomboy-ng/master/scripts/prepare.ppa` * `bash ./prepare.ppa [-Q]` // the -Q says make a Qt5 version please. * `cd tomboy-ng[tab] [enter]` * `bash ./buildit.bash` The binary will be in the source/. directory below where you are now standing. **VM Setup** ======== The machine to at least test the source package for Debian needs to be a current unstable. Further, because on the mentor's machines, apt does not install Recommended, we need to ensure the test machines is the same. So, take a current VM of Testing, update irs /etc/apt/sources.lst to point to unstable instead of, eg, bookwork. Apt update; apt upgrade. Then, add a file, /etc/apt/apt.config that has one line, apt::install-recommends "false"; May be a good idea to use this machine as the build machine as well, and treat it as temporary. But remember to take a snapshot of the *.gz *.xz and *.dsc files from a submitted build and keep, somewhere. A PGP key is required to upload to Mentors or Launchpad. It lives in ~/.gnupg. David Bannon The two keys should be exported from my dell laptop and imported into the VM using gpg command on both systems. (The 17741.... is the fingerprint) On the Launchpad PPA machine, In users home dir, a file called .devscripts.conf that contains DEBSIGN_KEYID=nnnn...... ie, the full key fingerprint. Both prepare scripts have hardwired my personal full name and tomboy-ng email address. These will only be used if relevent env vars are empty. Note that they must match whats available in a gpg key. AND if that does not match the Maintainer: entry from control, we get a non maintainer upload warning. Debian Bullseye likes debhelper = 13, Ubuntu is still on 12 in control file. Debian now (Feb 2023) wants standards 4.6.2 but it changes frequently. **Install** devscripts libqt5pas-dev lcl-qt5 libnotify-dev Lazarus >= 2.2.4, FPC >= 3.2.2 test-deb.bash into ~/bin/. from tb scripts dir. Debian need a config file, .dput.cf in $HOME that points to mentors, see mentors website. https://mentors.debian.net The Launchpad PPA VM does not seem to have that, we put destination address in the dput command line. The Debian file looks like - [mentors] fqdn = mentors.debian.net incoming = /upload method = https allow_unsigned_uploads = 0 progress_indicator = 2 # Allow uploads for UNRELEASED packages allowed_distributions = .* tomboy-ng_0.39-1/.gitignore0000644000175000017500000000134414551457644015431 0ustar dbannondbannon# Lazarus compiler-generated binaries (safe to delete) *.exe *.dll *.so *.dylib *.lrs *.res *.compiled *.dbg *.ppu *.o *.or *.a # Lazarus autogenerated files (duplicated info) *.rst *.rsj *.lrt # Lazarus local files (user-specific info) *.lps # Lazarus backups and unit output folders. # These can be changed by user in Lazarus/project options. backup/ *.bak lib/ # Added by DRB published/ # *.lrj apparently needed by the translation system /source/tomboy-ng /source/tomboy-ng-qt5 /source/tomboy-ng-64 tomboy-ng-qt.po releasepage NoGit/ # Application bundle for Mac OS *.app/ experimental/NextNotes/ po/tomboy-ng-64.pot po/tomboy-ng-qt-64.pot po/tomboy-ng-qt.pot po/tomboy-ng-qt5-64.pot po/tomboy-ng-qt5.pot po/tomboy-ng.fr.po-old tomboy-ng_0.39-1/Qt50000644000175000017500000000000014551457755014024 0ustar dbannondbannontomboy-ng_0.39-1/Makefile0000644000175000017500000000533214551457644015102 0ustar dbannondbannon # A makefile specificially to assist with making a SRC Deb for tomboy. # Might work to install as a src tarball but its not regularly tested for this. # # copyright David Bannon, 2020, use as you see fit, but retain this statement. # https://www.gnu.org/software/make/manual/html_node/index.html # Some not surprising template stuff PREFIX = /usr BIN_DIR = $(PREFIX)/bin PROGRAM_NAME=tomboy-ng MAN_DIR = $(PREFIX)/share/man/man1 SHARE_DIR = $(PREFIX)/share DOC_DIR = $(SHARE_DIR)/$(PROGRAM_NAME) # ---- Help Notes, it just replicates existing dir/note structure. HELP_DIR = $(DOC_DIR)/HELP RM = rm -f RMDIR = rm -Rf MKDIR = mkdir -p OUTFILES = ../*.deb ../*.build ../*.xz ../*.dsc ../*.buildinfo ../*.changes kcontrols/source/tomboy-ng.log source/tomboy-ng.log CLEANDIR = kcontrols/packages/kcontrols/lib source/lib kcontrols/source/lib INSTALL = install INSTALL_PROGRAM = $(INSTALL) -c -m 0755 INSTALL_DATA = $(INSTALL) -c -m 0644 CP = cp -R # ----- Language translation files, just add 2 letter code here ----- LANGUAGES = es fr nl MKDIRLANG = test -d $(DESTDIR)$(SHARE_DIR)/locale/$(LANG)/LC_MESSAGES || $(MKDIR) $(DESTDIR)$(SHARE_DIR)/locale/$(LANG)/LC_MESSAGES CPLANG = msgfmt -o $(DESTDIR)$(SHARE_DIR)/locale/$(LANG)/LC_MESSAGES/tomboy-ng.mo po/tomboy-ng.$(LANG).po tomboy-ngx86_64: bash ./buildit.bash $(info ========== We have compiled [${PROGRAM_NAME}]) # $(info ========== $$BIN_DIR is [${BIN_DIR}]) clean: rm -Rf debian/tomboy-ng $(RM) debian/debhelper-build-stamp $(RM) debian/tomboy-ng.substvars $(RMDIR) $(CLEANDIR) $(RM) $(OUTFILES) $(RM) source/Tomboy_NG source/tomboy-ng $(RM) kcontrols/package/kcontrols/KControls.log # clean is pretty useless here, any change to tree upsets debuild and apparently # kcontrols changes some src file during package build. So, refresh ! install: installdirs $(info ========== Installing ....) $(INSTALL_PROGRAM) source/tomboy-ng $(DESTDIR)$(BIN_DIR)/$(PROGRAM_NAME) $(INSTALL_DATA) doc/tomboy-ng.1 $(DESTDIR)$(MAN_DIR)/$(PROGRAM_NAME).1 $(CP) doc/HELP $(DESTDIR)$(HELP_DIR)/ $(CP) doc/overrides $(DESTDIR)$(SHARE_DIR)/lintian/overrides/tomboy-ng $(CP) glyphs/icons $(DESTDIR)$(SHARE_DIR)/ $(INSTALL_DATA) glyphs/tomboy-ng.desktop $(DESTDIR)$(SHARE_DIR)/applications/tomboy-ng.desktop $(foreach LANG, $(LANGUAGES), $(CPLANG);) installdirs: test -d $(DESTDIR)$(BIN_DIR) || $(MKDIR) $(DESTDIR)$(BIN_DIR) test -d $(DESTDIR)$(MAN_DIR) || $(MKDIR) $(DESTDIR)$(MAN_DIR) test -d $(DESTDIR)$(DOC_DIR) || $(MKDIR) $(DESTDIR)$(DOC_DIR) test -d $(DESTDIR)/share/applications || $(MKDIR) $(DESTDIR)$(SHARE_DIR)/applications test -d $(DESTDIR)/share/lintian/overrides || $(MKDIR) $(DESTDIR)$(SHARE_DIR)/lintian/overrides $(foreach LANG, $(LANGUAGES), $(MKDIRLANG);) tomboy-ng_0.39-1/package/0000755000175000017500000000000014551457644015032 5ustar dbannondbannontomboy-ng_0.39-1/package/PkgInfo0000644000175000017500000000001114551457644016302 0ustar dbannondbannonAPPL???? tomboy-ng_0.39-1/package/package.bash0000644000175000017500000004202314551457644017265 0ustar dbannondbannon#!/bin/bash # A script to build tomboy and make deb packages and zip up the other binaries # see https://www.debian.org/doc/manuals/debian-faq/ch-pkg_basics # we can also add preinst, postinst, prerm, and postrm scripts if required # David Bannon, November, 2017 # Assumes a working FPC/Lazarus install with cross compile tools as described in # http://wiki.lazarus.freepascal.org/Cross_compiling_for_Win32_under_Linux and # http://wiki.lazarus.freepascal.org/Cross_compiling # and that a 'Release' mode exists. # ---------------------------------------------------------------------------- # Typical usage - # ./package_debian.sh $HOME"/lazarus/laz-200 # Note we assume laz config has same name as Laz directory, ie .laz-200 # ---------------------------------------------------------------------------- PRODUCT="tomboy-ng" VERSION=`cat version` SOURCE_DIR="../source" ICON_DIR="../glyphs" WHOAMI="David Bannon " MANUALS_DIR="BUILD/usr/share/doc/$PRODUCT/" MANUALS=`cat note-files` # BUILDOPTS=" -B --quiet --quiet" BUILDOPTS=" -B --verbose" BUILDDATE=`date -R` LPI="Tomboy_NG.lpi" LAZ_FULL_DIR="$1" LAZ_DIR=`basename "$LAZ_FULL_DIR"` WIN_DIR=WinPre_"$VERSION" LEAKCHECK="NO" if [ -z "$LAZ_DIR" ]; then echo "Need a full path to configured Lazarus dir, add a build mode to just compile a binary" echo "Usage : $0 /Full/Path/Lazarus/dir [ReleaseQT6|ReleaseRasPi64|ReleaseLin32Qt5|default]" echo "eg : $0 /home/dbannon/bin/Lazarus/lazarus-fixes_3_0" echo "or" echo " : $0 clean" exit fi if [ "$2" == "LeakCheck" ]; then LEAKCHECK="YES" fi if [ $1 == "clean" ]; then rm -f *.deb rm -f *.tgz rm -f *.rpm rm -Rf BUILD rm -Rf WinPre* exit fi # ---------------------- function LookForBinary () { cd "$SOURCE_DIR" if [ -a "$1" ]; then echo "Binary $1 was made" else echo "---------- ERROR $1 was not made" fi cd "../package" } function ModeParamArch () { # expects to be called like ARCH=$(ModeParamArch ReleaseLin64) case $1 in # Only useful in debian packaging, used in package name ReleaseLin64) echo "amd64" ;; ReleaseLin32) echo "i386" ;; ReleaseQT5) echo "amd64Qt5" ;; ReleaseRasPi) echo "armhf" ;; ReleaseRasPi64) echo "arm64" ;; ReleaseQT6) echo "amd64Qt6" ;; ReleaseLin32Qt5) echo "i386Qt5" ;; esac } function ModeParamBin () { # expects to be called like BIN=$(ModeParam ReleaseWin64) case $1 in Default) echo "$PRODUCT" ;; ReleaseLin64) echo "$PRODUCT"-64 ;; ReleaseLin32) echo "$PRODUCT"-32 ;; ReleaseLin32Qt5) echo "$PRODUCT"-32-qt5 ;; ReleaseWin32) echo "$PRODUCT"-32.exe ;; ReleaseWin64) echo "$PRODUCT"-64.exe ;; ReleaseQT5) echo "$PRODUCT"-qt5 ;; ReleaseQT6) echo "$PRODUCT"-qt6 ;; ReleaseRasPi) echo "$PRODUCT"-armhf ;; ReleaseRasPi64) echo "$PRODUCT"-arm64 ;; esac } # Modes (as defined in IDE) ReleaseLin64 ReleaseLin32 ReleaseWin64 ReleaseWin32 ReleaseRasPi ReleaseQT5 function BuildAMode () { echo "------------- Building Mode $1 --------" cd ../source BIN=$(ModeParamBin "$1") rm -f "$BIN" #CMD="TOMBOY_NG_VER=$VERSION $LAZ_FULL_DIR/lazbuild $BUILDOPTS $LAZ_CONFIG --build-mode=$1 $LPI" #echo "CMD is $CMD" TOMBOY_NG_VER="$VERSION" $LAZ_FULL_DIR/lazbuild $BUILDOPTS $LAZ_CONFIG --build-mode="$1" "$LPI" if [ -f "$BIN" ]; then echo "----------------- Have compiled $BIN ---------------------" else echo "============== $1 ERROR failed to build $BIN =================" echo "$LAZ_FULL_DIR/lazbuild $BUILDOPTS $LAZ_CONFIG --build-mode=$1 $LPI" ERROR="$ERROR ; error $BIN was not made." exit fi cd ../package } function JustMakeBinary () { # Gets called if there is a $2 (which becocomes $1 here), does NOT return # Only, at present, doing the ones we cannot build in default Build VM, but could do all I guess. case $1 in Default) BuildAMode "$1" exit ;; ReleaseRasPi64) BuildAMode "$1" exit ;; ReleaseQT6) BuildAMode "$1" exit ;; ReleaseLin32Qt5) BuildAMode "$1" exit ;; esac echo " ============ ERROR unknown build mode as second parameter $1 =============" exit } function DebianTemplate () { # the common to all versions things # We build a debian tree in BUILD and call dpkg-deb -b # BUILD/DEBIAN control,debian-binary and any scripts rm -rf BUILD mkdir -p BUILD/DEBIAN mkdir -p BUILD/usr/bin mkdir -p BUILD/usr/share/"$PRODUCT" for i in 16x16 22x22 24x24 32x32 48x48 256x256; do mkdir -p "BUILD/usr/share/icons/hicolor/$i/apps"; cp "$ICON_DIR/$i.png" "BUILD/usr/share/icons/hicolor/$i/apps/$PRODUCT.png"; done; mkdir -p BUILD/usr/share/doc/$PRODUCT cp ../doc/authors BUILD/usr/share/doc/$PRODUCT/. cp -R ../doc/HELP BUILD/usr/share/"$PRODUCT"/. # -------------- Translation Files # we end up with, eg, /usr/share/locale/es/LC_MESSAGES/tomboy-ng.mo # and /usr/share/locale/es/LC_MESSAGES/lclstrconsts.mo for Linux mkdir -p BUILD/usr/share/locale for i in `ls -b ../po/*.??.po`; do # Deal with each country code in turn #echo "Name is $i" BASENAME=`basename -s.po "$i"` #echo "BASENAME is $BASENAME" CCODE=`echo "$BASENAME" | cut -d '.' -f2` #echo "CCode is $CCODE" mkdir -p BUILD/usr/share/locale/"$CCODE"/LC_MESSAGES BASENAME=`basename -s."$CCODE" "$BASENAME"` msgfmt -o BUILD/usr/share/locale/"$CCODE"/LC_MESSAGES/"$BASENAME".mo "$i" msgfmt -o BUILD/usr/share/locale/"$CCODE"/LC_MESSAGES/lclstrconsts.mo "$LAZ_FULL_DIR"/lcl/languages/lclstrconsts."$CCODE".po done mkdir BUILD/usr/share/applications cp "$ICON_DIR/$PRODUCT.desktop" BUILD/usr/share/applications/. mkdir -p BUILD/usr/share/man/man1 gzip -9kn ../doc/$PRODUCT.1 mv ../doc/$PRODUCT.1.gz BUILD/usr/share/man/man1/. cp ../debian/copyright BUILD/usr/share/doc/"$PRODUCT"/. } # gets called with the Lazarus Build Mode name for each one we are packaging ... function DebianPackage () { echo "--------- Packaging $1 ----------" rm -Rf BUILD DebianTemplate ARCH=$(ModeParamArch "$1") BIN=$(ModeParamBin "$1") if [ ! -f ../source/"$BIN" ]; then echo "--------- WARNING $BIN not present in ../source BIN=[$BIN] and Mode=[$1] and ARCH=[$ARCH] ----------------" ERROR="$ERROR ; $BIN not present" return 1 fi CTRL_ARCH=$ARCH CTRL_DEPENDS="libgtk2.0-0 (>= 2.6), libc6 (>= 2.14), wmctrl, libnotify-bin" CTRL_RELEASE="GTK2 release." cp $SOURCE_DIR/$BIN BUILD/usr/bin/$PRODUCT # ----------- Some Special Cases ---------------- case "$1" in "ReleaseQT5") # echo "++++++++++ Setting QT5 +++++++++" CTRL_ARCH="amd64" CTRL_DEPENDS="libqt5pas1 (>= 2.15), libc6 (>= 2.14), wmctrl, libnotify-bin" CTRL_RELEASE="Qt5 release." # we must force qt5 app to use qt5ct because of a bug in qt5.tsavedialog - no longer ! # note ugly syntax, qt5 strips it off (and anything after it) before app sees it. # sed -i "s/Exec=tomboy-ng %f/Exec=env QT_QPA_PLATFORMTHEME=qt5ct tomboy-ng %f/" BUILD/usr/share/applications/"$PRODUCT".desktop #sed -i "s/Exec=tomboy-ng %f/Exec=tomboy-ng %f --platformtheme qt5ct/" BUILD/usr/share/applications/"$PRODUCT".desktop ;; "ReleaseLin32Qt5") # echo "++++++++++ Setting Lin 32 QT5 +++++++++" CTRL_ARCH="i386" CTRL_DEPENDS="libqt5pas1 (>= 2.15), libc6 (>= 2.14), wmctrl, libnotify-bin" # , qt5ct" Nov 2023, remove dep on qt5ct for laz rc2 and later CTRL_RELEASE="32bit Qt5 release." # we must force qt5 app to use qt5ct because of a bug in qt5.tsavedialog # note ugly syntax, qt5 strips it off (and anything after it) before app sees it. # sed -i "s/Exec=tomboy-ng %f/Exec=env QT_QPA_PLATFORMTHEME=qt5ct tomboy-ng %f/" BUILD/usr/share/applications/"$PRODUCT".desktop #sed -i "s/Exec=tomboy-ng %f/Exec=tomboy-ng %f --platformtheme qt5ct/" BUILD/usr/share/applications/"$PRODUCT".desktop ;; "ReleaseQT6") # echo "++++++++++ Setting QT6 +++++++++" CTRL_ARCH="amd64" CTRL_DEPENDS="libc6 (>= 2.34), wmctrl, libnotify-bin, libqt6pas6 (>= 6.2.7)" CTRL_RELEASE="Qt6 release." # we must force qt6 app to use qt6ct because of a bug in qt6.tsavedialog, no, not using Laz300 # note ugly syntax, qt6 strips it off (and anything after it) before app sees it. # sed -i "s/Exec=tomboy-ng %f/Exec=env QT_QPA_PLATFORMTHEME=qt6ct tomboy-ng %f/" BUILD/usr/share/applications/"$PRODUCT".desktop ;; "ReleaseRasPi") CTRL_RELEASE="Raspberry Pi 32bit release." CTRL_DEPENDS="libqt5pas1 (>= 2.15), libc6 (>= 2.14), wmctrl, libnotify-bin" ;; "ReleaseRasPi64") CTRL_RELEASE="Raspberry Pi 64bit release." ;; esac chmod 755 BUILD/usr/bin/tomboy-ng # -------------------- Changelog ----------------- if [ -f changelog ]; then cp changelog "$MANUALS_DIR"changelog else cp ../debian/changelog "$MANUALS_DIR"changelog DEBEMAIL="David Bannon " dch --changelog "$MANUALS_DIR"changelog -v "$VERSION" -D unstable --force-distribution "Release of new version" if [ -f ../whatsnew ]; then echo "----------- Including whatsnew in changelog" while IFS= read -r Line; do DEBEMAIL="David Bannon " dch --changelog "$MANUALS_DIR"changelog --append "$Line" done < ../whatsnew fi DEBEMAIL="David Bannon " dch --changelog "$MANUALS_DIR"changelog --append "Please see github for change details." cp "$MANUALS_DIR"changelog . # use this for subsquent ones. fi gzip -9n "$MANUALS_DIR"changelog # -------------------------------- Make control file ------------------------- echo "Package: $PRODUCT" > BUILD/DEBIAN/control echo "Version: $VERSION" >> BUILD/DEBIAN/control echo "Architecture: $CTRL_ARCH" >> BUILD/DEBIAN/control echo "Maintainer: $WHOAMI" >> BUILD/DEBIAN/control # -------------------------------- Calculate size, thanks circular@LazForum SIZE_IN_KB="$(du -s BUILD | awk '{print $1;}')" echo "Installed-Size: ${SIZE_IN_KB}" >> "BUILD/DEBIAN/control" echo "Depends: $CTRL_DEPENDS" >> BUILD/DEBIAN/control echo "Priority: optional" >> BUILD/DEBIAN/control echo "Homepage: https://github.com/tomboy-notes/tomboy-ng/wiki" >> BUILD/DEBIAN/control #echo "Homepage: https://wiki.gnome.org/Apps/Tomboy" >> BUILD/DEBIAN/control echo "Section: x11" >> BUILD/DEBIAN/control echo "Description: Tomboy Notes rewritten to make installation and cross platform easier." >> BUILD/DEBIAN/control echo " $CTRL_RELEASE" >> BUILD/DEBIAN/control echo " Please report your experiences." >> BUILD/DEBIAN/control chmod -R g-w BUILD fakeroot dpkg-deb -b BUILD/. "$PRODUCT""_$VERSION-0_"$ARCH".deb" echo " ---------- finished packaging " "$PRODUCT""_$VERSION-0_"$ARCH".deb" # --------------------------------- Clean up ----------- # rm -Rf BUILD } function WriteZipReadMe () { RM="$1/readme.txt" echo "This is a tar ball of $PRODUCT $VERSION for Linux. Use this if you cannot use" > "$RM" echo "either the deb or rpm on your particular distribution. It contains some of the" >> "$RM" echo "files you need and a very basic installer but does not resolve dependancies." >> "$RM" echo "Its assumed you know what you are doing." >> "$RM" echo "Files and features not provided here include -" >> "$RM" echo "* Language other than English" >> "$RM" echo "* tomboy-ng help files" >> "$RM" echo "* Ability to have tomboy-ng set itself to autostart" >> "$RM" echo "Dependencies include libgtk2.0-0, libcanberra-gtk-module, libnotify, wmctrl." >> "$RM" echo " or, in the Qt5 version, libqt5pas1, libnotify, wmctrl" >> $RM echo "If you need help, please post specific question to tomboy-ng github issues." >> "$RM" } function DoGZipping { BIN=$(ModeParamBin "$1") ARCH=$(ModeParamArch "$1") GZIP_DIR="$PRODUCT"-"$VERSION" # rm -f *.tgz # for TBVer in tomboy-ng32 tomboy-ng; do rm -Rf "$GZIP_DIR" mkdir "$GZIP_DIR" cp "$SOURCE_DIR"/"$BIN" "$GZIP_DIR"/"$PRODUCT" for i in 16x16 22x22 24x24 32x32 48x48 256x256; do cp "$ICON_DIR/$i.png" "$GZIP_DIR/$i.png" done; cp "$ICON_DIR/install-local.bash" "$GZIP_DIR/install-local.bash" cp "$ICON_DIR/$PRODUCT.desktop" "$GZIP_DIR/$PRODUCT.desktop" gzip -9kn ../doc/$PRODUCT.1 mv ../doc/$PRODUCT.1.gz "$GZIP_DIR"/. WriteZipReadMe "$GZIP_DIR" tar czf "$PRODUCT"-"$VERSION"-"$ARCH".tgz "$GZIP_DIR" rm -Rf "$GZIP_DIR" } function MkWinPreInstaller() { # Make a dir containing everything we need to make a 32/64bit Inno Setup installer for Windows rm -Rf "$WIN_DIR" mkdir "$WIN_DIR" cp "$SOURCE_DIR"/tomboy-ng-64.exe "$WIN_DIR"/tomboy-ng64.exe cp "$SOURCE_DIR"/tomboy-ng-32.exe "$WIN_DIR"/tomboy-ng32.exe # cp ../../DLL/* "$WIN_DIR"/. cp ../../DLL/libhunspell.dll "$WIN_DIR/." cp ../../DLL/libhunspell.license "$WIN_DIR/." cp ../COPYING "$WIN_DIR/." cp AfterInstall.txt "$WIN_DIR/." sed "s/MyAppVersion \"REPLACEME\"/MyAppVersion \"$VERSION\"/" tomboy-ng.iss > "$WIN_DIR/tomboy-ng.iss.temp" # mkdir -p "$WIN_DIR/HELP/EN" # mkdir -p "$WIN_DIR/HELP/ES" # for i in $MANUALS; do # cp ../doc/$i "$WIN_DIR/." # done; mkdir "$WIN_DIR/HELP_DIR" cp -R ../doc/HELP "$WIN_DIR/HELP_DIR/." # " -------- WRITE mo files --------" # msgfmt -o "$WIN_DIR"/"$PRODUCT".mo ../po/"$PRODUCT".po # Hmm, why was this here ? 2023-11-22 # Source: "tomboy-ng.mo"; DestDir: "{app}\locale"; Flags: ignoreversion # echo "Source: \""$PRODUCT".mo\"; DestDir: \"{app}\\locale\"; Flags: ignoreversion" > mo.insert # above line commented Feb 2022, don't need tomboy-ng.mo in any package for i in `ls -b ../po/*.??.po`; do # echo "Name is $i" BASENAME=`basename -s.po "$i"` CCODE=`echo "$BASENAME" | cut -d '.' -f2` # echo "CCode is $CCODE" BASENAME=`basename -s."$CCODE" "$BASENAME"` msgfmt -o "$WIN_DIR"/"$BASENAME"."$CCODE".mo "$i" msgfmt -o "$WIN_DIR"/lclstrconsts."$CCODE".mo "$LAZ_FULL_DIR"/lcl/languages/lclstrconsts."$CCODE".po echo "Source: \""$BASENAME"."$CCODE".mo\"; DestDir: \"{app}\\locale\"; Flags: ignoreversion" >> mo.insert echo "Source: \"lclstrconsts."$CCODE".mo\"; DestDir: \"{app}\\locale\"; Flags: ignoreversion" >> mo.insert done sed '/PUTMOLINESHERE/r mo.insert' "$WIN_DIR"/tomboy-ng.iss.temp > "$WIN_DIR"/tomboy-ng.iss MANWIDTH=70 man -l ../doc/tomboy-ng.1 > "$WIN_DIR/readmeUNIX.txt" awk 'sub("$", "\r")' "$WIN_DIR/readmeUNIX.txt" > "$WIN_DIR/readme.txt" rm "$WIN_DIR/readmeUNIX.txt" # unix2dos -q "$WIN_DIR/readme.txt" Hmm, unix2dos seems to have dissapeared ! echo "----------- Windows installer dir created -----------" rm mo.insert # ls -la "$WIN_DIR" } # ------- OK, lets find Laz Config --------------------------------- # It all starts here if [ -f "$LAZ_FULL_DIR"/lazarus.cfg ]; then # Assume if we have a cfg, it specifies pcp ?? Will fail otherwise LAZ_CONFIG=`grep -i pcp "$LAZ_FULL_DIR"/lazarus.cfg` else if [ -d "$HOME/.Laz_$LAZ_DIR" ]; then # try my way of naming config first LAZ_CONFIG="$HOME/.Laz_$LAZ_DIR"; else echo "------ Testing for the .Laz config $HOME------" if [ -d "$HOME/.$LAZ_DIR" ]; then LAZ_CONFIG="$HOME/.$LAZ_DIR"; fi fi fi if [ -z "$LAZ_CONFIG" ]; then echo "--------- ERROR, dont have a Laz Config -------" exit fi echo "----- LAZ_CONFIG is $LAZ_CONFIG ------" # Note: because we must build Qt6 on later that U20.04 and for all others, we must build on U20.04 # due to the libc issue, we cannot build our qt6 one all at the same time. rm -f changelog # we build a new one from ../debian/changelog and ../whatsnew each run if [ "$2" != "" ]; then JustMakeBinary "$2" # Does not return. fi for BIN in ReleaseLin64 ReleaseLin32 ReleaseWin64 ReleaseWin32 ReleaseRasPi ReleaseQT5; # ReleaseQt6 etc, not yet ! Must build elsewhere, bring biary here. do BuildAMode $BIN; done # Note we can package ReleaseQT6 ReleaseRasPi64 ReleaseLin32Qt5 but not build them, so, build # elsewhere and put binaries in ../source. tomboy-ng-qt6 tomboy-ng-arm64 tomboy-ng-32-qt5 rm tom*.deb # Next line assumes some binaries, compiled elsewhere, have been put in the ../source directory # tomboy-ng-32-qt5 (ReleaseLin32Qt5) # tomboy-ng-qt6 (ReleaseQt6) # tomboy-ng-arm64 (ReleaseRasPi64) for BIN in ReleaseLin64 ReleaseLin32 ReleaseRasPi ReleaseQT5 ReleaseQT6 ReleaseRasPi64 ReleaseLin32Qt5; # Always package ReleaseLin64 first to update changelog once do DebianPackage $BIN ; done rm tom*.tgz for MODE in ReleaseLin64 ReleaseLin32 ; do DoGZipping $MODE; done MkWinPreInstaller # ls -ltr fakeroot bash ./mk_rpm.sh # echo "OK, if that looks OK, run fakeroot bash ./mk_rpm.sh" # Dont sign under fakeroot, its messy echo "OK, we will now sign the RPMs - david, use the longer passphrase !" for i in `ls -b *.rpm`; do rpm --addsign "$i"; echo "Signed $i"; done ls -l *.rpm *.deb "$WIN_DIR"/*.exe echo "ERROR REPORT = $ERROR" tomboy-ng_0.39-1/package/mk_dmg.bash0000644000175000017500000001176714551457644017143 0ustar dbannondbannon#!/bin/bash # ------------------------------------------------------------ # # A script to generate Mac's tomboy-ng dmg files # Typical Usage : bash ./mk_dmg.bash $HOME/bin/lazarus/fixes_2_0 # bash ./mk_dmg.bash packageonly # Note we assume config is named same as lazarus dir, ie .laz-200 # # Depends (heavily) on https://github.com/andreyvit/create-dmg # which must be installed. # # Probably should put license and readme in there too. # ------------------------------------------------------------- # History # 2022-11-02 Made allowance for lazconfig not being in $HOME/.* We now assume # instead that ALL Laz installs have a lazarus.cfg with --pcp= # 2023-11-08 Work in progress, added packageonly and path changes to get it # working on the Mac Mini (brew things now in path). # Not tested doing a compile first, does make the Universal binary # as long as the two individual binaries exist in ../source # # WARNING - as packageonly is not being told where Lazarus is, it cannot find # Lazarus's premade language files. LAZ_FULL_DIR="$1" LAZ_DIR=`basename "$LAZ_FULL_DIR"` PRODUCT=tomboy-ng WORK=source_folder CONTENTS="$WORK/""$PRODUCT".app/Contents VERSION=`cat version` MANUALS=`cat note-files` MSGFMT="msgfmt" #MSGFMT="/usr/local/Cellar/gettext/0.19.8.1/bin/msgfmt" VERSION=`cat version` PACKAGEONLY='false' if [ "$1" == "packageonly" ]; then PACKAGEONLY='true'; else LAZ_PCP=`cat "$LAZ_FULL_DIR"/lazarus.cfg` if [ -z "$LAZ_DIR" ]; then echo "Usage : $0 /Full/Path/Lazarus/dir" echo "eg : $0 \$HOME/bin/lazarus/fixes_2_0" exit fi if [ ! -f "$LAZ_FULL_DIR"/lazbuild ]; then echo "Sorry, ""$LAZ_FULL_DIR"" does not look like it contains a Lazarus build" exit fi fi # We do some wildcard deletes further on, be safe ! if [ ! -f tomboy-ng.iss ]; then echo "Not running in tomboy-ng package dir, too dangerous" exit fi function MakeBinary () { # Pass the Lazarus Mode we wish to build cd ../source BINARY="" case $1 in CocoaRelease) THECPU="x86_64" BINARY="tomboy-ng-x86_64" ;; CocoaArmRelease) THECPU="aarch64" BINARY="tomboy-ng-aarch64" ;; esac if [ "$BINARY" == "" ]; then echo "============ ERROR bad Mode Name ( $1 ) passed to MakeBinary =======" exit fi echo "--------- Making $BINARY with mode $1 --------" TOMBOY_NG_VER="$VERSION" $LAZ_FULL_DIR/lazbuild "$LAZ_PCP" -B --cpu="$THECPU" --build-mode="$1" Tomboy_NG.lpi if [ ! -f "$BINARY" ]; then echo "============= ERROR failed to make $BINARY ==========" exit fi echo "------------ $BINARY ready sir ------------" } function MakeUniversal() { cd ../source lipo -create -output tomboy-ng tomboy-ng-x86_64 tomboy-ng-aarch64 strip "$PRODUCT" if [ ! -f "$PRODUCT" ]; then echo "================= ERROR $PRODUCT is not present in source ========= " exit fi cd ../package } function MakeDMG () { if [ ! -f "../source/$PRODUCT" ]; then echo "================= ERROR $PRODUCT is not present in source dir ========= " exit fi BITS="64" # -------- Packaging starts here -------- rm -Rf $WORK mkdir -p $CONTENTS ln -s /Applications $WORK/Applications mkdir "$CONTENTS"/SharedSupport mkdir "$CONTENTS"/Resources mkdir "$CONTENTS"/MacOS MANWIDTH=70 man ../doc/tomboy-ng.1 > "$CONTENTS"/SharedSupport/readme.txt cp -R ../doc/html "$CONTENTS"/SharedSupport/. sed "s/REPLACEVER/\"$VERSION\"/" Info.plist > "$CONTENTS/Info.plist" # cp Info.plist "$CONTENTS/." cp PkgInfo "$CONTENTS/." cp ../glyphs/tomboy-ng.icns "$CONTENTS/Resources/." # for i in $MANUALS; do # cp ../doc/"$i" "$CONTENTS/Resources/."; # done; cp -R ../doc/HELP "$CONTENTS/Resources/." mkdir "$CONTENTS/MacOS/locale" for i in `ls -b ../po/*.??.po`; do echo "Name is $i" BASENAME=`basename -s.po "$i"` CCODE=`echo "$BASENAME" | cut -d '.' -f2` echo "CCode is $CCODE" BASENAME=`basename -s."$CCODE" "$BASENAME"` mkdir -p "$CONTENTS/MacOS/locale/$CCODE" "$MSGFMT" -o "$CONTENTS/MacOS/locale/$CCODE"/"$BASENAME".mo "$i" "$MSGFMT" -o "$CONTENTS/MacOS/locale/$CCODE"/lclstrconsts.mo "$LAZ_FULL_DIR"/lcl/languages/lclstrconsts."$CCODE".po done cp ../source/"$PRODUCT" "$CONTENTS/MacOS/." rm -f "$PRODUCT""$BITS"_"$VERSION".dmg # ~/create-dmg-master/create-dmg --volname "$PRODUCT""$BITS" --volicon "../glyphs/vol.icns" "$PRODUCT""$BITS"_"$VERSION".dmg "./$WORK/" create-dmg --volname "$PRODUCT""$BITS" --volicon "../glyphs/vol.icns" "$PRODUCT""$BITS"_"$VERSION".dmg "./$WORK/" } if [ "$PACKAGEONLY" == "false" ]; then if [ "LAZ_PCP" == "" ]; then echo "Failed to find config file" exit fi fi rm -f *.dmg # MakeDMG "carbon" # We don't bother building carbon any more, it should still build, must test occasionally. July 2020 # MakeDMG "cocoa" rm ../source/tomboy-ng-* MakeBinary "CocoaRelease" MakeBinary "CocoaArmRelease" MakeUniversal MakeDMG tomboy-ng_0.39-1/package/version0000644000175000017500000000000514551457644016435 0ustar dbannondbannon0.39 tomboy-ng_0.39-1/package/Info.plist0000644000175000017500000000243414551457644017005 0ustar dbannondbannon CFBundleDevelopmentRegion English CFBundleExecutable tomboy-ng CFBundleIconFile tomboy-ng.icns CFBundleName tomboy-ng CFBundleIdentifier com.company.tomboy-ng CFBundleInfoDictionaryVersion 6.0 CFBundlePackageType APPL CFBundleSignature tomb CFBundleShortVersionString REPLACEVER CFBundleVersion REPLACEVER CSResourcesFileMapped CFBundleDocumentTypes CFBundleTypeRole Viewer CFBundleTypeExtensions * CFBundleTypeOSTypes fold disk **** NSHighResolutionCapable tomboy-ng_0.39-1/package/mk_dmg-new.bash0000644000175000017500000001101114551457644017710 0ustar dbannondbannon#!/bin/bash # ------------------------------------------------------------ # # A script to generate Mac's tomboy-ng dmg files # Typical Usage : bash ./mk_dmg.bash $HOME/bin/lazarus/fixes_2_0 # bash ./mk_dmg.bash packageonly # Note we assume config is named same as lazarus dir, ie .laz-200 # # Depends (heavily) on https://github.com/andreyvit/create-dmg # which must be installed. # # Probably should put license and readme in there too. # ------------------------------------------------------------- # History # 2022-11-02 Made allowance for lazconfig not being in $HOME/.* We now assume # instead that ALL Laz installs have a lazarus.cfg with --pcp= # 2023-11-08 Work in progress, added packageonly and path changes to get it # working on the Mac Mini (brew things now in path). # Not tested doing a compile first, does make the Universal binary # as long as the two individual binaries exist in ../source # # WARNING - as packageonly is not being told where Lazarus is, it cannot find # Lazarus's premade language files. LAZ_FULL_DIR="$1" LAZ_DIR=`basename "$LAZ_FULL_DIR"` PRODUCT=tomboy-ng WORK=source_folder CONTENTS="$WORK/""$PRODUCT".app/Contents VERSION=`cat version` MANUALS=`cat note-files` MSGFMT="msgfmt" #MSGFMT="/usr/local/Cellar/gettext/0.19.8.1/bin/msgfmt" VERSION=`cat version` PACKAGEONLY='false' if [ "$1" == "packageonly" ]; then PACKAGEONLY='true'; else LAZ_PCP=`cat "$LAZ_FULL_DIR"/lazarus.cfg` if [ -z "$LAZ_DIR" ]; then echo "Usage : $0 /Full/Path/Lazarus/dir" echo "eg : $0 \$HOME/bin/lazarus/fixes_2_0" exit fi if [ ! -f "$LAZ_FULL_DIR"/lazbuild ]; then echo "Sorry, ""$LAZ_FULL_DIR"" does not look like it contains a Lazarus build" exit fi fi # We do some wildcard deletes further on, be safe ! if [ ! -f tomboy-ng.iss ]; then echo "Not running in tomboy-ng package dir, too dangerous" exit fi function MakeDMG () { if [ "$1" = "carbon" ]; then CPU="i386" BITS="32" REL="CarbonRelease" else CPU="x86_64" BITS="64" REL="CocoaRelease" fi cd ../source rm -f "$PRODUCT" # we are building a new one, either with fpc or lipo if [ "$PACKAGEONLY" == 'false' ]; then # TOMBOY_NG_VER="$VERSION" $LAZ_FULL_DIR/lazbuild --pcp="$HOME/.$LAZ_DIR" -B --cpu="$CPU" --ws="$1" --build-mode="$REL" --os="darwin" Tomboy_NG.lpi TOMBOY_NG_VER="$VERSION" $LAZ_FULL_DIR/lazbuild "$LAZ_PCP" -B --cpu="$CPU" --ws="$1" --build-mode="$REL" --os="darwin" Tomboy_NG.lpi if [ ! -f "$PRODUCT" ]; then echo "------------------------------------" echo "Failed to build ""$BITS"" bit binary" echo "------------------------------------" exit fi else # ie, package only mode lipo -create -output tomboy-ng tomboy-ng-x86_64 tomboy-ng-aarch64 fi strip "$PRODUCT" cd ../package # -------- Packaging starts here -------- rm -Rf $WORK mkdir -p $CONTENTS ln -s /Applications $WORK/Applications mkdir "$CONTENTS"/SharedSupport mkdir "$CONTENTS"/Resources mkdir "$CONTENTS"/MacOS MANWIDTH=70 man ../doc/tomboy-ng.1 > "$CONTENTS"/SharedSupport/readme.txt cp -R ../doc/html "$CONTENTS"/SharedSupport/. sed "s/REPLACEVER/\"$VERSION\"/" Info.plist > "$CONTENTS/Info.plist" # cp Info.plist "$CONTENTS/." cp PkgInfo "$CONTENTS/." cp ../glyphs/tomboy-ng.icns "$CONTENTS/Resources/." # for i in $MANUALS; do # cp ../doc/"$i" "$CONTENTS/Resources/."; # done; cp -R ../doc/HELP "$CONTENTS/Resources/." mkdir "$CONTENTS/MacOS/locale" for i in `ls -b ../po/*.??.po`; do echo "Name is $i" BASENAME=`basename -s.po "$i"` CCODE=`echo "$BASENAME" | cut -d '.' -f2` echo "CCode is $CCODE" BASENAME=`basename -s."$CCODE" "$BASENAME"` mkdir -p "$CONTENTS/MacOS/locale/$CCODE" "$MSGFMT" -o "$CONTENTS/MacOS/locale/$CCODE"/"$BASENAME".mo "$i" "$MSGFMT" -o "$CONTENTS/MacOS/locale/$CCODE"/lclstrconsts.mo "$LAZ_FULL_DIR"/lcl/languages/lclstrconsts."$CCODE".po done cp ../source/"$PRODUCT" "$CONTENTS/MacOS/." rm -f "$PRODUCT""$BITS"_"$VERSION".dmg # ~/create-dmg-master/create-dmg --volname "$PRODUCT""$BITS" --volicon "../glyphs/vol.icns" "$PRODUCT""$BITS"_"$VERSION".dmg "./$WORK/" create-dmg --volname "$PRODUCT""$BITS" --volicon "../glyphs/vol.icns" "$PRODUCT""$BITS"_"$VERSION".dmg "./$WORK/" } if [ "$PACKAGEONLY" == "false" ]; then if [ "LAZ_PCP" == "" ]; then echo "Failed to find config file" exit fi fi rm -f *.dmg # MakeDMG "carbon" # We don't bother building carbon any more, it should still build, must test occasionally. July 2020 MakeDMG "cocoa" tomboy-ng_0.39-1/package/note-files0000644000175000017500000000042414551457644017022 0ustar dbannondbannonHELP/EN/recover.note HELP/EN/sync-ng.note HELP/EN/tomboy-ng.note HELP/EN/tomdroid.note HELP/EN/calculator.note HELP/EN/key-shortcuts.note HELP/ES/recover.note HELP/ES/sync-ng.note HELP/ES/tomboy-ng.note HELP/ES/tomdroid.note HELP/ES/calculator.note HELP/ES/key-shortcuts.note tomboy-ng_0.39-1/package/tomboy-ng.iss0000644000175000017500000001066514551457644017475 0ustar dbannondbannon; Script generated by the Inno Script Studio Wizard. ; SEE THE DOCUMENTATION FOR DETAILS ON CREATING INNO SETUP SCRIPT FILES! #define MyAppName "tomboy-ng" #define MyAppVersion "REPLACEME" #define MyAppPublisher "David Bannon" #define MyAppURL "https://github.com/tomboy-notes/tomboy-ng" #define MyAppExeName32 "tomboy-ng.exe" #define MyAppExeName64 "tomboy-ng.exe" [Setup] ; NOTE: The value of AppId uniquely identifies this application. ; Do not use the same AppId value in installers for other applications. ; (To generate a new GUID, click Tools | Generate GUID inside the IDE.) AppId={{913B2DAF-AAFB-451A-98B3-FAE16027E477} AppName={#MyAppName} AppVersion={#MyAppVersion} ;AppVerName={#MyAppName} {#MyAppVersion} AppPublisher={#MyAppPublisher} AppPublisherURL={#MyAppURL} AppSupportURL={#MyAppURL} AppUpdatesURL={#MyAppURL} DefaultDirName={pf}\{#MyAppName} DefaultGroupName={#MyAppName} LicenseFile=COPYING InfoAfterFile=AfterInstall.txt OutputBaseFilename=tomboy-ng-setup-{#MyAppVersion} Compression=lzma SolidCompression=yes ; VersionInfoVersion={#MyAppVersion} ; "ArchitecturesInstallIn64BitMode=x64" requests that the install be ; done in "64-bit mode" on x64, meaning it should use the native ; 64-bit Program Files directory and the 64-bit view of the registry. ; On all other architectures it will install in "32-bit mode". ArchitecturesInstallIn64BitMode=x64 [Languages] Name: "english"; MessagesFile: "compiler:Default.isl" [Tasks] Name: "desktopicon"; Description: "{cm:CreateDesktopIcon}"; GroupDescription: "{cm:AdditionalIcons}"; Flags: unchecked ;Name: associate; Description: "&Associate files"; GroupDescription: "Associate .note files with tomboy-ng:"; Flags: unchecked ; Thats a todo, see http://www.jrsoftware.org/isfaq.php - requires admin priviliges, maybe a pain to non-admin users ? [Files] ; Install MyProg-x64.exe if running in 64-bit mode (x64; see above), MyProg.exe otherwise. Source: "libhunspell.license"; DestDir: "{app}"; Check: Is64BitInstallMode Source: "libhunspell.dll"; DestDir: "{app}"; Check: Is64BitInstallMode ; Source: "ssleay32.dll-64"; DestDir: "{app}"; DestName: "ssleay32.dll"; Check: Is64BitInstallMode ; Source: "libeay32.dll-64"; DestDir: "{app}"; DestName: "libeay32.dll"; Check: Is64BitInstallMode ; Source: "ssleay32.dll-32"; DestDir: "{app}"; DestName: "ssleay32.dll"; Check: not Is64BitInstallMode ; Source: "libeay32.dll-32"; DestDir: "{app}"; DestName: "libeay32.dll"; Check: not Is64BitInstallMode Source: "tomboy-ng64.exe"; DestDir: "{app}"; DestName: "tomboy-ng.exe"; Check: Is64BitInstallMode Source: "tomboy-ng32.exe"; DestDir: "{app}"; DestName: "tomboy-ng.exe"; Check: not Is64BitInstallMode ;Source: "C:\Users\dbann\Desktop\tomboy-ng_{#MyAppVersion}\tomboy-ng64.exe"; DestDir: "{app}"; Flags: ignoreversion DestDir: {app}; Source: "HELP_DIR\*"; Flags: recursesubdirs ; eg DestDir: {app}; Source: Files\*; Excludes: "*.m,.svn,private"; Flags: recursesubdirs ; Source: "calculator.note"; DestDir: "{app}"; Flags: ignoreversion ; Source: "key-shortcuts.note"; DestDir: "{app}"; Flags: ignoreversion ; Source: "recover.note"; DestDir: "{app}"; Flags: ignoreversion ; Source: "sync-ng.note"; DestDir: "{app}"; Flags: ignoreversion ; Source: "tomboy-ng.note"; DestDir: "{app}"; Flags: ignoreversion ; Source: "tomdroid.note"; DestDir: "{app}"; Flags: ignoreversion Source: "readme.txt"; DestDir: "{app}"; Flags: ignoreversion ; PUTMOLINESHERE ; Source: "tomboy-ng.es.mo"; DestDir: "{app}\locale"; Flags: ignoreversion ; NOTE: Don't use "Flags: ignoreversion" on any shared system files [Icons] Name: "{group}\{#MyAppName}"; Filename: "{app}\{#MyAppExeName64}"; Check: Is64BitInstallMode Name: "{group}\{#MyAppName}"; Filename: "{app}\{#MyAppExeName32}"; Check: not Is64BitInstallMode Name: "{commondesktop}\{#MyAppName}"; Filename: "{app}\{#MyAppExeName64}"; Tasks: desktopicon; Check: Is64BitInstallMode Name: "{commondesktop}\{#MyAppName}"; Filename: "{app}\{#MyAppExeName32}"; Tasks: desktopicon; Check: not Is64BitInstallMode [Run] Filename: "{app}\{#MyAppExeName64}"; Description: "{cm:LaunchProgram,{#StringChange(MyAppName, '&', '&&')}}"; Flags: nowait postinstall skipifsilent; Check: Is64BitInstallMode Filename: "{app}\{#MyAppExeName32}"; Description: "{cm:LaunchProgram,{#StringChange(MyAppName, '&', '&&')}}"; Flags: nowait postinstall skipifsilent; Check: not Is64BitInstallMode tomboy-ng_0.39-1/package/mk_rpm.sh0000644000175000017500000001057014551457644016656 0ustar dbannondbannon#!/usr/bin/bash # ==================================================== # a short script to make RPMs from our tomboy-ng debs # does more than just call alien as that seems to end up # with commands to create / and /usr/bin that upset yum # # This script must be run as fake root, so useage is - # fakeroot bash mk_rpm # # History # 2020/03/10 # Finally worked out why yum won't work, while the rpm # command is happy with me calling the arch i386, amd64 (debian speak) # yum insists on them being x86, x86_64. # Manually add wmctrl to dependencies. # 2021/05/15 # don't add gnome-shell-extension-appindicator to dependencies, # it pulls in half of Gnome desktop, non gnome users would hate me. # 2023-12-13 # Force a Minium libqt5pas of 1.2.15, this will need constant attention. # Add a qt5 amd64 rpm # ==================================================== PROD=tomboy-ng VERS=`cat version` RDIR="$PROD"-"$VERS" PACKVER=1 # Starts at '1', rev it if we are repackaging same content function DoAlien () { FILENAME="$PROD"_"$VERS"-0_"$1".deb # this is the input deb file ARCH="$1" rm -Rf "$RDIR" # Note, debs have a dash after initial version number, RPM an underscore if [ "$1" = amd64Qt5 ]; then # FILENAME="tomboy-ngQt_0.24b-0_amd64.deb" ARCH=x86_64 fi if [ "$1" = amd64Qt6 ]; then ARCH=x86_64 fi if [ "$1" = amd64 ]; then # the gtk2 version ARCH=x86_64 fi if [ "$1" = i386 ]; then ARCH=i686 # that is used in the output RPM fi if [ ! -f "$FILENAME" ]; then echo "=========== ERROR $FILENAME does not exist ================" return fi echo "--- RDIR=$RDIR and building for $1 using $FILENAME ---------" alien -r -g -v -k "$FILENAME" # Alien requests the package create / and /usr/bin and # the os does not apprieciate that, not surprisingly. # This removes the %dir / sed -i "s/^Release:.*/Release: $PACKVER/" "$RDIR"/"$RDIR"-"$PACKVER".spec sed -i 's#%dir "/"##' "$RDIR"/"$RDIR"-"$PACKVER".spec # and this removes %dir /usr/bin sed -i 's#%dir "/usr/bin/"##' "$RDIR"/"$RDIR"-"$PACKVER".spec sed -i 's#%dir "/usr/"##' "$RDIR"/"$RDIR"-"$PACKVER".spec sed -i 's#%dir "/usr/share/"##' "$RDIR"/"$RDIR"-"$PACKVER".spec sed -i 's#%dir "/usr/share/doc/"##' "$RDIR"/"$RDIR"-"$PACKVER".spec sed -i 's#%dir "/usr/share/icons/"##' "$RDIR"/"$RDIR"-"$PACKVER".spec sed -i 's#%dir "/usr/share/man/"##' "$RDIR"/"$RDIR"-"$PACKVER".spec sed -i 's#%dir "/usr/share/man/man1/"##' "$RDIR"/"$RDIR"-"$PACKVER".spec sed -i '10i Packager: David Bannon ' "$RDIR"/"$RDIR"-"$PACKVER".spec sed -i '11i URL: https://githup.com/tomboy/tomboy-ng' "$RDIR"/"$RDIR"-"$PACKVER".spec if [ "$1" = amd64Qt5 ]; then echo "------------ Setting Minium libqt5pas to 1.2.15 ---------------------------" sed -i '12i Requires: libqt5pas >= 1.2.15' "$RDIR"/"$RDIR"-"$PACKVER".spec fi gunzip "$RDIR"/usr/share/man/man1/tomboy-ng.1.gz bzip2 "$RDIR"/usr/share/man/man1/tomboy-ng.1 sed -i "s/tomboy-ng.1.gz/tomboy-ng.1.bz2/" "$RDIR"/"$RDIR"-"$PACKVER".spec cp "$RDIR"/"$RDIR"-"$PACKVER".spec "$1".spec echo "%changelog" >> "$RDIR"/"$RDIR"-"$PACKVER".spec CHDATE=`date +"%a %b %d %Y"` CHDATE="* $CHDATE David Bannon $VERS"-"$PACKVER" echo "$CHDATE" >> "$RDIR"/"$RDIR"-"$PACKVER".spec echo "- Release of package" >> "$RDIR"/"$RDIR"-"$PACKVER".spec while read -r line; do echo -e "- $line" >> "$RDIR"/"$RDIR"-"$PACKVER".spec done <"../whatsnew" # rpmbuild detects the dependencies but it misses wmctrl due to way its used. # So we add it to the spec file manually, insert as line 5. sed -i '5i Requires: wmctrl ' "$RDIR"/"$RDIR"-"$PACKVER".spec # cp -r "$RDIR" "$RDIR"-"$1" cd "$RDIR" cp "$RDIR"-"$PACKVER".spec ../../"$RDIR"-"$PACKVER".spec-"$1" rpmbuild --target "$ARCH" --buildroot "$PWD" -bb "$RDIR"-"$PACKVER".spec cd .. # if its a Qt5 one, rename it so it does not get overwritten subsquently if [ "$1" = amd64Qt5 ]; then mv "$RDIR"-"$PACKVER"."$ARCH".rpm "$PROD"Qt5-"$VERS"-"$PACKVER"."$ARCH".rpm fi if [ "$1" = amd64Qt6 ]; then mv "$RDIR"-"$PACKVER"."$ARCH".rpm "$PROD"Qt6-"$VERS"-"$PACKVER"."$ARCH".rpm fi } rm -f tom*.rpm # Must do the "non std" ones first, else have overwrite problems DoAlien "amd64Qt5" DoAlien "amd64Qt6" DoAlien "i386" DoAlien "amd64" chown "$SUDO_USER" *.rpm #echo "OK, we will now sign - david, use the longer passphrase !" #for i in `ls -b *.rpm`; do rpm --addsign "$i"; echo "Signed $i"; done ls -l *.rpm tomboy-ng_0.39-1/package/AfterInstall.txt0000644000175000017500000000115214551457644020162 0ustar dbannondbannonOK, looks like tomboy-ng is now installed. When it starts, it places a yellow icon in your System Tray, thats probably all you need to interact with it. If you cannot see it, click the ^ icon, "Show Hidden Icons", click (or drag to the bar) the yellow tomboy-ng icon. Depending on your existing setting, you may also see a small "spash screen" window showing some tomboy-ng status infomation. You can dismiss this and, if you wish, tick the box to ensure you don't see it again. If you close the small splash screen using top, right [X], that will close tomboy-ng. Please report you experiences with tomboy-ng. tomboy-ng_0.39-1/package/tomboy-ng-GPG-KEY0000644000175000017500000000610314551457644017731 0ustar dbannondbannon-----BEGIN PGP PUBLIC KEY BLOCK----- mQINBF+8drsBEADmlSR283mj+Y9a8jxoWk9tEEdavOtSqN/IV94o+pkLmBuDSEUj nJwCNjyI6EowBfc3aSYe0AqnViv+kBa1b79qizd8TwZzxBecelViF8aPGUwFkNEi etJw6hzDTzgww+Y6eMkLFdXKN8YcXKQVRCY7bO/U29pvTJsa1++hSLrkYbq8WTC0 +4tLZ9WrsOxtHZA/4g6e1tDiL09RVIEFuZZ6/pa9M7pVnhHPu6P62+y/F8fwY9yP Z5rFblMQnunInNvvu8F5KxOUMNhbJaw6V4UixnO995OgC87zOAY+3VM7fpzGV//x 8Fk2WHlcFigiN+mtQ3uZclcF3lW33I6LO6azU6jp1QyHYKXvlNm2Kd6suqUonWPI AHmXSyesGe0v5U4Bw9FmiDXY+2Nv1R5NHarRo/1Fajs6K7OR5JDjzRsnuANom5eR OLyWLa/VQTh0TjwicV8vLzfiXqbF/ran3Dis4Z7mu6I4QxRnDuMESOa+9hRJ7y/A ePWpr4oP/Bjsl26ffWb5mwstO5yW2BooKZifS2J/kx8dQCud3kg/6dFD815Oh7fw dnfGVJSYy4Qo05KQ86BPnZTim4N7ZoGRWkKN+XrZ9MX7BkCaSB++Xao8o3kSGd5U 8sUW3/UmA2ax0mP//VMG89y9PECXaCGxbNUAId78b6mypmwBOP4FnHdnlwARAQAB tCZEYXZpZCBCYW5ub24gPHRvbWJveS1uZ0BiYW5ub25zLmlkLmF1PokCTgQTAQgA OBYhBCZJifQe2lB7v3/SoznAVfbiYXdBBQJfvHa7AhsDBQsJCAcCBhUKCQgLAgQW AgMBAh4BAheAAAoJEDnAVfbiYXdBps4QAL7plEV0gRlbJT0bZoMlb2I15YVrGQHT +Th2EtT9tdt8OgTTEwAgFOjPPRyn5MoqkgF/uq7A1iQi+CFslsiEZu3V8bjWUfVE v4/Yk/KBF6M8QAZMutsTBwKnvf/sjpnBT+xu9DE8oIIzs2TMvFx+IbHrtrvn8LJa CPwDW0mRnwJ/xIitxjTeaEIhTVfqShvYG+vvddNt7iBMpeF7uMPjXS8Jrnd9yoZP XQylF061LQNsgxWn4x6qyYbm/ucBhCeP0P9xCqWSrkT4CbQrgXMSWFQwpyo0QJKX +iqoZSUaOiDKhdb5LJ20dDOEla/nxNTL2TBfemO9D4l42SRsUawFHxUFbd6Fjiw+ CpmcgPvFu5aUejmFEXim6HLas6SsTU8hN+5k/XacDVeo85WzOeNa73LJXhrrIsJW feyCxW2H0hIDYQa5FkXG6Bvbp1Y+hXg/fqSFF9qtiYAZhSIEuKdFmT0Xdv3FIFEH JDKM3RG3R38jaKPEqq8NVdYBZYCOd2Awtx7PJj1pvdgIMNqvMjzpI7ZsA3O4RsdO cluS/HLK2KEqw5eMRmGSrhzWyaGGIktCH9It1XQdXsOj/5rfhpNhs2m+pDXuk4Oh LtPP+2HIkjB4ogj1SgrUCb3JAxTzE1FcX4tsRCzXGaDdkkBlaWPtznFHWVxbImtZ tCDSroiYEKl2uQINBF+8drsBEADfkSMaIwSkpJsHvqwwxWaEXNQdCrmV+i24GHI9 LOoClsDZtZ0XJcJbusu1qn14IkHQUp1nXrB73+7me+NeuT+OXZCoLwh7Fp5kwEOw PMZk9yXcl9vAeGEjwIYm7zmTEzDpVZCdKpfdhL1HIcmMCVf3WIzjLhaV0R39WZdM QH0YoumXXLujubHnlg4BESoc3gRjHuVfp1PqFfYbY0wWLAhAP5zE6HrqyMWOlETA t93ESupv4yLbe/amO3D44oPNOCzel6bCjvyRC6V5T2ZcH44Y/wrQ1VzkE3RwvQG7 h7Pc37yTPaKAxIZYRIZluaF7rn0hnYZdc8//Ddp1cTAX9RRiKovx4vGp+9EA+Cue eAwmY9r20gO8hDP/YVhvg0v5PvJBHbcR9prSEfzn02hqx90qxBysca/qHFwMmH1B sIn4wl0DD77S73XYc002N5OPvWCx1yOF02vkiq9Hj+HeXenkhYNvkzMqmfi0GGFS g8xRAbXpnMTJIdVnDdiCDsel3EYjiynAoGO/ggpFYz8dn5i06sj/ypNfiXKb9OYD C+UPRfPGE58wLC16uLvnsJD4lx81KPtSgO7DRvTlq/B3xpc32yqTg5EZ6YLh3YH9 m3cT7hLHD+7CTU5kWDoEHcs0DQYBbFsf/cvQCJnSIOMmpDIQ7P5Z/QTNEVy6fsZc 2SK4zQARAQABiQI2BBgBCAAgFiEEJkmJ9B7aUHu/f9KjOcBV9uJhd0EFAl+8drsC GwwACgkQOcBV9uJhd0F+Kg//awvCFu+0KloMSGC7XYSTns1auM5NmTT92phZGpvo hjctNYiijYfI0khplzcvE4Z03W0VtfHjvo9HDEOM+LPLcpkwJJcb5IKpUr1xyGnm THbch88o26KIq4kianoBPdxYZrQHKYADYHCB8FZ7BttOrLB+jwJuyWYjtpLiznki yRV/UmN/ou0UJc8vnjxkmTLXnjlbMYJ0LJKhHmiTLLGX+xXRIWK6FzZ+bBGqaVkz WlPbnZxq2rPITkKZrw1PUHMTPZwuKaHxKswyQamcIn1Ejq2kL0D2OJkzmK7wR9xr +w/CHQGpNbN1hwDtmM8Pi1UHSAnImxQab2gp9WvVkPBb2Skk+X8J5r23xzLSlU+1 9kRx8Tzvw0Zim5dQpxpk22aBoRvatFT003UcqSJtNDDbqsIGg5DgeSVC7al4/gli oQrxgJEreMBccsupSuCsDyFZI1DgXsfDD+j1fXUSWvfvhPdtMNcnTu2zoO3eHISB MplqnLIAfVNqR0ZBoiEnGZ5UKz4pTqkHU/YRJQFmV3NUmAKjYIzoZEbIF+FMDjcA GXsUGHi2q1GRyNw9967Xh9r6ohyj2g5CQqfvD/JREUnkYNeoc9FNORqC5hiQ8wes pFvzCLb6D7FZ7/tBh0NOESTOi9NF9vUpZHR1ZLnXrtQ8BSPy0zzLUWiCAVWJGLjg ujs= =ZqGy -----END PGP PUBLIC KEY BLOCK----- tomboy-ng_0.39-1/Deb_SRC.readme0000644000175000017500000001143514551457644016023 0ustar dbannondbannonSteps to build Debian Source Package for tomboy-ng. --------------------------------------------------- You need two files to start. The tomboy-ng-master.zip file and the script, prepare.bash. WHAT does prepare.bash do ? --------------------------- Firstly, prepare is NOT required when rebuilding either binary or src packages. Prepare takes a zip file (github sends us a zip file), unzips it, removes some unnecessary files, downloads KControls source, again removes some unnecessary files, makes some changes according to desired widget set and then creates the corresponding .orig.tar.gz file. Dependancies ---------------- You should already have FPC and Lazarus installed. And the tomboy-ng build dependencies, gtk2-dev, libnotify-dev etc. If you just want to make a binary thats all you need. If you are making a deb or a deb src package, you will need the devscripts package installed and some config, such as - * In ~/.devscripts.conf a line defining the GPG key you will sign with. eg DEBSIGN_KEYID=your-key-fingerprint Note : while it says 'keyid' its happier with the full fingerprint. * Edit the prepare script so that DEBEMAIL and DEBFULLNAME match the key. $DEBFULLNAME <$DEBEMAIL> must look exactly like the key's version. The process ----------------- Download the tomboy-ng zip file from github - wget https://github.com/tomboy-notes/tomboy-ng/archive/master.zip mv master.zip tomboy-ng-master.zip Note : clicking the Github tomboy-ng page's Code -> Download Zip from github will get you the file called tomboy-ng-master.zip however, wget gets a master.zip and that must be renamed. You can now extract the prepare.bash script from the zip file or, perhaps easier download it from the github tomboy-ng page, browse to prepare.bash, click the "raw" button, right click, save_as. The prepare script will unzip the zip file, download kcontrols and insert its source into the working directory, leave some semophores for the buildit.bash script about where your FPC and Lazarus is (if you have them in user space, not needed if installed in root space). It then creates a .orig.tar.gz file that becomes the reference for the deb source package. Note that the .orig.tar.gz file's content must be identical to the working directory at this stage, the build process will fail if you change anything in working dir after the .orig.tar.gz file is created. If you need to change things, perhaps you are going to sign with your key (you cannot use mine!) or you wish to change build target or dependencies for example, give the prepare script a -p option, it will pause before making the .orig.tar.gz file. cd into the working dir, its called tomboy-ng_{$VER-1}. And do one of - * If you just want the binary, run bash ./buildit.bash no signing needed and you will find the binary down in the source directory. * If you want a binary deb, you must have devscripts installed, and some config things, you should have changed the prepare script wrt your own gpg key. In the working directory, run debbuild -us uc The binary dep will appear (along with src files) in directory above. * If you are going to build a full deb src package, to eg submit to a PPA then first check its building OK with above step then run debuild -S you will be asked sign it and it will leave the necessary files in the directory above. cd up and make sure you see a tomboy-ng_{$VER-1}_source.changes file. Run - dput ppa:d-bannon/ppa-tomboy-ng tomboy-ng_0.29e-1_source.changes [enter] Note : pretty obviously, you won't be submitting to my PPA so change it. Options to prepare.bash ------------------------ WIDGET SET The default widget set is GTK2, pass -Q to prepare.bash and you will get Qt5 BUILD TIME CHANGES Pass -p to prepare.bash and it will pause just before creating the .orig. file then, in another terminal you can alter the tree. Useful to add extra info in the changelog, the target system, dependancies etc. CLEAN or UPDATE There are two options that were used during development, likely of no use to most other people. USING LOCALLY BUILT LAZARUS / FPC In fact, you need only lazbuild and lcl (make lazbuild; make lcl). Many Lazarus users (sensibly) build their own from source, but that leaves them with Lazarus not findable using the core system path that debuild uses. Similarly, fpc can be installed direct from SourceForge tarballs. The prepare script will find your tarball FPC (as long as it is on your full path) but not Lazarus. So, put a full path to lazbuild with the option -l and prepare.bash will leave 'semophores' for the build process to find fpc and Lazarus. debuild will object as it does not find Lazarus in the apt database, pass it -d and all will be well. Please report any issues at https://github.com/tomboy-notes/tomboy-ng David Bannon, August 2020 tomboy-ng_0.39-1/whatsnew0000644000175000017500000000017314551457644015223 0ustar dbannondbannonFix to UTF8 bug in note title affecting links. Avoid Wayland, it cannot bring a window to foreground, report on position. tomboy-ng_0.39-1/README.md0000644000175000017500000000353214551457644014721 0ustar dbannondbannon### tomboy-ng tomboy-ng is a note taking app that works and syncronises between Linux, Windows and MacOS. It will also Sync to a private Github repository allowing access to any device with a browser. It features a rich text markup, printing, spell check, backup and snapshot capability. Undo and Redo. Import and export (plain text, RFT, MarkDown). It has Tomboy's automatic linking between notes, searching abilities, NoteBooks and a similar interface. Change a note's title by just editing the title in the edit window. Importantly, tomboy-ng has no awkard dependancies and so is an easy and lightweight install. It is easily installed for Debian Bullseye and its derivatives directly from the Debian Repositories or you can download a (possibly more current) install kit for other Linuxes, Windows or MacOS from here. You are, of course, welcome to build from source. Download from the [Wiki Download Page](https://github.com/tomboy-notes/tomboy-ng/wiki/Download_Release) Also available is [TomboyTools](https://github.com/davidbannon/TomboyTools) it provides a means to import or export notes individually, as members of a Notebook or in a directory. A range of formats include Markdown, plain text, HTML (following tomboy style links) and Man Page.

Please see the [Wiki](https://github.com/tomboy-notes/tomboy-ng/wiki) for further information. We use GitHub to store sources and track bugs, see [Tomboy](https://github.com/tomboy-notes/tomboy-ng). There is also a tomboy-ng page as part of the Tomboy homepage [here](https://wiki.gnome.org/Apps/Tomboy). Copyright (C) 2018,2019,2020,2021 David Bannon --- tomboy-ng_0.39-1/buildit.bash0000755000175000017500000002733714551457644015751 0ustar dbannondbannon#!/bin/bash # copyright David Bannon, 2019, 2020, use as you see fit, but retain this statement. # # A script to build tomboy-ng from source without using the Lazarus GUI # # tomboy-ng depends directly on fpc, lazbuild, lcl and kcontrols. Because the # package based install of fpc/lazarus is quite different to the popular # installs in user space, we need to allow for both. debuild does not pass the # user's PATH through so we need to allow for those user space installs. # * We expect to find FPC (3.2.0 or later) preinstalled. Either on a path # indicated by the file ../WHICHFPC or PATH. Only the ../WHICHFPC method will work # if its installed in user space, fpc is not passed through the SRC Deb tool chain. # * Lazarus, must find lazbuild, first tries ../WHICHLAZ, then PATH. # If lazbuild is in root space, then lcl is # probably pointed to by /etc/alteratives/lazarus. If its user space, then # we can assume lcl is in the same place as the lazbuild command itself. # * KControls is bundled into the deb source kit by prepare script, its not # present in the github zip file where tomboy-ng calls home. If building # from a SRC Deb kit, kcontrols is already in the 'orig' tarball. # While really intended to be part of a tool chain to build a Debian Source # package, its useful as a standalone build tool if all you want is the binary. # # This script runs in the upper tomboy-ng source tree (level with, eg Makefile). # The files, WHICHFPC and WHICHLAZ are in the directory above, while they can # created by hand, the script, prepare.bash will also do so if necessary. # The prepare script will take a github zip file, unpack it, add kcontrols # and create the necessary ../WHICH* files if it can. # Its necessary to call fpc directly here, lazbuild will not help us because kcontrols # is not in the location that the project file expects it to be. lazbuild does not # have an option to add an arbitary extra package location. # 2021-10-30 Added paths to lazarus unit src in case obj need rebuilding # 2021-12-15 Make a guess where Lazarus units are on non-Debian (ie without /etc/alternatives) # This is where I keep tarballs and zips to avoid repeated large downloads. MYREPO="$HOME/Documents/Kits" # set an alterantive with -r LAZ_VER="trunk" # an alternative is lazarus-2.0.10-2 LAZ_INT_NAME="blar" #CPU="x86_64" # default x86_64, can be arm CPU=$HOSTTYPE # might return i686, we change to i386 OS="linux" PROJ=Tomboy_NG # the formal name of the project, it's in project file. START_DIR=$PWD SOURCE_DIR="$PWD/source" TARGET="$CPU-$OS" K_DIR="$PWD/kcontrols/packages/kcontrols" WIDGET="gtk2" # either gtk2 or qt5 TEMPCONFDIR=`mktemp -d` # lazbuild writes, or worse might read a default .lazarus config file. We'll distract it later. EXCLUDEMESSAGE=" -vm6058,2005,5027 " # cut down on compiler noise # 6058 - note about things not being inlined # 5027 - var not used # 2005 - level 2 comment FPCHARD=" -Cg -k-pie -k-znow " AUTODOWNLOAD=FALSE # downloading large file, use -d to allow it # ------------------------ Some functions ------------------------ function ShowHelp () { echo " " echo "Assumes FPC of some sort in path, available and working, ideally 3.2.0." echo "Will look for Lazarus and KControls kits in repo, or download to it." echo "David Bannon, July 2020" echo "-h print help message" echo "-c specify CPU, default is $HOSTTYPE - supported x86_64, i386, arm" echo "-Q build a Qt5 version (default gtk2)" echo "When used in SRC DEB toolchain, set -c (if necessary) options in the Makefile." echo "" exit 1 } # Looks to see if we have a viable fpc, exits if not function CheckFPC () { if [ -f "../WHICHFPC" ]; then # If existing, the msg files take precedance COMP_DIR=`cat ../WHICHFPC | rev | cut -c -4 --complement | rev` if [ ! -x "$COMP_DIR""/fpc" ]; then echo "Sorry, WHICHFPC is not a viable compiler" echo "--------------------- EXITING ---------------------" exit 1 fi PATH="$COMP_DIR":"$PATH" export PATH else # OK, is it on path ? This won't work in SRC Deb mode if its installed in user space COMP_DIR=`which fpc | rev | cut -c -4 --complement | rev` if [ ! -x "$COMP_DIR""/fpc" ]; then echo "Sorry, not finding a viable compiler" echo "--------------------- EXITING ---------------------" exit 1 fi fi COMPILER="$COMP_DIR""/fpc" # we will need that later } # looks for a lazbuild, first in WHICHLAZ, then in PATH, failing exits. function CheckLazBuild () { if [ -f "../WHICHLAZ" ]; then LAZ_DIR=`cat ../WHICHLAZ | rev | cut -c -9 --complement | rev` if [ ! -x "$LAZ_DIR""/lazbuild" ]; then echo "Sorry, WHICHLAZ is not a viable lazarus install" echo "The path and 'lazbuild' is required" echo "--------------------- EXITING ---------------------" exit 1 fi PATH="$LAZ_DIR":"$PATH" export PATH else LAZ_DIR=`which lazbuild | rev | cut -c -9 --complement | rev` fi if [ ! -x "$LAZ_DIR""/lazbuild" ]; then echo "---------- ERROR, cannot find lazbuild ----------" exit 1 fi # if LAZ_DIR starts with /usr then its installed in root space and we should # assume that the lcl components are not 'along side' lazbuild. In fact # might be somewhere like /usr/lib/lazarus/2.0.8, should we assume its # /etc/alternatives/lazarus ? PREFIX="${LAZ_DIR:0:4}" if [ "$PREFIX" = "/usr" ]; then LAZ_DIR="/etc/alternatives/lazarus" # but thats wrong on non debian things, ones without the silly /etc/alternative if [ ! -d "$LAZ_DIR" ]; then LAZ_DIR="/usr/lib/lazarus" FPCHARD="" # probably an OS that does not want hardening if [ ! -d "$LAZ_DIR""/lcl" ]; then echo "==================== SORRY, cannot find lazarus/lcl dir" exit 1 fi fi fi } # We default to GTK2 but if a file is left in working dir called # Qt5 then we build that. Note a -q does the same thing. function CheckForQt5 () { if [ -f "Qt5" ]; then WIDGET="qt5" fi } # ------------ It all starts here --------------------- while getopts "hQc:" opt; do case $opt in h) ShowHelp ;; c) CPU="$OPTARG" TARGET="$CPU-$OS" ;; Q) WIDGET="qt5" ;; \?) echo "Invalid option: -$OPTARG" >&2 ShowHelp ;; esac done if [ "$CPU" = "i686" ]; then CPU="i386" fi if [ "$CPU" = "powerpc64le" ]; then # power does not like intel switches ! FPCHARD=" " fi TARGET="$CPU-$OS" CheckFPC CheckLazBuild CheckForQt5 # OK, if to here, we have a fpc and lazbuild, but which FPC ? FPCVERSION=$($COMPILER -iV) if [ "$FPCVERSION" = "3.0.4" ]; then echo "Sorry, need a later version of FPC later than $FPCVERSION" exit 1 fi #case $FPCVERSION in # 3.0.4) # echo "Compiler reported [$FPCVERSION]" # echo "FPC 3.0.4 is no longer suppoted by tomboy-ng ..." # exit 1 # # EXCLUDEMESSAGE=" -vm2005,5027 " # ;; # 3.2.0 | 3.2.2 | 3.2.3 | 3.2.4 | 3.2.5 | 3.2.6 ) # untested with > 3.2.3 # EXCLUDEMESSAGE=" -vm6058,2005,5027 " # ;; # *) # echo "Compiler reported [$FPCVERSION]" # echo "Unclear about your compiler, maybe edit script to support new one, exiting ..." # exit 1 # ;; # esac # OK, lets see if we can build KControls at this stage. # These are paths to Laz unit's source, needed if units need to be rebuilt, eg new compiler LAZUNITSRC=" -Fu$LAZ_DIR/lcl -Fi$LAZ_DIR/lcl/include -Fu$LAZ_DIR/components/lazutils -Fu$LAZ_DIR/lcl/widgetset " LAZUNITSRC="$LAZUNITSRC -Fu$LAZ_DIR/components/printers -Fi$LAZ_DIR/components/printers/unix " LAZUNITSRC="$LAZUNITSRC -Fu$LAZ_DIR/components/printers/unix -Fu$LAZ_DIR/components/cairocanvas " LAZUNITSRC="$LAZUNITSRC -Fu$LAZ_DIR/lcl/interfaces/$WIDGET -Fu$LAZ_DIR/lcl/forms -Fu$LAZ_DIR/lcl/nonwin32 " LAZUNITSRC="$LAZUNITSRC -Fu$LAZ_DIR/packager/registration " K_DIR="$PWD/kcontrols/source" cd "$K_DIR" # WARNING, kcontrols is not part of the github zip file, its added by prepare.bash # Here we build just the kmemo.pas part of kcontrols. mkdir -p "lib/$TARGET" # this is where kcontrols object files end up. rm -f "lib/$CPU-$OS/kmemo.o" # make sure we try to build a new one, but probably not there. FPCKOPT=" -B -MObjFPC -Scgi -Cg -O1 -g -gl -l -vewnibq -vh- $EXCLUDEMESSAGES -Fi$K_DIR" FPCKUNITS=" -Fu$LAZ_DIR/packager/units/$TARGET -Fu$LAZ_DIR/components/lazutils/lib/$TARGET" FPCKUNITS="$FPCKUNITS -Fu$LAZ_DIR/components/buildintf/units/$TARGET -Fu$LAZ_DIR/components/freetype/lib/$TARGET" FPCKUNITS="$FPCKUNITS -Fu$LAZ_DIR/lib/$TARGET -Fu$LAZ_DIR/lcl/units/$TARGET -Fu$LAZ_DIR/lcl/units/$TARGET/$WIDGET" FPCKUNITS="$FPCKUNITS -Fu$LAZ_DIR/components/cairocanvas/lib/$TARGET/$WIDGET -Fu$LAZ_DIR/components/lazcontrols/lib/$TARGET/$WIDGET" FPCKUNITS="$FPCKUNITS -Fu$LAZ_DIR/components/ideintf/units/$TARGET/$WIDGET -Fu$LAZ_DIR/components/printers/lib/$TARGET/$WIDGET" FPCKUNITS="$FPCKUNITS -Fu$LAZ_DIR/components/tdbf/lib/$TARGET/$WIDGET -Fu. -FUlib/$TARGET" RUNIT="$COMPILER $EXCLUDEMESSAGE $FPCKOPT $FPCHARD $LAZUNITSRC $FPCKUNITS kmemo.pas" echo "--------------- kcontrols COMPILE COMMAND -------------" echo "$RUNIT" echo "-----------------" $RUNIT 1>tomboy-ng.log # exit if [ ! -e "$K_DIR/lib/$CPU-$OS/kmemo.o" ]; then echo "ERROR failed to build KControls, exiting..." K_DIR="" exit 1 fi cd "$START_DIR" VERSION=`cat "package/version"` echo "------------------------------------------------------" echo "OK, we seem to have both Lazarus LCL and KControls available : " echo "kcontrols = $K_DIR" echo "Lazarus = $LAZ_DIR" echo "Compiler = $COMPILER" echo "CPU type = $CPU" echo "tb-ng Ver = $VERSION" echo "Hardening = $FPCHARD" echo "Exclude = $EXCLUDEMESSAGE" echo "PATH = $PATH" echo "-------------------------------------------------------" # Test to see if we find the tomboy-ng source. if [ ! -e "$SOURCE_DIR/editbox.pas" ]; then echo "----------------------------------------------------------------" echo "Looked for [$SOURCE_DIR/editbox.pas]" echo "Not finding tomboy-ng source, exiting ...." echo " " ShowHelp fi # echo "In buildit.bash, ready to start building tomboy" >> "$HOME"/build.log cd $SOURCE_DIR # DEBUG options -O1, (!) -CX, -g, -gl, -vewnhibq OPT1="-MObjFPC -Scghi -CX -Cg -O3 -XX -Xs -l -vewnibq $EXCLUDEMESSAGE -Fi$SOURCE_DIR/lib/$TARGET" UNITS="$UNITS -Fu$K_DIR/lib/$TARGET" UNITS="$UNITS -Fu$LAZ_DIR/components/tdbf/lib/$TARGET/$WIDGET" UNITS="$UNITS -Fu$LAZ_DIR/components/printers/lib/$TARGET/$WIDGET" UNITS="$UNITS -Fu$LAZ_DIR/components/cairocanvas/lib/$TARGET/$WIDGET" UNITS="$UNITS -Fu$LAZ_DIR/components/lazcontrols/lib/$TARGET/$WIDGET" UNITS="$UNITS -Fu$LAZ_DIR/components/lazutils/lib/$TARGET" UNITS="$UNITS -Fu$LAZ_DIR/components/ideintf/units/$TARGET/$WIDGET" UNITS="$UNITS -Fu$LAZ_DIR/lcl/units/$TARGET/$WIDGET" UNITS="$UNITS -Fu$LAZ_DIR/lcl/units/$TARGET" UNITS="$UNITS -Fu$LAZ_DIR/packager/units/$TARGET" UNITS="$UNITS -Fu$SOURCE_DIR/" UNITS="$UNITS -FU$SOURCE_DIR/lib/$TARGET/" OPT2=" -dLCL -dLCL$WIDGET" DEFS="-dDisableLCLGIF -dDisableLCLJPEG -dDisableLCLPNM -dDisableLCLTIFF" # FPCHARD=" -Cg -k-pie -k-znow " # We must force a clean compile, no make looking after us here. # I have not found a way of telling the compiler to write its .o and .ppu files # somewhere else so not to compete with an existing Lazarus, but both this script # and Lazarus is quite happy to write new ones whenever needed. So, flush it clean. rm -Rf "lib/$TARGET" rm -f tomboy-ng rm -f "$PROJ" mkdir -p "lib/$TARGET" RUNIT="$COMPILER $OPT1 $FPCHARD $UNITS $LAZUNITSRC $OPT2 $DEFS $PROJ.lpr" echo "------------ tomboy-ng COMPILE COMMAND --------------------" echo "$RUNIT" TOMBOY_NG_VER="$VERSION" $RUNIT 1>>tomboy-ng.log if [ ! -e "$PROJ" ]; then echo "======================== ERROR, COMPILE FAILED source/tomboy-ng.log =====" cat tomboy-ng.log echo "=========================================================== END of LOG ==" exit 1 else cp "$PROJ" "tomboy-ng" fi exit 0 tomboy-ng_0.39-1/doc/0000755000175000017500000000000014551457755014207 5ustar dbannondbannontomboy-ng_0.39-1/doc/tomboy-ng.10000644000175000017500000002374414551457644016213 0ustar dbannondbannon.TH tomboy-ng .SH NAME tomboy\-ng \- manage a collection of notes using a simple GUI markup .SH SYNOPSIS tomboy\-ng [\-h \-\-help] [\-\-dark\-theme] [\-\-debug\-sync] [\-\-debug\-index] [\-\-debug\-log=LOGFILE] [\-l \-\-lang=CC] [\-\-config\-dir=PATH_to_DIR] [\-o PATH_to_NOTE] [\-\-open\-note=PATH_to_NOTE] [PATH_to_NOTE] [\-t \-\-import\-txt=PATH_to_FILE] [\-m \-\-import\-md=PATH_to_FILE] [\-n \-\-import\-note=PATH_to_NOTE] [\-\-title\-fname] .SH DESCRIPTION tomboy\-ng is a rewrite of the much loved Tomboy Notes. It runs on Linux, Windows and MacOS. It is file compatible with Tomdroid and GNote (>=v0.30). Tomboy\-ng notes support Bold, Italic, Strikethrough, Highlight and Underline in four sizes. It will sync notes with other systems using Tomboy's File Sync model and to remote servers using sshfs. It will Sync with a Github account, either all your notes or just ones in the SyncGithub notebook. You can edit notes, from almost any device with a browser in markdown format. tomboy\-ng has built in systems to take snapshots of your notes for safe keeping, to import and export notes in different formats, spell checking means to group your notes into "notebooks" for easy management. Many users will want to have tomboy\-ng start at logon time and leave it running indefinitly. When running, it will put an Icon in the System Tray and you can interact with it via that Icon. However, some Gnome 3 based Linux distros have problems initially with the System Tray Icon, on such limited systems, see the project wiki page mentioned below. On Windows and Mac tomboy\-ng uses native libraries, on Linux, tomboy\-ng comes in both GTK2 and Qt5 version and many systems have almost all the necessary libraries pre installed. While options below are familiar to Linux users, Mac and Windows users may like to look at some examples further down to see how to use them. .SH COLORS and DARK THEME The GTK2 version follows the system colour theme. However, the Qt5 version (eg Bookworm and later) requires some instruction from the user. Using the \-\-dark\-theme is the simplest and probably the least satisfactory approach, the note edit screen is a dark theme, other windows vary. Qt5 (and Qt6) versions after 0.36c install qt5ct (or qt6ct) and are installed with a environment variable applying to only tomboy\-ng. So, control your tomboy\-ng colours using qt5ct or qt6ct. You may like to install qt5\-style\-plugins package. If you start tomboy\-ng, perhaps on the command line, it will not see the env variable so either set it yourself, eg QT_QPA_PLATFORMTHEME=qt5ct, or supply a command line option, \-\-platformtheme qt5ct that does a similar but not quite as complete job. A more general solution, applying to all Qt5 apps, is to add that var to either /etc/environment (requires root) or, simpler in a .xsessionrc file in your home dir. cd ; echo "export QT_QPA_PLATFORMTHEME=qt5ct" >> .xsessionrc Probably need to log out and back in again. Note that with the Qt versions, setting platformtheme to gtk2 or gtk3 can cause problems, particularly with the SaveDialog (ie when exporting a note) due to an upstream problem. On Windows, tomboy\-ng will follow the system for Dark Theme but only for the note edit window. Using the \-\-dark\-theme switch is not recommended. On MacOS, tomboy\-ng is believed to follow the system theme. .SH OPTIONS .TP \-h \-\-help Print some help and exit. .TP \-v \-\-version Print the tomboy\-ng version and exit. .TP \-\-dark\-theme Makes the note edit windows a reasonable dark theme (but not the system theme). Other part of the app are not dark. This option may be removed in future releases. .TP \-\-no\-splash Do not show the small tomboy\-ng splash screen at startup. However, if an error is detected the splash screen is always shown. .TP \-\-lang=CC Tomboy\-ng normally picks up its language from the OS and does an auto switch. However, its possible to force a language at startup using the two letter language code, ie es for spanish, nl for dutch, fr for French and uk for Ukranian. If you would like to help translate tomboy\-ng, please, please get in touch. .TP \-c, \-\-config\-dir=PATH_to_DIR Create or use an alternative config. That config could, for example, specify an alternative location to store notes and sync against a different file sync repository. .TP \-o, \-\-open\-note=PATH_to_NOTE Open a note in single note mode. In this mode, a separate process runs, it does not have access to the normal notes location, nor sync but can read, display and write back to a stand alone note. If the note name does not exist, a new note is created. If the note name specifies a plain text file or a rtf file, the contents of that file will be imported into a new note and that note will be named as specified on the command line but with an extension of ".note". In this mode, the note remains in its existing location, it is not moved to the tomboy\-ng notes location, it is not synced, nor searched by tomboy\-ng in its normal mode. Note that the switch (\-o or \-\-open\-note) is optional, "tomboy\-ng some.note" will works as well. .TP \-t \-\-import\-txt=PATH_to_FILE Import the indicated plain text file into the Note Repository, converting it to note format. The first line of the file will be used as the title unless \-\-title\-fname is also specified in which case the file name will become the title. If another instance of tomboy\-ng is running, its notified of the import and the note will appear as the newest. .TP \-m \-\-import\-md=PATH_to_FILE Import the indicated markdown file into the Note Repository, converting it to note format. The first line of the file will be used as the title unless \-\-title\-fname is also specified in which case the file name will become the title. The conversion assumes a CommonMark version of markdown and not all aspects of even that are supported. If another instance of tomboy\-ng is running, its notified of the import and the note will appear as the newest. .TP \-n \-\-import\-note=PATH_to_NOTE Import the indicated Tomboy Note format file into the Note Repository, the note itself is not changed, its just copied in and, if necessary, a GUID style file name is assigned. The last change date of the note is retained. If another instance of tomboy\-ng is running, its notified of the import. .TP \-\-title\-fname Applies only when importing a text or markdown file, determines that the filename will be used as the note title instead of the default first line of the file. .TP \-\-debug\-sync \-\-debug\-index \-\-debug\-spell Generate a lot of logging information on the console during a sync, index or spell process, each one relating to a particular field. You can combine or even use all three. Intended for debugging. The debug information is written to the console in Linux and can be captured to a file on all platforms, see below. .TP \-\-debug\-log=LOGFILE Direct debug info to a file, this is necessary to see that output on Windows and Mac and sometimes useful on Linux. LOGFILE is a filename and a (writable) path to that filename. See section below on debugging. .TP \-\-useappind=yes|no Only for Linux using gtk2 version. Will override tomboy\-ng decision about how to try to display the System Tray Icon, its here to help with difficult systems that cannot seem to display that icon using the normal approach. .TP \-\-platformtheme qt5ct Use with Qt versions ONLY, will instruct the app to display the colors defined in qt5ct. The qt5ct app has a nice GUI where you can select the colors that suite you. Some other Qt specific options may also work using a similar syntax. Note there is not an '=' sigh between the switch and its parameter. .SH FURTHER HELP tomboy\-ng comes bundled with several read only notes that provide help on topics such as keyboard short cuts, setting up a sync system, using the built in calculator and keeping your notes safe. The project's wiki also has extensive information available. https://github.com/tomboy\-notes/tomboy\-ng/wiki .SH DEBUGGING tomboy\-ng generally does not write debug output unless something has gone wrong but it does accepts a couple of debug switches as noted above. They will cause detailed progress reports relating to their section of the application to be written to the console. However, Windows and Mac do not, for this purpose, have a console. But can be told to capture this log info to a file using another command line switch or by setting an env variable that specifies a file name. Please ensure you have permission to write to the location specified. tomboy\-ng \-\-debug\-log=%userprofile%\\debug.txt \-\-debug\-sync set tomboy\-ng_debuglog=c:\\%userprofile%\\debug.txt Mac users can do something similar : open /Applications/tomboy\-ng.app \-\-args "\-\-debug\-log=$HOME/tomboy\-ng.log" "\-\-debug\-sync" Linux users who need a debug logfile can also : tomboy\-ng \-\-debug\-sync \-\-debug\-log=$HOME/tomboy\-ng.log Windows users should do something like this \- Rightclick the startbutton and select "run". In the field, enter this command line exactly as show (including the inverted commas) \- "C:\\Program Files\\tomboy\-ng\\tomboy\-ng.exe" \-\-debug\-index \-\-debug\-log=%userprofile%\\Desktop\\tomboy\-log.txt Press enter, tomboy\-ng should start up normally. Close it. A file called tomboy\-log.txt will have been created on your desktop. If you intend to post such a log file to (eg) the Tomboy help system, do please check through it first to ensure there is nothing there you don't want the world to see. .SH FILES On Linux, notes are stored (by default) in $HOME/.local/share/tomboy\-ng On Linux, config is stored (by default) in $HOME/.config/tomboy\-ng .SH SEE ALSO https://github.com/tomboy\-notes/tomboy\-ng There you will find several wiki pages going into far more detail than here. You may also be interested in TomboyTools, an addition application that allows inport and export in a range of formats. This man pages was built using TomboyTools. https://github.com/davidbannon/TomboyTools .SH BUGS Please send bug reports to the tomboy\-ng Github Issues system, see above. tomboy-ng_0.39-1/doc/authors0000644000175000017500000000167514551457644015625 0ustar dbannondbannonAuthors ======= tomboy-ng is built using - The Free Pascal Compiler and Lazarus, http://wiki.freepascal.org KControls - http://www.tkweb.eu/en/delphicomp/kcontrols.html, https://github.com/kryslt/KControls Much thanks due to the authors and developers of the above. Thanks are also due to the many people involved with the FPC/Lazarus Forum without who's help and patience this project would not have every got off the ground. The user interface and design of Tomboy, indeed, the very idea, is a product of the origional Tomboy authors, see - https://wiki.gnome.org/Apps/Tomboy tomboy-ng is primarily written by David Bannon, tomboy-ng@bannons.id.au Contributions made by Benjamin Brandall - me@benj.email Icons by XYPD, xypd.com Translations by Roy Reese (much gramatical work and Spanish), Andrij Mizyk (Ukrainian), Francois Edelin (French) and Heimen Stoffels (Dutch). Libnotify unit by Ido Kanner, https://github.com/ik5/libnotify-fpc tomboy-ng_0.39-1/doc/es_notes.zip0000644000175000017500000000171614551457644016554 0ustar dbannondbannonPKtS-wx$io.github.tomboy-notes.tomboy-ng.ymlTK0>_a!=mI)!U=n&v_.o3chQ麦ʗqJ2f?pViT|7BV`oz]-dF>lYaVkV0h7_]S5%@[BU CNjD~dUD*FP+R-$ Bk砦1S 5GZSt9!zG VյVʒ@%5 sIV],X,a\seddγ4xXQEDH8[8Xkj9!t>/rԗ8;jr$2*҈(W>(#.èĊ&Y)i\%_Dt^Dw&/]'}}b&:Ouk[XY7˻ i NiK Ayuda de tomboy-ng Ayuda de tomboy-ng Tomboy-ng es una refundición del querido programa Notas Tomboy. Funciona en Linux, Windows y MacOS. Es compatible con los archivos de Tomboy y GNote. Tomboy-ng notas permiten letras Negritas, Cursivas, Tachadas, Resaltadas y Subrayadas en cuatro tamaños, pequeña, normal, grande y enorme. Puede sincronizar las notas con otros sistemas utilizando el modelo de sincronización de Tomboy y/o una sincronización por red usando GitHub. GitHub le permite leer o editar sus notas online desde un navegador. Muchos usuarios querrán tener tomboy-ng iniciarse al acceder al SO. La aplicación pondrá un icono en la bandeja de sistema que se puede usar para interactuar con ella. Sin embargo, para asegurar que tenemos soporte para algunas plataformas difíciles, se abre una pequeña ventana también que se puede despachar si ve el icono en la bandeja de sistema (o en algunos sistemas de Gnome 3, la ha añadido a su dock como favorito). Puede elegir no mostrar la ventana pequeña al menos que no haya una nota corrompida al iniciar. Usando tomboy-ng Puede interactuar con tomboy-ng a través de un menú en la bandeja de sistema (en algunos sistemas) o el menú que aparece en todas las ventanas principales del programa. Si no tienes un icono en la bandeja de sistema (¡que triste!), añada tomboy-ng a los favoritos que aparecen en su dock y, de esta manera, puedes iniciarlo o despertar la ventana de búsqueda fácilmente. Desde la ventana de búsqueda, puede: Acceder al menú principal (Nota Nueva, Preferencias, notas recientes, etc.). Buscar términos en todas sus notas. Un término de búsqueda como Juan García nombre encontrará todas las notas con la palabra nombre en cualquier sitio, y tienen la combinación exacta de Juan García. No encontrará, por ejemplo, mi nombre es García, Juan. Organizar sus notas en cuadernos. tomboy-ng permite que cada nota puede aparecer en más de un cuaderno, pero si sincroniza o comparte las notes con el original Tomboy, no uses esa función. Renombrar un cuaderno, pero si sincroniza sus notas, ¡haga una sincronización completa primero! En general tomboy-ng: guarda notas automáticamente al hacer cambios. le permite cambiar el título de una nota en la ventana de la nota. hace copias de seguridad de notas eliminadas. Si necesita saber que una nota se ha eliminado de verdad, vaya a Preferencias-->Copia de Seguridad. tiene funciones para hacer instantáneas de sus notas de vez en cuando. ¡Utilícelo, por favor! puede sincronizar sus notas con un almacén de archivos común para que estén disponibles de equipos múltiples (Linux, Windows o Mac). no comparte bien. Si guarda sus notas en un disco compartido (sin usar sincronización), tenga muchísimo cuidado de no tener más de una instancia de tomboy-ng o Tomboy ejecutándose al mismo tiempo. Ocurren cosas malas. Parámetros de la línea de comandos. -h, --help Mostrar la ayuda y salir. -l CCode --lang=CCode Forzar idioma: códigos de idiomas soportados: es, fr, nl, y uk. Díganos si quiere tomboy-ng en otro idioma. --version Imprimir el número de versión y salir. --no-splash No mostrar la pequeña ventana de bienvenida. Le ahorra el trabajo de despacharla después del inicio. No lo use al menos que haya comprobado que se pueda ver el icono en la bandeja de sistema. --config-dir=PATH_to_DIR Crear o usar una configuración alternativa. Principalmente una opción para pruebas, pero útil si, por ejemplo, quiere tener dos (o más) grupos de notas independientes (pero no concurrentes). --debug-sync --debug-index ---debug-spell Mostrar lo que pasa durante una sincronización, indización o revisión ortográfica. Útil para depuración. Estos parámetros escribirán al terminal informes de progreso detallados con relación a las funciones respectivas de la aplicación. Sin embargo, Windows no tiene un terminal con este fin. Sin embargo, se puede dirigir esta información a un archivo de registro usando otro parámetro de la línea de comandos o estableciendo un variable ENV que especifica un nombre de archivo. Asegúrese, por favor, que tenga el permiso para escribir a la ubicación dada. Por ejemplo, desde el botón de inicio, haga clic en ejecutar y teclee: tomboy-ng --debug-log=c:\debug.txt --debug-sync --open-note=PATH_and_Name_to_NOTE Abrir una nota en el modo de nota simple. En este modo, un proceso independiente se ejecuta que no tiene acceso a la ubicación usual de las notas ni a la sincronización, pero que se puede leer, visualizar y escribir o exportar una sola nota. Si el nombre de la nota no existe, se crea una nueva. Si el nombre de la nota especifica un archivo de texto plano o rtf, los contenidos del archivo serán importados a una nota nueva y la nota tendrá el nombre especificado en la línea de comandos, pero con la extensión .note. En este modo la nota se queda en la ubicación donde estaba (o, para notas nuevas, donde se especifica en la línea de comandos). No se traslada a la ubicación de las notas tomboy-ng, no se sincroniza, ni se busca con tomboy-ng en el modo normal. Téngase en cuenta que el parámetro (-o o --open-note) es opcional; tomboy-ng some.note funciona también. --save-exit Funciona solamente en el modo de nota única e importará el archivo (.note, .rtf, texto plano), convertirá al formato .note (y el formato estándar del nombre de una nota) y lo guardará en el directorio de notas dado en la configuración. Útil para hacer scripts. --import-txt=FILE_NAME --import-md=FILE_NAME --import-note=FILE_NAME Al importar un archivo de texto, markdown o note al repositario de notas por defecto, se detecta en el tomboy-ng ejecutándose y aparece en la Lista de búsqueda. En cada case, el FILE_NAME es una ruta completa y el nombre de archivo, al menos que ya está en de directorio actual. Tenga en cuenta que -t, -m y -n funcionan igual. --title-fname tomboy-ng usa el nombre de archivo como título de la nota solamente al importar a repositorio de notas un archivo que no sea de tipo .note. Cosas de Mac Usuarios de Mac necesitan una línea de comandos un poco más complicada al usar cualquier de estos parámetros. Por ejemplo, una línea de comandos para generar un registro de depuración de una sincronización sería: open tomboy-ng.app --args --debug-log=$HOME/tomboy-ng.log --debug-sync Y, como consecuencia de la metodología .app, hay que usar rutas absolutas para los parámetros, o, $PWD relativo al directorio actual: open tomboy-ng/tomboy-ng.app --args -o $PWD/doc/tomboy-ng.note 2022-10-23T12:21:45.7101642+02:00 2022-10-23T12:21:45.7101642+02:00 2018-11-07T16:01:06.6550000+11:00 1 1 695 505 479 58 False tomboy-ng_0.39-1/doc/HELP/ES/calculator.note0000664000175000017500000000720114551457644020265 0ustar dbannondbannon Calculadora tomboy-ng Calculadora tomboy-ng Versiones de tomboy-ng después de V0.20 incluyen una calculadora. Tiene tres modos básicos, todos activados al pulsar Ctrl-E (o Cmd-E en el Mac). Modo Simple, por ejemplo, escriba 6+10= y pulse Ctrl-E y tomboy-ng mostrará '16' después del signo igual. Funcionará con cualquier cálculo básico, (5*7)/(8.3+12)-0.724=1.000 En este modo, puede usar números, paréntesis, el "." (en vez de la coma) para delimitar décimos y los operadores + - / * y ^ (es decir, potencia). Modo complejo, si necesita usar, por ejemplo, funciones trigonométricas, el Modo Simple no encontrará su expresión completa. Por lo cual, escriba la expresión, selecciónela y entra Ctrl-E de nuevo. Resultado similar. En este modo puede usar los operadores mencionados arriba, más pi, cos, sin, tan, arctan, abs, sqr, sqrt, exp, ln, log, frac, int round y trunc. ej., sin(0.5)^2 + cos(0.5)^2 =1 Modo Columna, sumará una columna de números en las líneas justo encima del total. En este caso, 'una columna' significa todos los números al principio o al final de las líneas. Si hay números tanto al principio como al final, la columna más larga prima. Si tenemos el mismo número de datos en la primera y última columna, la columna a la izquierda prevalece. La primera línea encontrada que no tiene un número en el extremo apropiado (principio o final) hace parar el cálculo. Acuérdese de que un número que es el único dato en una línea se puede considerar como en el principio o el final de la línea. Puede impedir que un número se incluya 'escondiéndolo' con un carácter alfa, quitando el carácter después de hacer el cálculo. En este modo solamente se permiten números y el delimitador de décimos, ".". Casa a Axedale 5.5 Axedale a Bendigo 19 Bendigo a casa por O'Briens Road 23 ida y vuelta = 47.500 5 [algún texto] 7 1 [más texto] 3 [texto] 4 9 En el segundo ejemplo, se usa la columna izquierda porque tiene tres números elegibles. La columna derecha tiene solamente uno (el '4') dado que no hay ningún número al final de la línea "1 [más texto]". texto 7 1 más texto 4 3 14 En esta ejemplo, la calculadora ha elegido los números al final de las líneas porque hay más al final. 7+4+3=14 tome nota que el número '3' se puede considerar en la primera columna y la columna final. La calculadora usa números de coma flotante donde haga falta y se muestra el resultado con 3 dígitos después del decimal ".". Sin embargo, los cálculos internos se hacen con mucho más precisión. Tome nota que en los ejemplos citados arriba, he puesto los resultados en negrita para claridad. No se ocurre automáticamente. 2021-07-19T12:14:41.2452799+00:00 2021-07-19T12:14:41.2452799+00:00 2019-01-15T21:32:06.9620000+11:00 1 1 1000 626 20 29 False tomboy-ng_0.39-1/doc/HELP/ES/key-shortcuts.note0000664000175000017500000001457014551457644020767 0ustar dbannondbannon Atajos de teclado de tomboy-ng Atajos de teclado de tomboy-ng Todas los sistemas Alt-FlechaDerecha : Activar viñeta o añadir una con más sangría Alt-FlechaIzquierda : Desactivar viñeta o reducir la sangría Ctrl-1 : Fuente pequeña Ctrl-2 : Fuente normal Ctrl-3 : Fuente grande Ctrl-4 : Fuente enorme Mayús-FlechaDerecha : extender el texto seleccionado por un carácter hacia la derecha Mayús-FlechaIzquierda : extender el texto seleccionado por un carácter hacia la izquierda Mayús-Clic : Seleccionar texto entre posición actual y posición del clic Windows / Linux Ctrl-Q : Salir de tomboy-ng - En Búsqueda, Preferencias o cualquier Nota Abierta Ctrl-N : Nota nueva - En Búsqueda, Preferencias y cualquier Nota abierta Ctrl-X : Cortar el texto seleccionado y copiarlo al portapapeles Ctrl-C : Copiar el texto seleccionado al portapapeles Ctrl-V : Pegar el contenido del portapapeles en la nota actual Ctrl-A : Seleccionar todo Fin or Fn-FlechaDerecha : ir al final del renglón Fin or Fn-FlechaIzquierda : ir al inicio del renglón Ctrl-FlechaDerecha : Mover al principio de la palabra a la derecha Ctrl-FlechaIzquierda : Mover al principio de la palabra a la izquierda del puntero Ctrl-Mayús-FlechaIzquierda : extender el texto seleccionado por un carácter hacia la izquierda Ctrl-Mayús-FlechaDerecha : extender el texto seleccionado por un carácter hacia la derecha Ctrl-Z : Deshacer Ctrl-Y : Rehacer Ctrl-F4 : Cerrar la ventana de la nota actual Ctrl-D : Insertar fecha, AAAA-MM-DD hh:mm:ss Ctrl-L : Crear un enlace desde el texto seleccionado Alt-F4 : Cerrar la ventana de la nota actual (algunos escritorios de Linux) Fuentes Ctrl-B : Negrita Ctrl-I : Cursiva Ctrl-S : Tachado Ctrl-U : Subrayado Ctrl-H : Resaltado Ctrl-E : Calculadora - Vea la nota de ayuda sobre la calculadora Buscar (en una nota) Ctrl-F : Buscar algo en una nota F3 o Ctrl-G : Buscar siguiente instancia Mayús-F3 o Mayús-Ctrl-G : Buscar instancia anterior Mac Cmd-Q : Salir de tomboy-ng - En Búsqueda, Preferencias o cualquier Nota Abierta Cmd-N : Nota nueva - En Búsqueda, Preferencias y cualquier Nota abierta Cmd-X : Cortar el texto seleccionado y copiarlo al portapapeles Cmd-C : Copiar el texto seleccionado al portapapeles Cmd-V : Pegar el contenido del portapapeles en la nota actual Cmd-A : Seleccionar todo Cmd-FlechaDerecha : Ir al final de la línea Cmd-FlechaIzquierda : Ir al principio de la línea Cmd-Z : Deshacer Cmd-Y : Rehacer Cmd-D : Insertar fecha, AAAA-MM-DD hh:mm:ss Opt-Mayús-FlechaIzquierda - extender el texto seleccionado por un carácter hacia la izquierda Opt-Mayús-FlechaDerecha - extender el texto seleccionado por un carácter hacia la derecha Fuentes Cmd-B : Negrita Cmd-I : Cursiva Cmd-S : Tachado Cmd.U : Subrayado Cmd-E : Calculadora - Vea nota de ayuda sobre la calculadora. Opt-H : Resaltado Buscar (en una nota) Cmd-F : Buscar algo en una nota Cmd-G : Buscar siguiente instancia Mayús-Cmd-G : Buscar instancia anterior 2022-11-11T12:05:08.6697108+11:00 2022-11-11T12:05:08.6697108+11:00 2018-12-06T21:38:38.0650000+11:00 1 1 1000 626 142 95 False tomboy-ng_0.39-1/doc/HELP/ES/sync-ng.note0000664000175000017500000002176314551457644017523 0ustar dbannondbannon Sincronización de tomboy-ng Sincronización de tomboy-ng Esto trata de la sincronización de archivos entre equipos con Linux, Windows y Mac. Si le interesa en sincronizar a través de Github, que permite tanto la sincronización como acceso a sus notas online desde un navegador, vea https://github.com/tomboy-notes/tomboy-ng/wiki/Github-Sync Sincronizar sus notas tomboy-ng (y/o Tomboy) puede ser muy útil. Si lo hace bien, todas las notas en todos sus equipos serán las mismas. Y, además, tiene una estrategia para hacer copias de seguridad de las notas. ¡Acuérdese que el valor de sincronizar está relacionado con la frecuencia de que lo hace! tomboy-ng permite la sincronización de archivos. Es decir, que sincroniza utilizando un sistema de archivos compartidos (un repositorio). El sistema de archivos puede ser Google Drive, cualquier servidor remoto con lo que se puede comunicar con ssh, un disco local compartido o incluso un pendrive. Funciona de la misma manera entre las plataformas de Linux, Windows y Mac. Tome nota de que tomboy-ng (a diferencia de Tomboy) no conecta a un servicio de sincronización dedicado como Snowy, Rainy o grauphel/NextCloud/Apache. Nuevo a partir de v0.27, Auto-Sincronización, vea más abajo. Vale, antes de empezar, ¿guarda instantáneas? Si no, ¿¿¿por qué no??? Un sistema de archivos compartidos En la práctica, que sepamos, tomboy-ng sincronizará con cualquier sistema de archivos en lo que su administrador de archivos puede navegar. Podría usar Google Drive, Drop Box u otro sistema en la nube. Pero acuérdese que una copia de sus notas estarán en esos servidores y si no está conforme con que se pueden leer allí, tal vez ¡guardarlas allí no es muy buena idea! Puede que quiera compartir un repositorio a través de NFS o SMB. Windows y NFS no representan una buena combinación, pero SMB funciona bien para las tres plataformas. El router que tiene el autor en casa cuenta con una ranura USB detrás y un disco USB enchufado allí que está compartido a través de SMB. Ha funcionado sin fallo durante un par de años. Algunos gestores de archivos de Linux puede ponerle pegas en mostrar los archivos compartidos por SMB o Samba. Puede ser de ayuda de crear un marcador en el gestor de archivos principal, pero incluso si no funciona, asegúrese de tener instalados gvfs y gvfs-fuse y buscar utilizando el diálogo de directorios que abre tomboy-ng donde verá un archivo denominado más o menos: /run/user/1000/gvfs/smb_share ... O incluso podría usar un disco USB y enchufarlo en cualquier equipo que está sincronizando de momento. Vale siempre y cuando tomboy-ng puede leer y escribir allí. Una cosa de tener en cuenta: si piensas sincronizar ambos Tomboy y tomboy-ng con el mismo repositorio, Tomboy no es tan flexible con "cualquier sistema de archivos". Investíguelo antes de dedicar mucho tiempo en establecer el sistema. Crear un repositorio Fácil. Puede que sea una buena idea crear un directorio allí en el sitio compartido como "Tomboy-Sync" o lo que quiera. Simplemente hay que decir a tomboy-ng (o Tomboy) donde está el sistema de archivos y lo hará todo. En tomboy-ng, vaya a Preferencias, haga clic en la pestaña de Sincronización, y "Cambiar repositorio". Navegue al directorio que creó antes. tomboy-ng analizará el directorio y las notas (si las hay) y producirá un informe sobre lo que hará. Si le parece bien, haga clic en "Guardar y Sincronizar". Hecho. sshfs para sincronizar a través de una red tomboy-ng puede sincronizarse con cualquier servidor remoto accesible a través de ssh. El desarrollador emplea un plan de hosting barato con un sitio web poco usado y unos cuantos GB de espacio. Es útil porque ¡puedo comunicarme con ello por ssh! Por poder hacerlo así, puedo usar sshfs. Por ejemplo, en Linux, instalaría sshfs y como primer paso conectarme al servidor remoto con ssh y crear un directorio, por ejemplo, TB_Sync. Luego en el equipo local: cd; mkdir TB_Sync; sshfs minombre@servidorremoto.com:TB_Sync TB_Sync [intro] Abrir tomboy-ng y establecer el repositorio de sincronización a ~/TB_Sync, y ¡listo! Desconectar del directorio compartido con: fusermount -uz TB_Sync [intro] Y re-conectar más tarde para sincronizar de nuevo con sshfs minombre@servidorremoto.com:TB_Sync TB_Sync [intro] Sincronización manual y conflictos De vez en cuando tiene que hacer clic en la entrada del menú de Sincronización. Un informe breve aparecerá contando lo que ha hecho. Eche un vistazo y cierra el informe. Sin embargo, es casi seguro que llegará un momento en que haya cambiado una nota en más de un equipo después de la última sincronización. Triste, pero inevitable. Ahora, el motor de sincronización no sabe que hacer. Le mostrará una lista de diferencias entre las dos notas y puede elegir usar la versión local o remota. Remota significa la versión en el repositorio de archivos "remoto". Si, incluso después de ver las diferencias entre las dos versiones, no puede elegir, entonces tal vez debería elegir usar la versión remota. De esta manera la versión "local" se copiará a la copia de seguridad y puede recuperarla desde Preferencias-->Copia de Seguridad. Para resolver conflictos, también existen varios botones "hacer todo" que se aplicarán a los demás conflictos en la sincronización. Remota, local, la más nueva, la más vieja, si se siente valiente, haga clic en una. Sincronización automática Nuevo en v0.27, tomboy-ng sincroniza automáticamente en segundo plano. Obviamente ocurre solamente si tienes el proceso de sincronización configurado y el repositorio está disponible. Preferencias-->Sincronización y marque la casilla. Sincronizará unos 15 segundos después de arrancarse y luego cada hora. Si encuentra un conflictos entre dos versiones de una nota, la ventana normal aparecerá mostrándole las diferencias entre las dos versiones para que puedas decidir. Si no se puede sincronizar porque, quizás ha desconectado el repositorio compartido, una ventana emergerá para avisarle. Puede arreglar el problema y haga clic en "Intentar de Nuevo" o, si hace clic en "Cancelar", no se sincronizará hasta que reinicie tomboy-ng o alterne la opción de Auto-Sincronizar. Si usted, como yo, tiene que asegurarse que todo funcione, puede ver detalles de la sincronización más reciente en la barra de estado de la ventana de Búsqueda. Unirse de nuevo a un repositorio Tomboy tenía dificultades si quería unirse de nuevo a un repositorio que usaba antes. Veía muchas notas con el mismo identificador sin tener los datos del repositorio para saber como tratarlas y las marcaba todas como conflictos. Para solucionarlo, tomboy-ng mira la última fecha de cambio, con precisión al microsegundo, y decide que dos notas con el mismo identificador y la misma fecha del último cambio debería de ser consideradas idénticas. Es una apuesta bastante buena. Ahora bien, este proceso puede ser un poco lento y por eso guardamos datos adiciones en el manifiesto remoto. No obstante, si usa Tomboy en el mismo repositorio, quitará esos datos y tardará en unirse de nuevo al repositorio. Usualmente no presente ningún problema ... Cuando algo va mal De verdad, he probado el nuevo motor de sincronización de modo exhaustivo, pero todos sabemos el problema de desarrolladores que prueban sus propios programas. Entonces, pues sí, ¡puede que todo vaya al traste! Primero, ¿está guardando instantáneas? Si no, ¿¿¿por qué no??? Segundo, por favor, prueba iniciar tomboy-ng desde la línea de comandos. Mientras se ejecuta, cualquier anomalía aparece en el terminal. Si no le muestra nada revelador, intente parar y añadir --debug-sync a la línea de comandos. Si tiene un problema, por favor haga un informe en Github o la lista de correos de Tomboy. ¡Realmente deseamos saberlo! 2022-09-23T20:46:31.9918428+10:00 2022-09-23T20:46:31.9918428+10:00 2000-01-01T10:00:00.0000000+11:00 1 1 1000 626 806 235 False tomboy-ng_0.39-1/doc/HELP/ES/systray.note0000664000175000017500000000352314551457644017655 0ustar dbannondbannon Bandeja de Sistema en Linux Bandeja de Sistema en Linux La manera habitual de interactuar con tomboy-ng es por un pequeño icono amarillo que aparece en la Bandeja de Sistema (SysTray), a veces llamada el área de notificación. Sin embargo, no todos los Entornos de Escritorio de Linux pueden mostrar iconos en la bandeja de sistema, y algunos que pueden no lo hacen por defecto. Si puede ver un pequeño icono de color amarillo, probablemente en el panel principal en la pantalla, no tienes ningún problema. Si no lo puede ver, es probable que usa un Escritorio que tiene dificultades en mostrar la bandeja de sistema, quizás el escritorio de Gnome. Información detallada y, esperamos, actual sobre los últimos 'trucos' para tener una bandeja de sistema disponible o, incluso, como usar tomboy-ng sin una se puede encontrar en https://github.com/tomboy-notes/tomboy-ng/wiki/System-Tray-on-Linux Suporte para la bandeja de sistema en Linux a veces cambia de repente, entonces vale la pena considerar una versión más nueva de tomboy-ng, https://github.com/tomboy-notes/tomboy-ng 2022-10-23T12:12:46.6802171+02:00 2022-10-23T12:12:46.6802171+02:00 2021-01-23T13:48:35.2369237+11:00 1 1 695 505 699 0 False tomboy-ng_0.39-1/doc/HELP/ES/recover.note0000664000175000017500000001336114551457644017605 0ustar dbannondbannon Recuperar notas perdidas Recuperar notas perdidas Si está leyendo esto, es probable que ¡está preocupado! Entonces, el primer consejo es no se deje llevar por el pánico. (1) Es bastante probable que le podemos ayudar. Dependerá de que ha ocurrido y, tal vez, si ha hecho una instantánea manual recientemente. En primer lugar, no sincronice las notas, lo que podría sustituir datos malos por buenos. Luego, dé pasos pequeños. Vamos a ver las posibilidades: Eliminé (o se eliminó) una nota que necesito. Puede que sea fácil de solucionar. Mantenemos una copia de todas las notas eliminadas manualmente o sobrescritas en una sincronización. Pero, hay solamente una copia, entonces si se ha sincronizado y sobrescrito otra vez, la nota original se ha esfumado. Compruebe volviendo a la pestaña de "Recuperar" en Preferencias, haga clic en "Ver Nota(s)", eche un vistazo a las notas y haga doble clic en una nota que puede que sea la que busca. Aparecerá una caja de diálogo que le permite ver, eliminar o recuperar la nota. Tengo una nota corrompida. Al iniciar tomboy-ng, verá un aviso sobre la imposibilidad de indizar la nota. Probablemente significa que el formato XML de la nota se ha corrompido de alguna manera. (2) El método de indizar en tomboy-ng es muy riguroso por diseño y se genera un error si hay un campo que no se puede obtener. Sin embargo, en función de donde está el error en la nota, puede que sea posible abrirla y guardarla con el XML reescrito. Por supuesto, haga una instantánea antes de iniciar el proceso. Para probar este remedio rápido, debería: Desde la pestaña "Recuperar" en "Preferencias", hacer clic primero en "Hacer una Instantánea Manual" (¡para estar seguro!) y luego en "Recuperar notas perdidas". En la pestaña "Notas corrompidas" encontrará una lista de notas que están corrompidas. Haga doble clic en una nota que puede ser la problemática y se abrirá una nueva ventana de edición. Puede que haya conseguido recuperar por lo menos algo del contenido. No me esta escuchando, ¡he perdido todas mis notas! Vale, entendido. Esto es grave. Pero nos quedan dos posibilidades todavía. A ver . . . Sincronizo mis notas desde otro lugar. Ah, esto es bueno. Quizás sólo tiene que eliminar el directorio actual de las notas (3) y unirse de nuevo a la red de sincronización. Tome nota, hago hincapié en no solamente sincronizar las notas. Deba ir a la pestaña de sincronización y haga clic en "Establecer Repositorio de Sincronización". De esta manera, el sistema de sincronización le ve como un usuario nuevo y le envía todas las notas. La utilidad de este método depende del tiempo que ha transcurrido desde la última sincronización dado que, claro está, los cambios hechos después de la última sincronización se perderán. Tengo una instantánea ¡Una noticia fantástica! Puede recurrir fácilmente a una instantánea concreta y olvidarse de todas las preocupaciones. ¡Demasiado fácil! Si tuvo la prudencia de guardar la instantánea en otro sitio, cópiela a su directorio de instantáneas (visible en la pestaña "Recuperar" de "Preferencias"). De la pestaña "Recuperar", haga clic en "Recuperar Notas Perdidas". Si no lo ha hecho todavía, ahora es buen momento para hacer clic en "Instantánea de Seguridad" dado que está en una situación peligrosa en este momento. Vaya a la pestaña "Recuperar Instantánea", elija la instantánea que quiere usar y ¡adelante! (4) Regrese y vaya a "Buscar" y haga clic en "Actualizar". Después de comprobar que todo está en orden, por favor, ¡acuérdese to hacer una instantánea de vez en cuando! Notas (1) Palabras de Douglas Adams, usadas sin permiso. (2) Las notas nunca debería corromperse, pero parece que ha pasado: fallo eléctrico, error del programa, lo que sea. Si es culpa mía, ¡lo lamento sinceramente! Por favor, haga un informe sobre la experiencia en la lista de correo de Tomboy o en Github. La única manera que tengo de eliminar los problemas es a través de los informes de los usuarios. (3) Tomboy-ng le informa de donde se guardan sus notas. Vaya allí con un gestor de archivos y seleccione todos los archivos de notas. Son los archivos con nombres de 36 caracteres que parecen ser aleatorios y la extensión ".note". ¡Haga esto solamente si sincronice sus notas! (5) Si guarda una copia en otro sitio, recupérela y desencríptelo la si hace falta. Y ¡ buen trabajo ! 2021-07-20T17:51:10.2211944+00:00 2021-07-20T17:51:10.2211944+00:00 2018-08-26T14:03:28.1020000+10:00 1 1 1061 626 248 20 False tomboy-ng_0.39-1/doc/HELP/UK/0000755000175000017500000000000014551457644015253 5ustar dbannondbannontomboy-ng_0.39-1/doc/HELP/UK/tomboy-ng.note0000644000175000017500000003315614551457644020065 0ustar dbannondbannon Довідка tomboy-ng Довідка tomboy-ng Tomboy-ng - це переписана версія всіма любимого Tomboy Notes. Він працює на Linux, Windows і MacOS. Файли сумісні з Tomboy і GNote. Нотатки Tomboy-ng підтримують Грубий, Похилий, Закреслений, Підсвічений і Підкреслений шрифти в чотирьох розмірах - малий, звичайний, великий, і величезний. Він може синхронізувати нотатки з іншими системами, використовуючи модель синхронізації файлів Tomboy та / або мережеву синхронізацію з Github. Останнє дозволяє читати або редагувати нотатки в режимі онлайн із веб-переглядача. Багато користувачів хочуть, щоб tomboy-ng запускався під час входу в систему, він додаватиме значок у системному лотку і ви зможете взаємодіяти з ним через цей значок. Крім того, щоб забезпечити підтримку деяких складних платформ, відкриватиметься невелике вікно або заставка, яку можна закрити, якщо ви бачите піктограму у системному лотку (або у деяких системах Gnome 3, якщо ви дали її до вибраного). Цю маленьку заставку можна налаштувати так, щоб вона не відкривалася, якщо під час запуску не буде виявлено поганих нотаток. Однак, щоб забезпечити підтримку деяких складних платформ, також буде відкрито невелике вікно або заставку, яку можна закрити, якщо ви бачите піктограму у системному лотку (або у деяких системах Gnome 3, якщо ви додали її до вибраного). Ви можете налаштувати цю маленьку заставку так, щоб вона не відкривалася, якщо під час запуску не буде виявлено поганої ноти. Використання tomboy-ng Ви можете взаємодіяти з tomboy-ng за допомогою значка в системному лотку (лише на деяких системах) або з меню, яке появляється в усіх основних формах програми. Якщо ви не маєте значка в системному лотку (це сумно!), додайте tomboy-ng до Вибраного і воно зʼявиться на вашій док-панелі, таким чином, ви зможете запустити програму або викликати її пошукову форму. Із форми пошуку ви можете - Отримати доступ до основного меню (Нова нотатка, Налаштування, останні нотатки і т.і.). Шукати термін по всіх ваших нотатках. Пошуковий термін як імʼя "John Smith" знайде всі нотатки, що використовують слово імʼя будь-де і поєднується з John Smith. Для прикладу я хочу знайти моє імʼя Smith, John. Організувати свої нотаки в записники, tomboy-ng дозволяє, щоб одна нотатка могла бути в більше ніж одному записнику, але якщо ви синхронізуєте або поширюєте свої нотатки з оригінальним Tomboy, не вмикайте цієї функції. Перейменувати записник, але якщо ви синхронізуєте свої нотатки, запустіть спочатку повну синхронізацію Загалом tomboy-ng - автоматично зберігає нотатки, коли ви зробили зміну. дозволяє змінити заголовок нотатки прямо відредагувавши актуальний заголовок у вікні нотатки. автоматично створює резервні копії, коли ви видаляєте нотатку, якщо ви бажаєте знати чи нотатку дійсно втрачено, перейдіть у Налаштування->Відновлення. має можливість створювати зрізи ваших нотаток час від часу, будь ласка, використовуйте це! може синхронізувати ваші нотатки з основним сховищем файлів, яке доступне не різних машинах (Linux, Windows або Mac). не має спільного доступу. Якщо ви просто зберігаєте свої нотатки на спільному диску (не використовуючи синхронізацію), будьте дуже обережними, щоб не запустити більше однієї програми tomboy-ng або Tomboy одночасно. Трапляються погані речі. Перемикачі командного рядка. -h або --help Показує довідку і виходить. -l CCode --lang=CCode Примусово вказати мову, підтримувані мовні коди es, uk, fr та nl. Дайте нам знати, якщо бажаєте мати tomboy-ng своєю мовою. --version Показує версію і виходить --no-splash Не показувати невелике вікно стану/заставки. Врятує вас від необхідності вимикати його під час запуску. Не використовуйте, якщо ви не переконалися, що бачите маленьку зелену піктограму в системному треї. --config-dir=ШЛЯХ_до_КАТАЛОГУ Створити або використовувати альтернативну конфігурацію. В основному для тестування, але корисно, якщо ви хочете мати два (або більше) набори незалежних (але не паралельних) нотаток. --debug-sync --debug-index ---debug-spell Показує, що відбувається під час синхронізації, індексації або правопису. Корисно для налагодження. Це буде писати докладні звіти про хід роботи, що стосуються їх розділу програми, у консоль. Однак, Windows не має для цього консолі. Але програмі можна наказати записувати цю інформацію у файл за допомогою іншого перемикача командного рядка або задати змінну env, яка вказує на ім'я файлу. Будь ласка, переконайтеся, що у вас є дозвіл на запис у вказане місце. Наприклад, з кнопки "Пуск" натисніть "Виконати" і введіть - tomboy-ng --debug-log=c:\debug.txt --debug-sync --open-note=ШЛЯХ_і_Назва_до_НОТАТКИ Відкрити нотатку в режимі окремої нотатки. У цьому режимі запускається окремий процес, який не має доступу до звичайного розташування нотаток, а також до синхронізації, але може читати, відображати, записувати назад або експортувати окрему нотатку. Якщо імʼя нотатки не існує, створюється нова нотатка. Якщо в назві примітки вказано звичайний текстовий файл або rtf-файл, вміст цього файлу буде імпортовано в нову нотатку, і ця примітка буде названа так, як вказано в командному рядку, але з розширенням ".note". У цьому режимі нотатка залишається у своєму поточному розташуванні, вона не переміщується до розташування нотаток tomboy-ng, не синхронізується і не шукається tomboy-ng у звичайному режимі. Зауважте, що перемикач (-o або --open-note) не є обовʼязковим, "tomboy-ng some.note" також працюватиме. --save-exit Працює лише в режимі однієї нотатки, імпортує файл (.note, .rtf, звичайний текст), конвертує в формат .note (і стандартний формат імені файлу нотатки) і зберігає в налаштованому каталозі нотаток. Корисно при написанні скриптів. --import-txt=НАЗВА_ФАЙЛУ --import-md=НАЗВА_ФАЙЛУ --import-note=НАЗВА_ФАЙЛУ Імпортує текстовий файл, файл markdown або файл нотатки у ваш стандартний репозиторій нотаток, наявний екземпляр tomboy-ng буде повідомлений про це, і нотатка зʼявиться у вашому списку пошуку. В кожному випадку НАЗВА_ФАЙЛУ - це повний шлях та назва файлу, якщо він не знаходиться у поточному каталозі. Зауважте, що -t, -m і -n роблять те ж саме. --title-fname Застосовується лише під час імпортування файлу до вашого репозитарію нотаток (але під час імпортування нотатки імпортується назва файлу як заголовок, а не перший рядок файлу). Повʼязане з Mac Користувачі Mac потребують дещо складніших команд під час використання будь-якого з цих перемикачів командного рядка. Наприклад, команда Mac для створення журналу налагодження синхронізації може бути такою - open tomboy-ng.app --args "--debug-log=$HOME/tomboy-ng.log" "--debug-sync" І, через підхід .app, для параметрів потрібно використовувати абсолютні шляхи, або використовувати $PWD відносно вашого поточного каталогу - open tomboy-ng/tomboy-ng.app --args "-o" "$PWD/doc/tomboy-ng.note" 2022-09-23T17:10:13.7156566+03:00 2022-09-23T17:10:13.7156566+03:00 2018-11-07T16:01:06.6550000+11:00 1 1 1000 626 105 27 False tomboy-ng_0.39-1/doc/HELP/UK/calculator.note0000644000175000017500000001217014551457644020274 0ustar dbannondbannon Калькулятор tomboy-ng Калькулятор tomboy-ng Версії після tomboy-ng V0.20 мають калькулятор виразів. Він має три основні режими, які можна активувати натиснувши Ctrl-E (або Cmd-E в Mac) - Простий режим розрахунку, якщо ви напишете 6+10= і натиснете Ctrl-E, tomboy-ng допише після знаку рівності '16'. Це працює для будь-яких простих числових обрахунків, (5*7)/(8.3+12)-0.724=1.000 У цьому режимі, ви можете використовувати числа, круглі дужки, десяткові крапки та основні оператори: + - / * і ^ (степінь). Комплексний режим розрахунку, якщо вам потрібно використовувати скажімо тригонометричні функції, Простий розрахунок не знайде всього виразу. Отож, напишіть вираз, виділіть його і натисніть Ctrl-E ще раз. Схожий результат. У цьому режимі можна використовувати вище згадане, а також pi cos sin tan arctan abs sqr sqrt exp ln log frac int round і trunc. приклад: sin(0.5)^2 + cos(0.5)^2 =1 Стовпчастий режим, додає стовпчик чисел у рядках вище. 'Стовпець', у цьому випадку означає всі числа, що стоять на початку або в кінці рядків. Якщо на початку і в кінці рядків є цифри, то перевагу має довший стовпчик. Якщо ми маємо однакову кількість записів з обох кінців, має перевагу лівий або початковий стовпчик. Перший зустрічний рядок, що не має номера на відповідному кінці, зупиняє підрахунок стовпців. Запам'ятайте, що число в рядку може розглядатися як на початку, так і в кінці рядка. Ви можете зупинити обчислення числа, "сховавши" його за допомогою альфа-символу, а потім видалити цей символ після завершення обчислення. У цьому режимі дозволені лише числа і десяткові крапки. З дому до Акседалу 5.5 З Акседалу до Бендіґо 19 Із Бендіґо додому через дорогу О'Браєна 23 відстань становить 47.500 5 якийсь текст 7 1 більше тексту 3 бла 4 9 У прикладі вище використовується лівий стовпець, він має три числа. Правий стовпець має лише одне, '4', вкінці рядка "1 більше тексту" нема числа. якийсь текст 7 1 більше тексту 4 3 14 У прикладі вище парсер обире для роботи числа вкінці рядка, тому що там є більше елементів. 7+4+3=14, зверніть увагу, що '3' використовується, як для початку, так і для кінця стовпця. Парсер виразів перетворює числа з плаваючою комою там, де це необхідно, і виводить результат із 3 знаками після десяткової крапки. Однак внутрішні обчислення виконуються з набагато вищою точністю. Зверніть увагу, в наведених вище прикладах я вручну виділив жирним шрифтом відповіді для наочності, це не відбувається автоматично. 2022-09-23T13:52:09.6920468+03:00 2022-09-23T13:52:09.6920468+03:00 2019-01-15T21:32:06.9620000+11:00 1 1 1366 717 0 27 False tomboy-ng_0.39-1/doc/HELP/UK/key-shortcuts.note0000644000175000017500000002114014551457644020764 0ustar dbannondbannon tomboy-ng Комбінації клавіш tomboy-ng Комбінації клавіш Усі платформи Alt-СтрілкаВправо : увімкнути маркер списку. Alt-СтрілкаВліво : вимкнути маркер списку. Control-1 : малий шрифт Control-2 : звичайний шрифт Control-3 : великий шрифт Control-4 : величезний шрифт Shift-СтрілкаВправо - виділити одни знак вправо Shift-СтрілкаВліво - виділити один знак вліво Shift-Клацання : виділити текст між поточною позицією і позицією клацання. Windows / Linux Control-Q : Вийти з tomboy-ng - з пошуку, налаштувань чи будь-якої нотатки Control-N : Нова нотатка - з пошуку, налаштувань чи будь-якої нотатки Control-X : Вирізати виділений текст і копіювати його в буфер обміну. Control-C : Копіювати виділений текст у буфер обміну. Control-V : Вставити вміст із буфра обміну в поточну нотатку. Control-A : Виділити всі елементи. Control-СтрілкаВправо : переміститися на слово вправо. Control-СтрілкаВліво : переміститися на слово вліво. Control-Shift-СтрілкаВліво - виділити на одне слово вліво Control-Shift-СтрілкаВправо - виділити на одне слово вправо Control-F4 : Закрити вікно поточної нотатки. Control-Z : Скасувати дію Control-Y : Повторити дію Control-D : Вставити дату і час, РРРР-ММ-ДД гг:хх:сс Control-L : Створити посилання на нотатку з виділеного тексту. Alt - F4 : Закрити поточне вікно нотатки Шрифти Control-B : Грубий Control-I : Похилий Control-S : Закреслений Control-U : Підкреслений Control-H : Підсвічений Control-E : Калькулятор виразів - див. нотаку довідки про Калькулятор Пошук (у нотатці) Control-F : Шукати щось у нотатці. F3 або Ctrl-G : Шукати далі в нотатці Shift-F3 або Shift-Ctrl-G : Шукати назад у нотатці Mac (Де клавіша Option це клавіша Alt) Command-Q : Вийти з tomboy-ng - з пошуку, налаштувань чи будь-якої відкритої нотатки Command-N : Нова нотатка - з пошуку, налаштувань чи будь-якої відкритої нотатки Command-X : Вирізати виділений текст і скопіювати в буфер обміну. Command-C : Копіювати виділений текст у буфер обміну. Command-V : Вставити вміст із буфера обміну в поточну нотатку. Command-A : Виділити всі елементи. Command-F : Відкрити вікно пошуку. Command-СтрілкаВправо : перейти в кінець рядка. Command-СтрілкаВліво : перейти на початок рядка. Command-Z : Скасувати Command-Y : Повторити Command-D : Вставити дату і час, РРРР-ММ-ДД гг:хх:сс Option-Shift-СтрілкаВліво - виділити на слово вліво Option-Shift-СтрілкаВправо - виділити на слово вправо Шрифти Command-B : Bold Command-I : Italics Command-S : Strikeout Command-U : Underline Command-E : Expression calculator - see Calculator help note Option-H : Highlight Пошук (у нотатці) Command-F : Шукати щось у нотатці. Command-G : Шукати далі в нотаці Shift-Command-G : Шукати назад в нотаці 2022-09-23T11:35:16.7638823+03:00 2022-09-23T11:35:16.7638823+03:00 2018-12-06T21:38:38.0650000+11:00 1 1 1000 626 356 78 False tomboy-ng_0.39-1/doc/HELP/UK/sync-ng.note0000644000175000017500000003365614551457644017535 0ustar dbannondbannon Синхронізація tomboy-ng Синхронізація tomboy-ng Це про синхронізацію файлів між компʼютерами Linux, Windows і Mac. Якщо вам цікаво про синхронізацію з GitHub, що забезпечує синхронізацію і доступ до ваших нотаток онлайн через веб-переглядач, будь ласка, дивіться https://github.com/tomboy-notes/tomboy-ng/wiki/Github-Sync Синхронізація ваших нотаток tomboy-ng (та/або Tomboy) може бути дуже корисною річчю. Зробіть це правильно, і всі ваші нотатки на всіх ваших компʼютерах будуть однаковими. І у вас також буде стратегія резервного копіювання нотаток! Памʼятайте, що цінність синхронізації тісно повʼязана з тим, як часто ви це робите! tomboy-ng підтримує синхронізацію файлів. Тобто, він синхронізується із загальною файловою системою. Такою файловою системою може бути Google Диск, будь-який віддалений сервер, до якого ви можете підключитися по ssh, локальний спільний диск вдома або навіть просто USB-флешка. Він працює ідентично на трьох підтримуваних платформах: Linux, Windows і Mac. Зверніть увагу, що tomboy-ng не підключається (як Tomboy) до спеціальних служб синхронізації Tomboy, таких як Snowy, Rainy або grauphel/NextCloud/Apache. Нове у v0.27, Автосинхронізація, дивіться нижче. Добре, для початку, ви зробили зріз ? Якщо ні, то чому ні ??? Спільні файлові системи На практиці, tomboy-ng може синхронізувати до будь-якої (?) файлової системи, яку ваш файловий керівник може переглядати. Ви можете використовувати Google Drive, DropBox або інші системи. Не забувайте, що копія ваших нотаток житиме в них на сервері, тож якщо вам не подобається, що їх там читатимуть, то, можливо, це не найкраща ідея! Можливо ви захочете налаштувати спільний ресурс NFS або SMB. Windows і NFS не найкраще поєднання, проте SMB працює добре на всіх платформах. Маршрутизатор домашньої мережі автора має розʼєм USB на задінй панелі, вставлений туди USB Disk Key розповсюджується через SMB. Працює бездоганно вже пару років. Деякі файлові керівники Linux можуть не охоче показувати вам ресурси SMB або Samba, може допомогти зробити їх закладкою в основному файловому керівнику, але якщо і це не спрацює, переконайтеся, що у вас встановлено gvfs та gvfs-fuse і переглядайте за допомогою вікна каталогу, яке tomboy-ng відкриває десь приблизно тут /run/user/1000/gvfs/smb_share ...... Або ви можете просто використати USB Disk Key і вставити його у будь-який компʼютер, з яким ви синхронізуєтесь у цей час. Якщо tomboy-ng може читати і писати на ньому, добре. Єдине, на що слід звернути увагу, якщо ви плануєте синхронізувати і Tomboy, і tomboy-ng з одним і тим же репозиторієм, Tomboy не зовсім задоволений "будь-якою спільною файловою системою", перевірте це, перш ніж витрачати забагато часу. Налаштування репозиторію Легко, може бути гарною ідеєю створити десь каталог з назвою Tomboy-Sync чи щось таке, і сказати tomboy-ng (або Tomboy) де він розташований, а решту він зробить сам. У tomboy-ng клацніть Налаштування, вкладка Синхронізація, клацніть "Змінити репозиторій синхронізації файлів". Переглянути створений каталог. tomboy-ng перегляне каталог і ваші наявні нотатки (якщо вони є) і зґенерує звіт про те, що він буде робити. Якщо все виглядає добре, клацніть "Зберегти і синхронізувати". Готово. sshfs робить мережеву синхронізацію tomboy-ng може тихо синхронізувати на будь-який віддалений сервер, до якого ви маєте ssh-доступ. Автор має хостинг з тарифним планом за зниженою ціною з дуже занедбаним веб-сайтом і кількома гігабайтами дискового простору. Це зручно, тому що можна заходити на нього по ssh ! Отож, якщо я можу заходити по ssh, отже, я можу використовувати sshfs. Наприклад, на машині linux, я ставлю sshfs, потім зайшовши по ssh на цей віддалений сервер я створюю каталог з назвою TB_Sync, потім повертаюся назад на локальну машину - cd; mkdir TB_Sync; sshfs myname@remoteserver.com:TB_Sync TB_Sync [enter] Запустіть tomboy-ng і вкажіть ~/TB_Sync як репозиторій для синхронізації і все готово. Відʼєднайте цей спільний каталог командою - fusermount -uz TB_Sync [enter] І перезʼєднайтеся пізніше, щоб синхронізувати ще раз, командою sshfs myname@remoteserver.com TB_SYNC [enter] Ручна синхронізація і розвʼязання конфліктів Час від часу, вам потрібно клацнути на елемент меню Синхронізувати. Зʼявиться короткий звіт про те, що було зроблено, подивіться і закрийте. Однак, майже напевно настане час, коли ви зміните певну нотатку на більш ніж одному пристрої з моменту останньої синхронізації. Сумно, але не минуче. Тепер, механізм синхронізації не знає, що робити. Він покаже вам список відмінностей між двома нотатками, і ви зможете вибрати, чи використовувати локальну, чи віддалену версію. Віддалена буде на 'віддаленому' файловому репозиторії. Якщо, навіть побачивши відмінності, ви все ще не можете визначитися яку версію обрати, то можливо варто обрати віддалену. Для локальної версії буде створено резервну копію і ви зможете відновити у Налаштування->Резервна копія. Зверніть увагу, під час розвʼязання конфліктів, є також кілька кнопок "зробити все", які будуть застосовані до решти цього циклу синхронізації. Віддалений, локальний, найновіший, найстаріший, якщо ви почуваєтеся сміливо, натисніть один. Автоматична синхронізація Нове у v0.27, tomboy-ng синхронізується автоматично за лаштунками. Звичайно, тільки якщо у вас налаштована синхронізація і доступна необхідна спільна файлова система. Поставте галочку в Налаштування->Синхронізація. Синхронізація відбудеться приблизно через 15 секунд після запуску, а потім щогодини. Якщо вона зіткнеться з конфліктом нотаток, все одно зʼявиться звичайне вікно, що показує відмінності між двома нотатками, дозволяючи вам прийняти рішення. Якщо він не може синхронізуватися, тому що, можливо, ви відʼєднали спільний диск, знову зʼявиться спливаюче вікно, в якому ви можете або вирішити проблему і натиснути кнопку Повторити, або, якщо ви натиснете кнопку Скасувати, спроба синхронізації не буде повторена, поки ви не перезапустите tomboy-ng або не "вимкнете" параметр Автосинхронізація. Якщо ви, як і я, потребуєте постійної впевненості в тому, що все працює, ви можете переглянути деталі останньої синхронізації в рядку стану вікна пошуку. Переприєднання репозиторію Tomboy матиме проблеми, якщо Вам доведеться повторно приєднатися до репозиторію, яке Ви використовували в минулому. Він може виявити велику кількість нотаток з однаковим ідентифікатором, але не матиме даних сховища, щоб знати, як з ними поводитися, і всі вони будуть позначені як конфліктні. Щоб вирішити цю проблему, tomboy-ng дивиться на дату останньої зміни з точністю до мікросекунди і вирішує, що дві нотатки з однаковим ІД і однаковою датою останньої зміни слід вважати ідентичними. Це досить хороша тактика. Цей процес може бути трохи повільним, тому ми зберігаємо додаткові дані у віддаленому маніфесті. Однак, якщо ви використовуєте Tomboy в тому ж репозиторії, він видалить ці додаткові дані, і повторне приєднання до репозиторію буде повільним. Зазвичай це не проблема ... Коли щось пішло не так. Чесно кажучи, я тестував новий рушій синхронізації до смерті. Але ми всі знаємо проблему з розробниками, які тестують свій власний код. Так що, так, все може піти не так ! По-перше, Ви зберігаєте зрізи ? Якщо ні, то чому ні ??? По-друге, спробуйте запустити tomboy-ng з командного рядка. Під час роботи програми все, що їй не сподобається, буде повідомлено на вашу консоль. Якщо це не покаже вам нічого показового, спробуйте зупинити і додати --debug-sync до командного рядка. Якщо у вас виникли проблеми, будь ласка, повідомте про це на github або до поштової розсилки Tomboy, ми дійсно хочемо знати! 2022-09-24T22:04:46.7427255+03:00 2022-09-24T22:04:46.7427255+03:00 2000-01-01T10:00:00.0000000+11:00 1 1 1000 626 29 39 False tomboy-ng_0.39-1/doc/HELP/UK/systray.note0000644000175000017500000000502714551457644017664 0ustar dbannondbannon Системний лоток у Linux Системний лоток у Linux Зазвичай користувач взаємодіє з tomboy-ng за допомогою маленької жовтої піктограми, що зʼявляється в системному лотку, який іноді називають областю сповіщень. Однак, не всі середовища робочого столу Linux можуть відображати піктограми системного лотка, а деякі з них можуть не робити цього за замовчуванням. Якщо ви можете бачити маленький, жовтий значок, імовірно на основній панелі вашого екрану, тоді у вас проблем немає. Якщо ви його не бачите, то напевно ви використовуєте стільницю, що має проблеми з відображенням системного лотка, як-от стільниця Gnome. Детальну і, сподіваємося, актуальну інформацію про останні "трюки" для відображення системного лотка на непокірних системах і навіть про те, як використовувати tomboy-ng без системного лотка, можна знайти за адресою https://github.com/tomboy-notes/tomboy-ng/wiki/System-Tray-on-Linux Підтримка системного лотка в Linux іноді змінюється досить різко, тому часто варто розглянути новішу версію tomboy-ng, https://github.com/tomboy-notes/tomboy-ng 2022-09-23T12:02:19.8867685+03:00 2022-09-23T12:02:19.8867685+03:00 2021-01-23T13:48:35.2369237+11:00 1 1 1227 610 108 124 False tomboy-ng_0.39-1/doc/HELP/UK/recover.note0000644000175000017500000002062214551457644017611 0ustar dbannondbannon Відновлення втрачених нотаток Відновлення втрачених нотаток Якщо ви це читаєте, то швидше за все у вас щось трапилося без паніки (1) Швидше за все, ми зможемо вам допомогти. Це залежить від того, що трапилося, і, можливо, від того, чи робили ви недавно зріз вручну. По-перше, не робіть синхронізацію, це може замінити хороші дані на погані. Далі, робіть маленькі кроки. Давайте глянемо на можливі випадки - Мною (або синхронізацією) видалено потрібну мені нотатку Це буде просто. Ми зберігаємо резервну копію кожної нотатки, яку ви видалили вручну або перезаписали під час синхронізації. Але є лише одна копія, тому якщо ви синхронізуєте і перезапишете ще раз, вона зникне. Перевірити можна перейшовши в Налаштування, вкладка Відновлення, клацнути "Показати мені", переглянути старі нотатки і подвійним клацанням вибрати потрібну кандидатуру. Появиться віконце, в якому ви зможете переглянути, видалити або відновити нотатку. У мене пошкоджена нотатка. Коли ви запускаєте tomboy-ng, ви бачите попередження про неможливість проіндексувати нотатку. Це може означати, що XML нотатки якимось чином пошкоджено (2). Механізм індексування tomboy-ng навмисно дуже суворий до того, що він приймає, він видасть помилку, якщо одне з полів недоступне. Однак, залежно від місця, де знаходиться XML-помилка в нотатці, ви можете відкрити її і зберегти з виправленим XML. Зробіть зріз перед початком цього процесу. Щоб спробувати це швидке виправлення, ви повинні - У Налаштуваннях, вкладка Відновлення, клацнути "Зріз вручну" (щоб бути в безпеці!), потім клацнути "Відновити втрачені нотатки". У цьому вікні, в розділі "Погані нотатки" є список саме таких нотаток. Двічі клацніть на потрібній кандидатурі і відкриється нове вікно Змінити. Можливо, ви відновите хоча б частину вмісту. Ти не слухаєш, я втратив усі свої нотатки ! Добре, я зрозумів, це серйозно. У нас залишилося два шляхи - Я синхронізую свої нотатки з іншого місця. О, це добре. Можливо все, що вам потрібно це очистити поточний каталог нотаток (3) і повторно приєднатися до мережі синхронізації. Зверніть увагу, підкреслюю, не просто зробити синхронізацію. Вам ПОТРІБНО перейти у вкладку синхронізації і клацнути "Вказати репозиторій синхронізації файлів". Таким чином, система синхронізації сприйме вас як нового друга і надішле вам повний набір нотаток. Наскільки це правильний підхід, залежить від того, як давно ви не синхронізувалися, очевидно, що будь-які зміни з моменту останньої синхронізації будуть втрачені. У мене є зріз Чудові новини ! Ви можете легко відкотитися назад до певного зрізу і здути всі свої проблеми. Занадто просто ! Якщо ви завбачливо зберегли зріз в іншому місці, скопіюйте його до каталогу зрізів (показаний у Налаштуваннях -> вкладка Відновлення). У вкладці Відновлення, клацніть "Відновити втрачені нотатки". Якщо у вас нічого немає, то зараз саме час натиснути "Зробити зріз вручну", ви зараз в дуже небезпечному місці. Перейдіть у вкладку "Відновити зріз", оберіть зріз, який бажаєте використовувати і забирайтеся звідтам (4). Поверніться назад, перейдіть до Пошуку та натисніть "Оновити". Після того, як ви перевірили, чи все в порядку, будь ласка, не забувайте час від часу робити знімки! Примітки (1) Від Douglas Adams, використовується без дозволу. (2) Зіпсованих нотаток не повинно бути, але, схоже, це сталося. Збій живлення, програмна помилка, що завгодно. Якщо це моя вина, я щиро перепрошую ! Будь ласка, повідомте про цей досвід у поштовій розсилці Tomboy або на GitHub. Єдиний спосіб дізнатися про них, це якщо люди мені розкажуть. (3) Tomboy-ng скаже вам де зберігаються нотатки, перейдіть туди через керівник файлів і виберіть усі файли нотаток. Це ті, назва яких складається з 36-ти випадкових символів і розширення ".note". Робіть це, якщо ви користувач синхронізації ! (4) Якщо ви (з розумом) зберігаєте копію в іншому місці, перенесіть її назад, розшифруйте за потреби. І хорошої вам роботи ! 2022-09-23T15:29:04.6095805+03:00 2022-09-23T15:29:04.6095805+03:00 2018-08-26T14:03:28.1020000+10:00 1 1 1061 626 118 61 False tomboy-ng_0.39-1/doc/HELP/EN/0000755000175000017500000000000014551457644015236 5ustar dbannondbannontomboy-ng_0.39-1/doc/HELP/EN/tomboy-ng.note0000664000175000017500000002230014551457644020037 0ustar dbannondbannon tomboy-ng help tomboy-ng help Tomboy-ng is a rewrite of the much loved Tomboy Notes. It runs on Linux, Windows and MacOS. Is file compatible with Tomboy and GNote. Tomboy-ng notes support Bold, Italic, Strike-through, Highlight and Underline in four sizes, small, normal, large and huge. It can sync notes with other systems using Tomboy's File Sync model and / or a network based sync to Github. The latter allows you to read or edit you notes on line from a browser. Many users will want to have tomboy-ng start at logon time, it will put an Icon in the System Tray and you can interact with it via that Icon. However, to ensure we support some difficult platforms, a small window or splash screen is also opened, it can be dismissed if you see the system tray icon (or on some Gnome 3 systems, you have added it to your dock as a favourite). You can set that small splash screen to not open unless a bad note is detected at startup. Using tomboy-ng You will interact with tomboy-ng using a menu on a System Tray Icon (only some systems) or from a menu that appears on all major forms of the application. If you don't have a System Tray Icon (that's sad!) you add tomboy-ng to your Favourites so it appears on your dock, that way, you can always either start it or wake up its Search Form easily. From the search form, you can - Access the main menu (New Note, Settings, recent notes etc). Search for terms in all your notes. A search term like "John Smith" name will find all notes that use the word name anywhere and have exactly that combination of John Smith. It won't, for example find my name is Smith, John. Organise your notes into Notebooks, tomboy-ng will allow each note to be in more than one Notebook but if you sync or share your notes with the original Tomboy, don't turn that feature on. Rename a notebook, but if you sync your notes, do run a full sync first ! Generally tomboy-ng - notes are automatically saved as you make changes. allows you to change a notes's title by directly editing the actual title in the note window. automatically makes backup copies when you delete a note, if you need to know a note is really gone, go to Settings->Backup. has facilities to make snapshots of your notes from time to time, please use it! can sync your notes to a common file store so they are accessible from multiple machines (Linux, Windows or Mac). does not share well. If you just put your notes on a shared drive (without using sync) be desperately careful that you don't have more than one tomboy-ng or Tomboy running at the same time. Bad things happen. Linking A major feature of Tomboy and its descendants is the automatic linking between notes. If you type the Title of an existing note, the words will become hyperlinks and a click will open that other note. Similarly, if you select some text and click the Links button, a new note with that Title and linked to from your existing note, appears. New in v0.38, clicking the Links button with nothing selected will display a clickable list of the notes linked to this one, Backlinks. In a similar manner, text that tomboy-ng thinks might be a web link is marked as a hyper link, a click will open your browser. Both forms of hyperlinks can be turned off in the settings window. Command Line Switches. -h or --help Show help and exit. -l CCode --lang=CCode Force Language, supported language codes as es, uk, fr and nl. Let us know if you want tomboy-ng in another language. --version Print version and exit --no-splash Don't show small status/splash window. Saves you from having to dismiss it at startup. Don't use unless you have checked you can see the small green system tray icon. --config-dir=PATH_to_DIR Create or use an alternative config. Mainly a testing feature but useful if you want to have two (or more) sets of independent (but not concurrent) notes for example. --debug-sync --debug-index ---debug-spell Show what is happening during either sync, index or spell. Useful for debugging. They will write detailed progress reports relating to their section of the application to the console. However, Windows does not, for this purpose, have a console. But it can be told to capture this log info to a file using another command line switch or by setting an env variable that specifies a file name. Please ensure you have permission to write to the location specified. For example, from the start button, click run and type - tomboy-ng --debug-log=c:\debug.txt --debug-sync --open-note=PATH_and_Name_to_NOTE Open a note in single note mode. In this mode, a separate process runs, it does not have access to the normal notes location, nor sync but can read, display, write back to or export a stand alone note. If the note name does not exist, a new note is created. If the note name specifies a plain text file or a rtf file, the contents of that file will be imported into a new note and that note will be named as specified on the command line but with an extension of ".note". In this mode, the note remains in its existing location, it is not moved to the tomboy-ng notes location, it is not synced, nor searched by tomboy-ng in its normal mode. Note that the switch (-o or --open-note) is optional, "tomboy-ng some.note" will works as well. --save-exit Works only with the single note mode, will import (.note, .rtf, plain text) the file, convert to .note format (and note standard filename format) and save in the configured notes directory. Useful in scripting. --import-txt=FILE_NAME --import-md=FILE_NAME --import-note=FILE_NAME Import a text, markdown or note file into your default Note Repo, an existing instance of tomboy-ng will be told about it and it appears in your Search List. In each case, FILE_NAME is a full path and filename unless its in the current directory. Note that -t, -m and -n does the same thing. --title-fname Applies only when importing a file into your Notes Repository (but when importing a Note), filename as title instead of the first line of the file. --useappind=yes|no Only for Linux using gtk2 version. Will override tomboy-ng decision about how to try to display the System Tray Icon, its here to help with difficult systems that cannot seem to display that icon using the normal approach. --platformtheme qt5ct Use with Qt versions ONLY, will instruct the app to display the colors defined in qt5ct. The qt5ct app has a nice GUI where you can select the colors that suite you. Some other Qt specific options may also work using a similar syntax. Note there is not an '=' sigh between the switch and its parameter. Mac Things Mac user require a slightly more complicated command line when using any of these command line switches. For example a Mac command line to generate a sync debug log would be - open tomboy-ng.app --args "--debug-log=$HOME/tomboy-ng.log" "--debug-sync" And, because of the .app approach, absolute paths need be used for parameters, or, use $PWD relative to your current directory - open tomboy-ng/tomboy-ng.app --args "-o" "$PWD/doc/tomboy-ng.note" 2024-01-05T12:49:22.5012394+11:00 2024-01-05T12:49:22.5012394+11:00 2018-11-07T16:01:06.6550000+11:00 1 1 1000 626 703 33 False tomboy-ng_0.39-1/doc/HELP/EN/calculator.note0000664000175000017500000000671614551457644020272 0ustar dbannondbannon tomboy-ng Calculator tomboy-ng Calculator Versions of tomboy-ng after V0.20 include an expression calculator. It has three basic modes, all activated by pressing Ctrl-E (or Cmd-E on the Mac) - Simple Calc Mode, you type for example, 6+10= and press Ctrl-E, tomboy-ng will fill in '16' after the equals sign. This will work with any basic numerical calculations, (5*7)/(8.3+12)-0.724=1.000 In this mode, you can use numerals, curved brackets, decimal points and the basic operators, + - / * and ^ (ie power). Complex Calc Mode, if you need to use, say trig functions, the Simple Calc won't find your full expression. So, type the expression, select it and, again, press Ctrl-E. Similar result. In this mode you can use the above mentioned plus pi cos sin tan arctan abs sqr sqrt exp ln log frac int round and trunc. eg sin(0.5)^2 + cos(0.5)^2 =1 Column Mode, will add up a column of numbers in the lines above it. 'A column', in this case means all the numbers that appear at either the beginning of the lines or end of the lines. If there are numbers at both beginning and end of lines, the longer column takes precedence. If we have the same number of entries at either end, the left or beginning column takes precedence. The first line encounted that does not have a number at the appropriate end stops the column count. Remember a number on a line by itself can be considered to be at both the beginning and end of the line. You can stop a number being considered by 'hiding' it with an alpha char and, then remove that character after doing the calc. Only numerals and the decimal point are allowed in this mode. Home to Axedale 5.5 Axedale to Bendigo 19 Bendigo to home via O'Briens Road 23 round trip is 47.500 5 some text 7 1 more text 3 blah 4 9 In the above example, the left column is used, it has three eligible numbers, the right column only has one, the '4', there is no number at the end of the "1 more text" line. some text 7 1 more text 4 3 14 In above example, the parser has chosen to work with the numbers at the end of the line because that list has more entries. 7+4+3=14 note that the '3' can be used by both a beginning and end column. The expression parser converts to using floating point numbers where necessary and displays its output with 3 digits after the decimal point. The internal calculations are done at a much higher precision however. Note in the examples above, I have manually bolded the answers for clarity, it does not happen automatically. 2021-07-11T17:28:34.3098611+10:00 2021-07-11T17:28:34.3098611+10:00 2019-01-15T21:32:06.9620000+11:00 1 1 1000 626 20 29 False tomboy-ng_0.39-1/doc/HELP/EN/key-shortcuts.note0000664000175000017500000001411714551457644020757 0ustar dbannondbannon tomboy-ng Keyboard Shortcuts tomboy-ng Keyboard Shortcuts All Platforms Alt-RightArrow : Turn a bullet point on or increase indent Alt-LeftArrow : Turn a bullet point off or reduce indent Control-1 : Small Font Control-2 : normal font Control-3 : large font Control-4 : huge font Shift-RightArrow : extend selection one char to right Shift-LeftArrow : extend selection one char to left Shift-Click : Select text between existing position and clicked position Windows / Linux Control-Q : Quit tomboy-ng - On Search, Settings and any Open Note Control-N : New Note - On Search, Settings and any Open Note Control-X : Cut the selected text and copy it to the Clipboard Control-C : Copy the selected text to the Clipboard. Control-V : Paste the contents of the Clipboard into the current note Control-A : Select All items. End or Fn-RightArrow : move to end of line. Home or Fn-LeftArrow : move to start of line. Control-RightArrow : move cursor to the word to the right Control-LeftArrow : move cursor to word to the left Control-Shift-LeftArrow : extend selection one word to left Control-Shift-RightArrow : extend selection one word to right Control-Z : Undo Control-Y : Redo Control-F4 : Close current note window Control-D : Insert date time string, YYYY-MM-DD hh:mm:ss Control-L : Create a link note from selected text Alt-F4 : Close current note window (not all Linux desktops allow this) Fonts Control-B : Bold Control-I : Italics Control-S : Strikeout Control-U : Underline Control-H : Highlight Control-E : Expression calculator - see Calculator help note Find (in a note) Control-F : Find something in a Note F3 or Ctrl-G : Next in-note Find Shift-F3 or Shift-Ctrl-G : Previous in-note Find Mac Command-Q : Quit tomboy-ng - On Search, Settings and any Open Note Command-N : New Note - On Search, Settings and any Open Note Command-X : Cut the selected text and copy it to the Clipboard Command-C : Copy the selected text to the Clipboard Command-V : Paste the contents of the Clipboard into the current note Command-A : Select All items Command-RightArrow : go to end of line Command-LeftArrow : go to start of line Command-Z : Undo Command-Y : Redo Command-D : Insert date time string, YYYY-MM-DD hh:mm:ss Option-Shift-LeftArrow : extend selection one word to left Option-Shift-RightArrow : extend selection one word to right Fonts Command-B : Bold Command-I : Italics Command-S : Strikeout Command-U : Underline Command-E : Expression calculator - see Calculator help note Option-H : Highlight Find (in a note) Command-F : Find something in a Note Command-G : Next in-note Find Shift-Command-G : Previous in-note Find 2022-11-11T12:05:08.6697108+11:00 2022-11-11T12:05:08.6697108+11:00 2018-12-06T21:38:38.0650000+11:00 1 1 1000 626 142 95 False tomboy-ng_0.39-1/doc/HELP/EN/sync-ng.note0000664000175000017500000001611114551457644017505 0ustar dbannondbannon tomboy-ng sync tomboy-ng sync This is about file syncing between Linux, Windows and Mac computers. If you are interested in Github sync, providing both Sync and a access to your notes online from a browser, please see https://github.com/tomboy-notes/tomboy-ng/wiki/Github-Sync Synchronising your tomboy-ng (and/or Tomboy) notes can be a very useful thing. Do it properly and all your notes on all your computers are the same. And you have a backup strategy for your note too ! Remember that the value of syncing is closely related to how often you do it ! tomboy-ng supports file sync. That is, it syncs to a shared file system. That filesystem might be Google Drive, any remote server you can ssh to, a local shared drive at home or even just a USB thumb drive. It works identically between the three supported platforms, Linux, Windows and Mac. Note that tomboy-ng does not (like Tomboy does) connect to a dedicated Tomboy sync service such as Snowy, Rainy or grauphel/NextCloud/Apache. New in v0.27, Auto sync, see further down. OK, before we start, are you keeping snapshots ? If not, why not ??? A shared Filesystem In practise, tomboy-ng will sync to any (?) file system that your file manager can browse. You could use Google Drive, Drop Box or any such system. Don't forget a copy of your notes will live on their server so if you are unhappy at them being read there, maybe that is not a great idea! You may want to setup a NFS or SMB share. Windows and NFS is not a great mix but SMB works well for all three platforms. The author's home network router has a USB slot at the back, a USB Disk Key plugged in there is distributed via SMB. Been working flawlessly for a couple of years. Some Linux File Managers can be reluctant to show you the SMB or Samba shares, it can help to make them a book mark in your main File Manager but if even that does not work, ensure you have gvfs and gvfs-fuse installed and browse using the directory dialog that tomboy-ng pops up to somewhere like /run/user/1000/gvfs/smb_share ..... Or you could even just use a USB Disk Key and plug it into which ever machine you are syncing at the time. As long as tomboy-ng can read and write there, good. One thing to note, if you plan to sync both Tomboy and tomboy-ng with the same repository, Tomboy is not quite so happy with "any shared filesystem", check it before investing too much time. Setting Up A Repository Easy, might be a good idea to create a directory there such as Tomboy-Sync or whatever, tomboy-ng just needs be told where the filesystem is and it will do the rest. In tomboy-ng, click Settings, Sync Tab. Set Sync Type to "File Sync ..." and click "Change File Sync Repo". Browse to the directory you created. tomboy-ng will have a look at the directory and your existing notes (if any) and will generate a report about what it will do. If that looks OK, click "Save and Sync". Done. sshfs to do network sync tomboy-ng can sync quite happily to any remote server that you have ssh access to. The author has a cut price hosting plan with a much neglected website and a few gig of diskspace. Its useful because I can ssh into it ! So, if I can ssh to it, I can use sshfs with it. For example, on a linux machine, I would install sshfs then, initially ssh to this remote server and create a directory called eg TB_Sync, then back on my local machine make a local directory as a mount point and use sshfs to mount the remote share on that point. In tomboy-ng, "Change Sync Repo" and browse to that mount point. cd; mkdir TB_Sync; sshfs myname@remoteserver.com:TB_Sync TB_Sync [enter] Manual Syncing and Clashes From time to time, you need to click the Sync menu entry. A short report will pop up telling what it has done, have a look and close. However, there will almost certainly come a time when you have changed a particular note on more than one machine since your last Sync. Sad but inevitable. Now, the Sync engine does not know what to do. It will show you a list of the differences between the two notes and you can choose to use the Local or Remote version. Remote being the 'remote' file repository. If, even after seeing the differences between the two versions, you still cannot decide, then perhaps you should chose to use the remote. The local one will then be backed up and you can recover it from Settings->Backup. Note, when resolving clashes, there are also several "do all" buttons that will be applied to the remainder of this sync run. Remote, Local, newest, oldest, if you feel brave, click one. Automatic Syncing New on v0.27, tomboy-ng does automatic, behind the scenes syncing. Obviously only if you have setup sync and the necessary shared file system is available. Settings->Sync and tick the box. It will sync about 15 seconds after startup and then as often as you have set. If it encounters a note clash, the usual window will still popup showing the differences between the two notes allowing you to decide. If it cannot sync, because, perhaps, you have disconnected the shared drive, again a popup windows will advise you, you can either fix the problem and press Retry or, if you press Cancel, syncing will not be attempted again until you either restart tomboy-ng or 'bounce' the Auto Sync setting. If you are like me and need constant reassurance that things are working, you can see details of most recent sync in the Search Window's status bar. Rejoining a Repository Tomboy would struggle when you had occasion to re-join a repo you have used in the past. It would spot a whole lot of notes with the same ID but not have the repository data to know how to handle them, they would all be labelled as clashes. To solve this, tomboy-ng looks at the last change date, accurate to the micro second and decides that two notes with the same ID and the same last change date should be assumed to be identical. Its a pretty good bet. Now, this process can be a bit slow so we keep additional data in the remote manifest. However, if you use Tomboy in the same repo, it will drop that extra data and re-joining a repo will be slow. Not a problem, just slower. 2023-12-06T17:46:15.9245866+11:00 2023-12-06T17:46:15.9245866+11:00 2000-01-01T10:00:00.0000000+11:00 1 1 1000 626 181 165 False tomboy-ng_0.39-1/doc/HELP/EN/systray.note0000664000175000017500000000334714551457644017654 0ustar dbannondbannon System Tray on Linux System Tray on Linux The normal way that a user interacts with tomboy-ng is via a small yellow icon that appears on the System Tray, sometimes called the Notification Area. However, not all Linux Desktop Environments are able to display System Tray Icons, and some that can may not do so by default. If you can see a small, yellow icon, probably on the main panel on your screen, you don't have a problem. If you cannot see it, you are probably using a Desktop that has issues displaying the System Tray, possibly a Gnome Desktop. Detailed and hopefully current information on the latest 'tricks' to display a System Tray on recalcitrant systems and even how to use tomboy-ng without a System Tray can be found at https://github.com/tomboy-notes/tomboy-ng/wiki/System-Tray-on-Linux Support for System Tray on Linux changes quite abruptly sometimes so its often worth considering a newer version of tomboy-ng, https://github.com/tomboy-notes/tomboy-ng 2022-11-01T09:37:23.3446960+11:00 2022-11-01T09:37:23.3446960+11:00 2021-01-23T13:48:35.2369237+11:00 1 1 1227 610 108 195 False tomboy-ng_0.39-1/doc/HELP/EN/recover.note0000664000175000017500000001161614551457644017601 0ustar dbannondbannon Recovering Lost Notes Recovering Lost Notes If you are reading this, odds are you are worried ! So, first bit of advice is don't panic (1) Its quite possible we can help you. That will depend on what has happened and maybe if you have taken a manual snapshot recently. Firstly, don't do a sync, it could replace good data with bad. Next, take small steps. Let's look at the possibilities - I (or the sync) deleted a note I need That just might be easy. We keep a backup copy of every note you manually delete or is overwritten during a sync. But only one copy so if its been synced and overwritten again, it is gone. Check by going back to Settings, the Recover tab, click "Show Me", browse through the old notes there and double click a likely candidate. You'll get a dialog that lets you view, delete or recover that note. I have a corrupted note. When you start tomboy-ng, you see a warning about an inability to index a note. That probably means the note's XML has somehow become corrupted (2). The indexing mechanism in tomboy-ng is deliberately very strict in what it will accept, it errors if one field is unobtainable. However, depending on where the XML error in the note is, you may be able to open it and save it with rewritten XML. Do take a snapshot before you start this process. To try this quick fix, you should - From Settings, the Recover tab, click "Manual Snapshot" (to be safe!) then click "Recover lost notes". In this window, under "Bad Notes" is a list of just that. Double click a likely candidate and a new Edit window will open. You may have just recovered at least some content. You're not listening, I have lost all my notes ! OK, I get you, this is serious. But we at have two paths left, lets see - I sync my notes from somewhere else. Oh, that's good. Maybe all you need do is clean out your current notes directory (3) and rejoin the sync network. Note, I emphasise, not just do a sync. You MUST go to the sync tab and click "Set File Sync Repo". That way, the sync system sees you as a new friend and sends you a full set of notes. Just how good an approach this is depends on how recently you last synced, obviously any changes since last sync will be lost. I have a snapshot Great news ! You can easily choose to roll back to a particular snapshot and blow away all your troubles. Too Easy ! If you wisely kept the snapshot elsewhere, copy it to your snapshot directory (shown on the Settings -> Recover tab). From the Recover tab, click "Recover lost Notes". If you have not already, now would be a great time to click "Take a Manual Snapshot", you are in seriously dangerous space right now. Go to the "Recover Snapshot" tab, choose the snapshot you wish to use and away you go (4). Back out, go to the Search and click "Refresh". After you have checked all is good, please remember to take a snapshot every now and again ! Notes (1) By Douglas Adams, used without permission. (2) Corrupted notes should never happen, looks like it did. Power failure, program error, whatever. If its my fault, I am sincerely sorry ! Please report this experience to the Tomboy mailing list or Github. The only way I can rid of these problems is if people tell me about them. (3) Tomboy-ng tells you where your notes are stored, go there with a file manager and select all the note files. They are the ones with a 36 apparently random character name and ".note" extension. Only do this if you are a sync user ! (4) If you (wisely) keep a copy elsewhere, bring it back, decrypt it if necessary. And, good work ! 2021-07-21T10:31:32.6130010+10:00 2021-07-21T10:31:32.6130010+10:00 2018-08-26T14:03:28.1020000+10:00 1 1 1061 626 22 246 False tomboy-ng_0.39-1/doc/HELP/FR/0000755000175000017500000000000014551457644015243 5ustar dbannondbannontomboy-ng_0.39-1/doc/HELP/FR/tomboy-ng.note0000664000175000017500000001753414551457644020061 0ustar dbannondbannon aide de tomboy-ng aide de tomboy-ng Tomboy-ng est une réécriture du regretté Tomboy Notes. Il tourne sur Linux, Windows et MacOS. Son format de fichier est compatible avec Tomdroid et (?) GNote. Tomboy-ng accepte le texte en Gras, Italique, Barré, Surligné et Souligné en quatre taille de police : petite, normale, grande et énorme. La synchro Tomboy-ng des notes est possible avec tous les systèmes qui utilisent le modèle de synchro de Tomboy (mais pas encore la synchro réseau via Rainy ou Graphal). Il est possible de synchroniser individuellement tout smartphone Android capable d'exécuter Tomdroid (version linux uniquement). Certains utilisateurs souhaiteront avoir Tomboy-ng actif à l'ouverture de la session, une icône est placée la barre des tâches et permet d'interagir. Pour garantir le support sur certaines distribution spéciales, une petite fenêtre ou un écran d'accueil est également ouvert ; il peut être minimisé vers le bandeau des applications (ou sur certaines version de Gnome3, être ajouté comme favori dans le dock). Utilisation de Tomboy-ng Tomboy-ng se manipule depuis le menu visible comme icône dans le bandeau des applications ou via la fenêtre menu sur les autres distributions. En l'absence du beandeau des application (quel dommage !), Tomboy-ng peut-être ajouté comme favori pour apparaitre dans le dock, de cette façon il est aisément possible de le lancer ou de restaurer le champ de recherche. Depuis la fenêtre de recherche, on peut : Accéder au menu principal (Nouvelle note, réglages, notes récentes, etc.). Rechercher des termes dans toutes les notes. Une recherche du type : nom "Jacques Martin" retournera toutes les notes contenant le mot nom et l'exacte combinaison "Jacques Martin". Mon nom est Martin par exemple ne sera pas sélectionné. Organiser les notes dans des carnets, Tomboy-ng autorise qu'une note soit classée dans plus d'un carnet mais si la synchronisation ou le partage est utilisé, c'est à éviter. Renommer un carnet, en n'oubliant pas de faire une synchronisation complète au préalable si cette fonction est utilisée ! À noter que les résultats de la recherche ne sont pas automaitquement mises à jour quand la fenêtre est ouverte. C'est pour garantir qu'un résultat de recherche ne change pas durant la modification des notes. Si un changement est intervenu, le bouton "Rafraîchir" est activé et la mise à jour est alors possible. Tomboy-ng : sauvegarde automatiquement les notes quand elles sont modifiées créé automatiquement une copie de secours qund un note est effacée, pour savoir si une note est effectivement effacée, consulter le menu Réglages->Restauration permet de faire simplement un snapshot des notes, n'oublier pas d'en faire ! Linux, Windows et MacOSpeut synchroniser les notes vers une zone de stockage commune les rendant ainsi accessibles à de multiples machines (Linux, Windows et Mac). ne gère pas parfaitement le partage. L'accès concurrent aux notes sur un volume partagé (sans utiliser la synchronisation) génère des comportements hiératiques avec des résultats imprévisibles. Commandes par terminal -h ou --help affiche l'aide puis quitte. --delay-start Retarde le démarrage de quelques secondes pour permettre a Tomboy-ng d'utiliser la personnalisation des couleurs. -g ou --gnome3 Empêche la fermeture de l'écran d'accueil. Uniquement nécessaire pour certaines distributions linux (gnome 3) qui n'afficherait pas Tomboy-ng dans le bandeau des application. -l CodePays ou --lang=CodePays Sélectionne la langue de l'interface (CodePays= es, nl ou fr). Dites-nous si vous souhaitez voir de nouvelles langues ajoutées ! --version Affiche la version et quitte. --no-splash N'affiche pas l'écran d'accueil au lancement. Évite de devoir fermer la fenêtre manuellement après démarrage. À n'utiliser qu'après avoir vérifié la présence de la petite icône verte dans le bandeau des applications. --config-dir=CHEMIN_RÉPERTOIRE Crée ou utilise un chemin alternatif. Sert surtout à faire des tests, comme avoir deux bases de carnets distinctes par exemple. --open-note=CHEMIN_NOTE Ne fonctionne qu'avec le mode de note unique. Une instance isolée est éxécutée, elle n'a ni accès à au répertoire courant des notes ni à la synchro mais elle peut lire, afficher et écrire la note unique. Si la note n'existe pas, elle est automatiquement créée. Si le nom de la note désigne un fichier ".rtf" ou "texte non formaté", son contenu sera importé dans la dite note qui reprendra le nom stipulé mais au format ".note". Dans ce mode, la note est stockée conformément au chemin précisé et ne sera ni déplacée vers le répertoire courant des notes, ni synchronisée, ni identifiée lors d'une recherche en mode normal. À noter que le paramètre "-o" ou "--open-note" peut être omis : "tomboy-ng ma.note" fonctionne tout aussi bien. --save-exit Importe le fichier (.note, .rtf, texte non formaté), le convertit au format .note (et au format de nom de note standard) puis sauve la note dans le répertoire courant des notes. Aprs avoir passé cette commande, un redémarrage de Tomboy-ng est requis. --debug-sync --debug-index --debug-spell Affiche sur la console les événements demandés de manière détaillée issus de la partie de l'application qui les concerne. La console de Windows ne bénéficie pas de cette fonctinnalité cependant il peut être demandé de diriger les messages de sortie vers un fichier journal en utilisant une autre commande ou en spécifiant une variable d'environnement contenant un nom de fichier. Attention de disposer des droits suffisants. Exemple, presser le logo "start", cliquer sur "exécuter" puis saisir la séquence ci-dessous : tomboy-ng --debug-log=c:\debug.txt --debug-snyc Pour MacOS L'utilisation de la console requiert une syntaxe plus complète dès lors que des paramètres sont ajoutés. Par exemple, journaliser les messages d'un debug de la synchro s'écrivent ainsi : open tomboy-ng.app --args "--debug-log=$HOME/tomboy-ng.log" "--debug-sync" De par l'approche ".app", l'utilisation de paramètres demande que le chemin spécifié soit absolu, sauf à utiliser une variable $PWD relative au repertoire courant : open tomboy-ng/tomboy-ng.app --args "-o" "PWD$/doc/tomboy-ng.note" 2020-11-25T08:25:26.5455611+01:00 2020-11-25T08:25:26.5455611+01:00 2020-11-23T18:33:51.0251392+01:00 1 1 933 947 920 37 False tomboy-ng_0.39-1/doc/HELP/FR/calculator.note0000664000175000017500000000631214551457644020267 0ustar dbannondbannon tomboy-ng Calculator tomboy-ng Calculator Versions of tomboy-ng after V0.20 include an expression calculator. It has three basic modes, all activated by pressing Ctrl-E (or Cmd-E on the Mac) - Simple Calc Mode, you type for example, 6+10= and press Ctrl-E, tomboy-ng will fill in '16' after the equals sign. This will work with any basic numerical calculations, (5*7)/(8.3+12)-0.724=1.000 In this mode, you can use numerals, curved brackets, decimal points and the basic operators, + - / * and ^ (ie power). Complex Calc Mode, if you need to use, say trig functions, the Simple Calc won't find your full expression. So, type the expression, select it and, again, press Ctrl-E. Similar result. In this mode you can use the above mentioned plus pi cos sin tan arctan abs sqr sqrt exp ln log frac int round and trunc. eg sin(0.5)^2 + cos(0.5)^2 =1 Column Mode, will add up a column of numbers in the lines above it. 'A column', in this case means all the numbers that appear at either the beginning of the lines or end of the lines. If there are numbers at both beginning and end of lines, the longer column takes precedence. The first line encounted that does not have a number at the appropriate end stops the column count. You can stop a number being considered by 'hiding' it with an alpha char and, then remove that character after doing the calc. Only numerals and the decimal point are allowed in this mode. Home to Axedale 5.5 Axedale to Bendigo 19 Bendigo to home via O'Briens Road 23 round trip is 47.500 5 some text 7 1 more text 3 blah 4 9 In the above example, the left column is used, it has three eligible numbers, the right column only has one, the '4', there is no number at the end of the "1 more text" line. The expression parser converts to using floating point numbers where necessary and displays its output with 3 digits after the decimal point. It would be easy to add a more flexible model here, one that suppresses trailing zeros and switched to scientific notation if there appears any demand for it. (see floattostrf()). That and the number of decimal places could become config options ? Note in the examples above, I have manually bolded the answers for clarity, it does not happen automatically. 2019-01-29T19:35:51.9370000+11:00 2019-01-29T19:35:51.9370000+11:00 2019-01-15T21:32:06.9620000+11:00 1 1 1000 626 0 0 False tomboy-ng_0.39-1/doc/HELP/FR/key-shortcuts.note0000664000175000017500000001366714551457644020775 0ustar dbannondbannon tomboy-ng Keyboard Shortcuts tomboy-ng Keyboard Shortcuts All Platforms Alt-RightArrow : Turn a bullet point on. Alt-LeftArrow : Turn a bullet point off. Control-1 : Small Font Control-2 : normal font Control-3 : large font Control-4 : huge font Shift-RightArrow - extend selection one char to right Shift-LeftArrow - extend selection one char to left Shift-Click : Select text between existing position and clicked position. Windows / Linux Control-Q : Quit tomboy-ng - On Search, Settings and any Open Note Control-N : New Note - On Search, Settings and any Open Note Control-X : Cut the selected text and copy it to the Clipboard. Control-C : Copy the selected text to the Clipboard. Control-V : Paste the contents of the Clipboard into the current note. Control-A : Select All items. Control-RightArrow : move word to the right. Control-LeftArrow : move word to the left. Control-Shift-LeftArrow - extend selection one word to left Control-Shift-RightArrow - extend selection one word to right Control-F4 : Close current note window. Control-Z : Undo Control-Y : Redo Control-D : Insert date time string, YYYY-MM-DD hh:mm:ss Control-L : Create a link note from selected text. Alt - F4 : Close current note window Fonts Control-B : Bold Control-I : Italics Control-S : Strikeout Control-U : Underline Control-H : Highlight Control-E : Expression calculator - see Calculator help note Find (in a note) Control-F : Find something in a Note. F3 or Ctrl-G : Next in note Find Shift-F3 or Shift-Ctrl-G : Previous in note Find Mac (Where Option key is also the Alt key) Command-Q : Quit tomboy-ng - On Search, Settings and any Open Note Command-N : New Note - On Search, Settings and any Open Note Command-X : Cut the selected text and copy it to the Clipboard. Command-C : Copy the selected text to the Clipboard. Command-V : Paste the contents of the Clipboard into the current note. Command-A : Select All items. Command-F : Open a Find window. Command-RightArrow : go to end of line. Command-LeftArrow : go to start of line. Command-Z : Undo Command-Y : Redo Command-D : Insert date time string, YYYY-MM-DD hh:mm:ss Option-Shift-LeftArrow - extend selection one word to left Option-Shift-RightArrow - extend selection one word to right Fonts Command-B : Bold Command-I : Italics Command-S : Strikeout Command-U : Underline Command-E : Expression calculator - see Calculator help note Option-H : Highlight Find (in a note) Command-F : Find something in a Note. Command-G : Next in note Find Shift-Command-G : Previous in note Find 2021-06-17T13:20:22.4828983+10:00 2021-06-17T13:20:22.4828983+10:00 2018-12-06T21:38:38.0650000+11:00 1 1 1000 626 587 163 False tomboy-ng_0.39-1/doc/HELP/FR/sync-ng.note0000664000175000017500000001611114551457644017512 0ustar dbannondbannon tomboy-ng sync tomboy-ng sync This is about file syncing between Linux, Windows and Mac computers. If you are interested in Github sync, providing both Sync and a access to your notes online from a browser, please see https://github.com/tomboy-notes/tomboy-ng/wiki/Github-Sync Synchronising your tomboy-ng (and/or Tomboy) notes can be a very useful thing. Do it properly and all your notes on all your computers are the same. And you have a backup strategy for your note too ! Remember that the value of syncing is closely related to how often you do it ! tomboy-ng supports file sync. That is, it syncs to a shared file system. That filesystem might be Google Drive, any remote server you can ssh to, a local shared drive at home or even just a USB thumb drive. It works identically between the three supported platforms, Linux, Windows and Mac. Note that tomboy-ng does not (like Tomboy does) connect to a dedicated Tomboy sync service such as Snowy, Rainy or grauphel/NextCloud/Apache. New in v0.27, Auto sync, see further down. OK, before we start, are you keeping snapshots ? If not, why not ??? A shared Filesystem In practise, tomboy-ng will sync to any (?) file system that your file manager can browse. You could use Google Drive, Drop Box or any such system. Don't forget a copy of your notes will live on their server so if you are unhappy at them being read there, maybe that is not a great idea! You may want to setup a NFS or SMB share. Windows and NFS is not a great mix but SMB works well for all three platforms. The author's home network router has a USB slot at the back, a USB Disk Key plugged in there is distributed via SMB. Been working flawlessly for a couple of years. Some Linux File Managers can be reluctant to show you the SMB or Samba shares, it can help to make them a book mark in your main File Manager but if even that does not work, ensure you have gvfs and gvfs-fuse installed and browse using the directory dialog that tomboy-ng pops up to somewhere like /run/user/1000/gvfs/smb_share ..... Or you could even just use a USB Disk Key and plug it into which ever machine you are syncing at the time. As long as tomboy-ng can read and write there, good. One thing to note, if you plan to sync both Tomboy and tomboy-ng with the same repository, Tomboy is not quite so happy with "any shared filesystem", check it before investing too much time. Setting Up A Repository Easy, might be a good idea to create a directory there such as Tomboy-Sync or whatever, tomboy-ng just needs be told where the filesystem is and it will do the rest. In tomboy-ng, click Settings, Sync Tab. Set Sync Type to "File Sync ..." and click "Change File Sync Repo". Browse to the directory you created. tomboy-ng will have a look at the directory and your existing notes (if any) and will generate a report about what it will do. If that looks OK, click "Save and Sync". Done. sshfs to do network sync tomboy-ng can sync quite happily to any remote server that you have ssh access to. The author has a cut price hosting plan with a much neglected website and a few gig of diskspace. Its useful because I can ssh into it ! So, if I can ssh to it, I can use sshfs with it. For example, on a linux machine, I would install sshfs then, initially ssh to this remote server and create a directory called eg TB_Sync, then back on my local machine make a local directory as a mount point and use sshfs to mount the remote share on that point. In tomboy-ng, "Change Sync Repo" and browse to that mount point. cd; mkdir TB_Sync; sshfs myname@remoteserver.com:TB_Sync TB_Sync [enter] Manual Syncing and Clashes From time to time, you need to click the Sync menu entry. A short report will pop up telling what it has done, have a look and close. However, there will almost certainly come a time when you have changed a particular note on more than one machine since your last Sync. Sad but inevitable. Now, the Sync engine does not know what to do. It will show you a list of the differences between the two notes and you can choose to use the Local or Remote version. Remote being the 'remote' file repository. If, even after seeing the differences between the two versions, you still cannot decide, then perhaps you should chose to use the remote. The local one will then be backed up and you can recover it from Settings->Backup. Note, when resolving clashes, there are also several "do all" buttons that will be applied to the remainder of this sync run. Remote, Local, newest, oldest, if you feel brave, click one. Automatic Syncing New on v0.27, tomboy-ng does automatic, behind the scenes syncing. Obviously only if you have setup sync and the necessary shared file system is available. Settings->Sync and tick the box. It will sync about 15 seconds after startup and then as often as you have set. If it encounters a note clash, the usual window will still popup showing the differences between the two notes allowing you to decide. If it cannot sync, because, perhaps, you have disconnected the shared drive, again a popup windows will advise you, you can either fix the problem and press Retry or, if you press Cancel, syncing will not be attempted again until you either restart tomboy-ng or 'bounce' the Auto Sync setting. If you are like me and need constant reassurance that things are working, you can see details of most recent sync in the Search Window's status bar. Rejoining a Repository Tomboy would struggle when you had occasion to re-join a repo you have used in the past. It would spot a whole lot of notes with the same ID but not have the repository data to know how to handle them, they would all be labelled as clashes. To solve this, tomboy-ng looks at the last change date, accurate to the micro second and decides that two notes with the same ID and the same last change date should be assumed to be identical. Its a pretty good bet. Now, this process can be a bit slow so we keep additional data in the remote manifest. However, if you use Tomboy in the same repo, it will drop that extra data and re-joining a repo will be slow. Not a problem, just slower. 2023-12-06T17:46:15.9245866+11:00 2023-12-06T17:46:15.9245866+11:00 2000-01-01T10:00:00.0000000+11:00 1 1 1000 626 181 165 False tomboy-ng_0.39-1/doc/HELP/FR/systray.note0000664000175000017500000000635114551457644017657 0ustar dbannondbannon System Tray on Linux System Tray on Linux Note : the message about not showing the SysTray is usually a false alarm on Ubuntu. Sorry. The normal way that a user interacts with tomboy-ng is via a small yellow icon that appears on the System Tray, sometimes called the notification area. However, not all Linux Desktop Environments are able to display System Tray Icons, and some that can do not do so by default. If you can see a small, yellow icon, possibly upper right of your screen, you don't have a problem, well done in choosing a user focused Desktop. If you cannot see it, you are probably using a Desktop that may not display the System Tray. Firstly, see if your particular Desktop just needs to configured to display a SysTray, failing that, you have a number of alternatives - tint2 Install the very useful tint2 panel. It has no trouble displaying a System Tray on all Linux Desktops that I have tested. It seems to be widely available. Typically, you might type one of the following command in your terminal - sudo yum install tint2 sudo dnf install tint2 sudo apt install tint2 Start tint2 before you start work and if you like that model, add it to your startup applications. Using your dock Gnome 3 typically has a 'dock' down the left side, maybe only visible after you click Activities'. Some other Desktops have similar docks. After starting tomboy-ng (the first time), and before you 'hide' it, find its yellow Icon in your dock. Right click it and choose add to favourites. You can now 'Hide' the tomboy-ng splash screen and activate tomboy-ng at any time directly from the dock. To close tomboy-ng completely, click the tomboy-ng icon in the dock, tomboy-ng's search box opens, click 'Menu' and 'close'. Other Approaches Similarly to the above approach, if you start tomboy-ng and hide it, you can activate it at any time from the Menu you normally use to start an application. In this way, you are not restarting it each time, its always there, the restart attempt just prompts the running instance to pop up its Search Window. There are some Gnome Extensions that you can install to restore a functioning System Tray but especially if you are using Wayland they may be just too hard. But if you are willing to disable wayland and use xorg instead, that just might work. Search for TopIconsPlus. 2021-02-01T18:48:56.2321715+11:00 2021-02-01T18:48:56.2321715+11:00 2021-01-23T13:48:35.2369237+11:00 1 1 912 497 847 292 False tomboy-ng_0.39-1/doc/HELP/FR/recover.note0000664000175000017500000001157414551457644017611 0ustar dbannondbannon Recovering Lost Notes Recovering Lost Notes If you are reading this, odds are you are worried ! So, first bit of advice is don't panic (1) Its quite possible we can help you. That will depend on whats happened and maybe if you have taken a manual snapshot recently. Firstly, don't do a sync, it could replace good data with bad. Next, take small steps. Lets look at the possibilities - I (or the sync) deleted a note I need That just might be easy. We keep a backup copy of every note you manually delete or is overwritten during a sync. But only one copy so if its been synced and overwritten again, its gone. Check by going back to Settings, the Recover tab, click "Show Me", browse through the old notes there and double click a likely candidate. You'll get a dialog that lets you view, delete or recover that note. I have a corrupted note. When you start tomboy-ng, you see a warning about an inability to index a note. That probably means the note's XML has somehow become corrupted (2). The indexing mechanism in tomboy-ng is deliberately very strict in what it will accept, it errors if one field is unobtainable. However, depending on where the XML error in the note is, you may be able to open it and save it with rewritten XML. Do take a snapshot before you start this process. To try this quick fix, you should - From Settings, the Recover tab, click "Manual Snapshot" (to be safe!) then click "Recover lost notes". In this window, under "Bad Notes" is a list of just that. Double click a likely candidate and a new Edit window will open. You may have just recovered at least some content. You're not listening, I have lost all my notes ! OK, I get you, this is serious. But we at have two paths left, lets see - I sync my notes from somewhere else. Oh, that's good. Maybe all you need do is clean out your current notes directory (3) and rejoin the sync network. Note, I emphasise, not just do a sync. You MUST go to the sync tab and click "Set File Sync Repo". That way, the sync system sees you as a new friend and sends you a full set of notes. Just how good an approach this is depends on how recently you last synced, obviously any changes since last sync will be lost. I have a snapshot Great news ! You can easily choose to roll back to a particular snapshot and blow away all your troubles. Too Easy ! If you wisely kept the snapshot elsewhere, copy it to your snapshot directory (shown on the settings -> snapshots tab). From the SnapShot tab, click "Recover one or more lost Notes". If you have not already, now would be a great time to click "Safety Snapshot", you are in seriously dangerous space right now. Go to the "Recover Snapshot" tab, choose the snapshot you wish to use and away you go (4). Back out, go to the Search and click "Refresh". After you have checked all is good, please remember to take a snapshot every now and again ! Notes (1) By Douglas Adams, used without permission. (2) Corrupted notes should never happen, looks like it did. Power failure, program error, whatever. If its my fault, I am sincerely sorry ! Please report this experience to the Tomboy mailing list or Github. The only way I can rid of these problems is if people tell me about them. (3) Tomboy-ng tells you where your notes are stored, go there with a file manager and select all the note files. They are the ones with a 36 apparently random character name and ".note" extension. Only do this if you are a sync user ! (4) If you (wisely) keep a copy elsewhere, bring it back, un-encrypt it if necessary. And, good work ! 2020-11-17T20:33:16.2310674+11:00 2020-11-17T20:33:16.2310674+11:00 2018-08-26T14:03:28.1020000+10:00 1 1 1061 626 76 243 False tomboy-ng_0.39-1/doc/overrides0000644000175000017500000000123514551457644016132 0ustar dbannondbannon# This is the Lintian override file for the tomboy-ng binary. # It ultimatly lives in /usr/share/lintian/overrides # and is called tomboy-ng there. # # tomboy-ng is built using the fpc, not gcc. So use of CPPFLAGS # is not possible. PIE, Read-only relocations and Immediate bindings # are enabled but Fortify Source functions is not. tomboy-ng binary: hardening-no-fortify-functions # Its necessary to use xcb because Wayland does not yet # support a window reporting its screen coordinates nor # opening a window in a particular place. # Therefore, we set an env in the Exec command. # The actual command does follow the env setting. desktop-command-not-in-package tomboy-ng_0.39-1/fpexprpars_addon.pas0000644000175000017500000003401214551457644017503 0ustar dbannondbannonunit fpexprpars_addon; {$mode objfpc}{$H+} interface uses Classes, SysUtils, fpexprpars; Procedure ExprDegToRad(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); Procedure ExprRadToDeg(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); Procedure ExprTan(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); Procedure ExprCot(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); Procedure ExprArcsin(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); Procedure ExprArccos(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); Procedure ExprArccot(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); Procedure ExprCosh(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); Procedure ExprCoth(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); Procedure ExprSinh(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); Procedure ExprTanh(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); Procedure ExprArcosh(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); Procedure ExprArsinh(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); Procedure ExprArtanh(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); Procedure ExprArcoth(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); Procedure ExprSinc(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); Procedure ExprPower(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); Procedure ExprHypot(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); Procedure ExprLog10(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); Procedure ExprLog2(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); Procedure ExprErf(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); Procedure ExprErfc(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); Procedure ExprGammaP(var Result: TFPExpressionResult; Const Args: TExprParameterArray); Procedure ExprGammaQ(var Result: TFPExpressionResult; Const Args: TExprParameterArray); Procedure ExprBetaI(var Result: TFPExpressionResult; Const Args: TExprParameterArray); Procedure ExprChi2Dist(var Result: TFPExpressionResult; Const Args: TExprParameterArray); Procedure ExprtDist(var Result: TFPExpressionResult; const Args: TExprParameterArray); Procedure ExprFDist(var Result: TFPExpressionResult; const Args: TExprParameterArray); Procedure ExprI0(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); Procedure ExprI1(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); Procedure ExprJ0(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); Procedure ExprJ1(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); Procedure ExprK0(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); Procedure ExprK1(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); Procedure ExprY0(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); Procedure ExprY1(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); function FixDecSep(const AExpression: String): String; implementation uses Math, typ, spe; // numlib { Additional functions for the parser } procedure ExprDegToRad(var Result: TFPExpressionResult; const Args: TExprParameterArray); var x: Double; begin x := ArgToFloat(Args[0]); Result.resFloat := degtorad(x); end; procedure ExprRadToDeg(var Result: TFPExpressionResult; const Args: TExprParameterArray); var x: Double; begin x := ArgToFloat(Args[0]); Result.resFloat := radtodeg(x); end; procedure ExprTan(var Result: TFPExpressionResult; const Args: TExprParameterArray); var x: Double; begin x := ArgToFloat(Args[0]); Result.resFloat := tan(x); end; procedure ExprCot(var Result: TFPExpressionResult; const Args: TExprParameterArray); var x: Double; begin x := ArgToFloat(Args[0]); Result.resFloat := cot(x); end; procedure ExprArcsin(var Result: TFPExpressionResult; const Args: TExprParameterArray); var x: Double; begin x := ArgToFloat(Args[0]); Result.resFloat := arcsin(x); end; procedure ExprArccos(var Result: TFPExpressionResult; const Args: TExprParameterArray); var x: Double; begin x := ArgToFloat(Args[0]); Result.resFloat := arccos(x); end; procedure ExprArccot(Var Result: TFPExpressionResult; const Args: TExprParameterArray); var x: Double; begin x := ArgToFloat(Args[0]); Result.resFloat := pi/2 - arctan(x); end; procedure ExprCosh(var Result: TFPExpressionResult; const Args: TExprParameterArray); var x: Double; begin x := ArgToFloat(Args[0]); Result.resFloat := cosh(x); end; { Hyperbolic cotangent coth(x); x <> 0 } procedure ExprCoth(var Result: TFPExpressionResult; const Args: TExprParameterArray); var x: Double; begin x := ArgToFloat(Args[0]); Result.resFloat := 1/tanh(x); end; procedure ExprSinh(var Result: TFPExpressionResult; const Args: TExprParameterArray); var x: Double; begin x := ArgToFloat(Args[0]); Result.resFloat := sinh(x); end; procedure ExprTanh(var Result: TFPExpressionResult; const Args: TExprParameterArray); var x: Double; begin x := ArgToFloat(Args[0]); Result.resFloat := tanh(x); end; procedure ExprArcosh(var Result: TFPExpressionResult; const Args: TExprParameterArray); var x: Double; begin x := ArgToFloat(Args[0]); Result.resFloat := arcosh(x); end; procedure ExprArsinh(var Result: TFPExpressionResult; const Args: TExprParameterArray); var x: Double; begin x := ArgtoFloat(Args[0]); Result.resFloat := arsinh(x); end; procedure ExprArtanh(var Result: TFPExpressionResult; const Args: TExprParameterArray); var x: Double; begin x := ArgToFloat(Args[0]); Result.resFloat := artanh(x); end; procedure ExprArcoth(var Result: TFPExpressionResult; const Args: TExprParameterArray); var x: Double; begin x := ArgToFloat(Args[0]); Result.resFloat := artanh(1.0/x); end; procedure ExprSinc(var Result: TFPExpressionResult; const Args: TExprParameterArray); var x: Double; begin x := ArgToFloat(Args[0]); if x = 0 then Result.ResFloat := 1.0 else Result.resFloat := sin(x)/x; end; procedure ExprPower(var Result: TFPExpressionResult; const Args: TExprParameterArray); var x,y: Double; begin x := ArgToFloat(Args[0]); y := ArgToFloat(Args[1]); Result.resFloat := Power(x, y); end; procedure ExprLg(var Result: TFPExpressionResult; const Args: TExprParameterArray); var x: Double; begin x := ArgToFloat(Args[0]); Result.resFloat := log10(x); end; procedure ExprLog10(var Result: TFPExpressionResult; const Args: TExprParameterArray); var x: Double; begin x := ArgToFloat(Args[0]); Result.resFloat := log10(x); end; procedure ExprLog2(var Result: TFPExpressionResult; const Args: TExprParameterArray); var x: Double; begin x := ArgToFloat(Args[0]); Result.resFloat := log2(x); end; procedure ExprMax(var Result: TFPExpressionResult; const Args: TExprParameterArray); var x1, x2: Double; begin x1 := ArgToFloat(Args[0]); x2 := ArgToFloat(Args[1]); Result.resFloat := Max(x1, x2); end; procedure ExprMin(var Result: TFPExpressionResult; const Args: TExprParameterArray); var x1, x2: Double; begin x1 := ArgToFloat(Args[0]); x2 := ArgToFloat(Args[1]); Result.resFloat := Min(x1, x2); end; Procedure ExprHypot(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); var x,y: Double; begin x := ArgToFloat(Args[0]); y := ArgToFloat(Args[1]); Result.resFloat := Hypot(x,y); end; Procedure ExprErf(Var Result: TFPExpressionResult; const Args: TExprParameterArray); // Error function var x: Double; begin x := ArgToFloat(Args[0]); Result.resFloat := speerf(x); end; Procedure ExprErfc(Var Result: TFPExpressionResult; const Args: TExprParameterArray); // Error function complement var x: Double; begin x := ArgToFloat(Args[0]); Result.resFloat := speefc(x); end; // Incomplete gamma function P Procedure ExprGammaP(var Result: TFPExpressionResult; Const Args: TExprParameterArray); var x, s: Double; begin s := ArgToFloat(Args[0]); x := ArgToFloat(Args[1]); Result.resFloat := gammap(s, x); end; // Incomplete gamma function Q Procedure ExprGammaQ(var Result: TFPExpressionResult; Const Args: TExprParameterArray); var x, s: Double; begin s := ArgToFloat(Args[0]); x := ArgToFloat(Args[1]); Result.resFloat := gammaq(s, x); end; // Incomplete beta function Procedure ExprBetaI(var Result: TFPExpressionResult; Const Args: TExprParameterArray); var a, b, x: Double; begin a := ArgToFloat(Args[0]); b := ArgToFloat(Args[1]); x := ArgToFloat(Args[2]); Result.resFloat := betai(a, b, x); end; Procedure ExprChi2Dist(var Result: TFPExpressionResult; const Args: TExprParameterArray); var x: Double; n: Double; begin x := ArgToFloat(Args[0]); n := ArgToFloat(Args[1]); Result.resFloat := chi2dist(x, round(n)); end; Procedure ExprtDist(var Result: TFPExpressionResult; const Args: TExprParameterArray); var x: Double; n: Double; begin x := ArgToFloat(Args[0]); n := ArgToFloat(Args[1]); Result.resFloat := tdist(x, round(n), 2); end; Procedure ExprFDist(var Result: TFPExpressionResult; const Args: TExprParameterArray); var x: Double; n1, n2: Double; begin x := ArgToFloat(Args[0]); n1 := ArgToFloat(Args[1]); n2 := ArgToFloat(Args[2]); Result.resFloat := Fdist(x, round(n1), round(n2)); end; Procedure ExprI0(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); // Bessel function of the first kind I0(x) var x: Double; begin x := ArgToFloat(Args[0]); Result.resFloat := spebi0(x); end; Procedure ExprI1(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); // Bessel function of the first kind I1(x) var x: Double; begin x := ArgToFloat(Args[0]); Result.resFloat := spebi1(x); end; Procedure ExprJ0(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); // Bessel function of the first kind J0(x) var x: Double; begin x := ArgToFloat(Args[0]); Result.resFloat := spebj0(x); end; Procedure ExprJ1(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); // Bessel function of the first kind J1(x) var x: Double; begin x := ArgToFloat(Args[0]); Result.resFloat := spebj1(x); end; Procedure ExprK0(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); // Bessel function of the second kind K0(x) var x: Double; begin x := ArgToFloat(Args[0]); Result.resFloat := spebk0(x); end; Procedure ExprK1(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); // Bessel function of the second kind K1(x) var x: Double; begin x := ArgToFloat(Args[0]); Result.resFloat := spebk1(x); end; Procedure ExprY0(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); // Bessel function of the second kind Y0(x) var x: Double; begin x := ArgToFloat(Args[0]); Result.resFloat := speby0(x); end; Procedure ExprY1(Var Result: TFPExpressionResult; Const Args: TExprParameterArray); // Bessel function of the second kind Y1(x) var x: Double; begin x := ArgToFloat(Args[0]); Result.resFloat := speby1(x); end; function FixDecSep(const AExpression: String): String; var i: Integer; begin Result := AExpression; for i:=1 to Length(Result) do begin if Result[i] = ',' then Result[i] := '.'; end; end; //--------------------- procedure RegisterExprParserAddons; begin with BuiltinIdentifiers do begin AddFunction(bcMath, 'degtorad', 'F', 'F', @ExprDegtorad); AddFunction(bcMath, 'radtodeg', 'F', 'F', @ExprRadtodeg); AddFunction(bcMath, 'tan', 'F', 'F', @ExprTan); AddFunction(bcMath, 'cot', 'F', 'F', @ExprCot); AddFunction(bcMath, 'arcsin', 'F', 'F', @ExprArcSin); AddFunction(bcMath, 'arccos', 'F', 'F', @ExprArcCos); AddFunction(bcMath, 'arccot', 'F', 'F', @ExprArcCot); AddFunction(bcMath, 'cosh', 'F', 'F', @ExprCosh); AddFunction(bcMath, 'coth', 'F', 'F', @ExprCoth); AddFunction(bcMath, 'sinh', 'F', 'F', @ExprSinh); AddFunction(bcMath, 'tanh', 'F', 'F', @ExprTanh); AddFunction(bcMath, 'arcosh', 'F', 'F', @ExprArcosh); AddFunction(bcMath, 'arsinh', 'F', 'F', @ExprArsinh); AddFunction(bcMath, 'artanh', 'F', 'F', @ExprArtanh); AddFunction(bcMath, 'arcoth', 'F', 'F', @ExprArcoth); AddFunction(bcMath, 'sinc', 'F', 'F', @ExprSinc); AddFunction(bcMath, 'power', 'F', 'FF', @ExprPower); AddFunction(bcMath, 'hypot', 'F', 'FF', @ExprHypot); AddFunction(bcMath, 'lg', 'F', 'F', @ExprLog10); AddFunction(bcMath, 'log10', 'F', 'F', @ExprLog10); AddFunction(bcMath, 'log2', 'F', 'F', @ExprLog2); // Error function AddFunction(bcMath, 'erf', 'F', 'F', @ExprErf); AddFunction(bcMath, 'erfc', 'F', 'F', @ExprErfc); // Incomplete gamma and beta functions AddFunction(bcMath, 'gammap', 'F', 'FF', @ExprGammaP); AddFunction(bcMath, 'gammaq', 'F', 'FF', @ExprGammaQ); AddFunction(bcMath, 'betai', 'F', 'FFF', @ExprBetaI); // Probability distributions AddFunction(bcMath, 'chi2dist', 'F', 'FI', @ExprChi2Dist); AddFunction(bcMath, 'tdist', 'F', 'FI', @Exprtdist); AddFunction(bcMath, 'Fdist', 'F', 'FII', @ExprFDist); // Bessel functions of the first kind AddFunction(bcMath, 'I0', 'F', 'F', @ExprI0); AddFunction(bcMath, 'I1', 'F', 'F', @ExprI1); AddFunction(bcMath, 'J0', 'F', 'F', @ExprJ0); AddFunction(bcMath, 'J1', 'F', 'F', @ExprJ1); // Bessel functions of the second kind AddFunction(bcMath, 'K0', 'F', 'F', @ExprK0); AddFunction(bcMath, 'K1', 'F', 'F', @ExprK1); AddFunction(bcMath, 'Y0', 'F', 'F', @ExprY0); AddFunction(bcMath, 'Y1', 'F', 'F', @ExprY1); end; end; initialization RegisterExprParserAddons; end. tomboy-ng_0.39-1/source/0000755000175000017500000000000014551457644014737 5ustar dbannondbannontomboy-ng_0.39-1/source/searchunit.lrj0000644000175000017500000000531114551457644017615 0ustar dbannondbannon{"version":1,"strings":[ {"hash":234232728,"name":"tsearchform.caption","sourcebytes":[116,111,109,98,111,121,45,110,103,95,83,101,97,114,99,104],"value":"tomboy-ng_Search"}, {"hash":90721265,"name":"tsearchform.panel1.caption","sourcebytes":[80,97,110,101,108,49],"value":"Panel1"}, {"hash":4860802,"name":"tsearchform.buttonclearfilters.caption","sourcebytes":[67,108,101,97,114],"value":"Clear"}, {"hash":78352483,"name":"tsearchform.listboxnotebooks.hint","sourcebytes":[82,105,103,104,116,32,67,108,105,99,107,32,116,111,32,109,97,110,97,103,101,32,78,111,116,101,98,111,111,107,115],"value":"Right Click to manage Notebooks"}, {"hash":179900739,"name":"tsearchform.panel2.caption","sourcebytes":[78,111,116,101,98,111,111,107,115],"value":"Notebooks"}, {"hash":4860802,"name":"tsearchform.buttonclearsearch.caption","sourcebytes":[67,108,101,97,114],"value":"Clear"}, {"hash":343125,"name":"tsearchform.bitbtnmenu.caption","sourcebytes":[77,101,110,117],"value":"Menu"}, {"hash":108725763,"name":"tsearchform.buttonsearchoptions.caption","sourcebytes":[79,112,116,105,111,110,115],"value":"Options"}, {"hash":89337013,"name":"tsearchform.menueditnotebooktemplate.caption","sourcebytes":[69,100,105,116,32,78,111,116,101,98,111,111,107,32,84,101,109,112,108,97,116,101],"value":"Edit Notebook Template"}, {"hash":73518027,"name":"tsearchform.menudeletenotebook.caption","sourcebytes":[68,101,108,101,116,101,32,78,111,116,101,98,111,111,107],"value":"Delete Notebook"}, {"hash":36223435,"name":"tsearchform.menurenamenotebook.caption","sourcebytes":[82,101,110,97,109,101,32,78,111,116,101,98,111,111,107],"value":"Rename Notebook"}, {"hash":173784437,"name":"tsearchform.menunewnotefromtemplate.caption","sourcebytes":[67,114,101,97,116,101,32,78,101,119,32,78,111,116,101,32,102,114,111,109,32,84,101,109,112,108,97,116,101],"value":"Create New Note from Template"}, {"hash":21545019,"name":"tsearchform.menuitemmanagenbook.caption","sourcebytes":[77,97,110,97,103,101,32,78,111,116,101,115,32,105,110,32,78,111,116,101,98,111,111,107],"value":"Manage Notes in Notebook"}, {"hash":191671259,"name":"tsearchform.menucreatenotebook.caption","sourcebytes":[67,114,101,97,116,101,32,110,101,119,32,78,111,116,101,98,111,111,107],"value":"Create new Notebook"}, {"hash":154437957,"name":"tsearchform.menuitemimportnote.caption","sourcebytes":[73,109,112,111,114,116,32,70,105,108,101],"value":"Import File"}, {"hash":219680245,"name":"tsearchform.menuitemcasesensitive.caption","sourcebytes":[67,97,115,101,32,83,101,110,115,105,116,105,118,101],"value":"Case Sensitive"}, {"hash":16665029,"name":"tsearchform.menuitemswyt.caption","sourcebytes":[83,101,97,114,99,104,32,87,104,105,108,101,32,89,111,117,32,84,121,112,101],"value":"Search While You Type"} ]} tomboy-ng_0.39-1/source/tb_symbol.lfm0000644000175000017500000000514114551457644017432 0ustar dbannondbannonobject FormSymbol: TFormSymbol Left = 192 Height = 372 Top = 452 Width = 685 Caption = 'Symbol' ClientHeight = 372 ClientWidth = 685 OnCreate = FormCreate LCLVersion = '2.2.0.2' object StringGrid1: TStringGrid AnchorSideLeft.Control = Owner AnchorSideTop.Control = Owner AnchorSideBottom.Control = Owner AnchorSideBottom.Side = asrBottom Left = 10 Height = 352 Top = 10 Width = 136 Anchors = [akTop, akLeft, akBottom] BorderSpacing.Left = 10 BorderSpacing.Top = 10 BorderSpacing.Bottom = 10 ColCount = 2 Columns = < item ReadOnly = True Title.Caption = 'Title' Width = 30 end item Title.Caption = 'Title' Width = 100 end> FixedCols = 0 FixedRows = 0 Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goEditing, goAlwaysShowEditor, goSmoothScroll] RowCount = 10 TabOrder = 0 OnSetEditText = StringGrid1SetEditText end object BitBtnCancel: TBitBtn AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = Owner AnchorSideBottom.Side = asrBottom Left = 575 Height = 31 Top = 331 Width = 100 Anchors = [akRight, akBottom] BorderSpacing.Right = 10 BorderSpacing.Bottom = 10 Cancel = True DefaultCaption = True Kind = bkCancel ModalResult = 2 TabOrder = 1 end object BitBtnOK: TBitBtn AnchorSideRight.Control = BitBtnCancel AnchorSideBottom.Control = Owner AnchorSideBottom.Side = asrBottom Left = 475 Height = 31 Top = 331 Width = 100 Anchors = [akRight, akBottom] BorderSpacing.Bottom = 10 Default = True DefaultCaption = True Kind = bkOK ModalResult = 1 OnClick = BitBtnOKClick TabOrder = 2 end object BitBtnRevert: TBitBtn AnchorSideRight.Control = BitBtnOK AnchorSideBottom.Control = Owner AnchorSideBottom.Side = asrBottom Left = 375 Height = 31 Top = 331 Width = 100 Anchors = [akRight, akBottom] BorderSpacing.Bottom = 10 Caption = 'Revert' Kind = bkRetry OnClick = BitBtnRevertClick TabOrder = 3 end object Label1: TLabel Left = 184 Height = 21 Top = 160 Width = 53 Caption = 'Label1' end object Label2: TLabel Left = 184 Height = 21 Top = 192 Width = 53 Caption = 'Label2' end object Label3: TLabel Left = 184 Height = 21 Top = 224 Width = 53 Caption = 'Label3' Font.Style = [fsUnderline] ParentFont = False OnClick = Label3Click end end tomboy-ng_0.39-1/source/tb_sdiff.pas0000644000175000017500000003103514551457644017226 0ustar dbannondbannonunit TB_SDiff; { Copyright (C) 2017-2020 David Bannon License: This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html ------------------ A unit that can display differences between two similar notes. User can choose to use First (Remote) or Second (Local) // Use Remote, Yellow is mrYes, File1 // Use Local, Aqua is mrNo, File2 // Always Use Local is mrNoToAll // Always Use Remote is mrYesToAll // Always use newest mrAll // Always use oldest mrClose // Anything else is DoNothing - no, do not permit donothing } { History 2018/08/14 Added to project 2018/09/17 Changes to work with new sync model. We now just use the two file names in TClashRec and we get the last-change-dates our selves. Should be compatible with old sync model .... 2018/10/16 Options to apply choice to all notes. 2019/10/17 Trap exception if, for some reason, we cannot load one of the note files. } {$mode objfpc}{$H+} interface uses Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls, ComCtrls, Buttons, kmemo, menus; type { TFormSDiff } TFormSDiff = class(TForm) BitBtnUseRemote: TBitBtn; BitBtnUseLocal: TBitBtn; ButtAllOldest: TButton; ButtAllNewest: TButton; ButtAllLocal: TButton; ButtAllRemote: TButton; KMemo1: TKMemo; Label1: TLabel; LabelRemote: TLabel; LabelLocal: TLabel; Label3: TLabel; Label4: TLabel; Panel1: TPanel; RadioLong: TRadioButton; RadioShort: TRadioButton; procedure FormShow(Sender: TObject); procedure KMemo1Change(Sender: TObject); procedure RadioLongChange(Sender: TObject); private procedure AddDiffText(DiffText : string; NoteNo : integer = 0); procedure AddHeader(Title: string); {Returns 0 if no further sync works, 1 or 2 depending on which does sync eg 1 means you should go incrementing 1 until it looks like 2 in other words, '1' means 1 can be matched. 2 must have been an insert. } function CanResync(const SL1, SL2: TStringList; const Spot1, Spot2, End1, End2: integer ): integer; procedure CheckFiles(); //function GetDateFromStr(const DateStr: ANSIString): TDateTime; //function GetNoteChangeGMT(const FullFileName: ANSIString; out LastChange: ANSIString): TDateTime; procedure GotoEnd(const NoteNo : integer; const SL: TStringList; const Spot, TheEnd: integer); function RemoveXml(const St: AnsiString): AnsiString; // Returns a new (synced) Pos, showing intermediate lines. function Resync(const Target : string; NoteNo : integer; const SL : TStringList; var Spot : integer) : integer; public RemoteFileName : string; // #1 LocalFileName : string; // #2 NoteTitle : string; end; //var // FormSDiff: TFormSDiff; implementation {$R *.lfm} uses LazLogger, laz2_DOM, laz2_XMLRead, LazFileUtils, DateUtils, syncutils, tb_utils; { TFormSDiff } function TFormSDiff.RemoveXml(const St : AnsiString) : AnsiString; var X, Y : integer; FoundOne : boolean = false; begin Result := St; repeat FoundOne := False; X := Pos('<', Result); // don't use UTF8Pos for byte operations if X > 0 then begin Y := Pos('>', Result); if Y > 0 then begin Delete(Result, X, Y-X+1); FoundOne := True; end; end; until not FoundOne; Result := trim(Result); end; procedure TFormSDiff.AddDiffText(DiffText : string; NoteNo : integer = 0); var TB, TBPre: TKMemoTextBlock; begin // TB.TextStyle.Font.Size := 16; if NoteNo > 0 then begin TBpre := KMemo1.Blocks.AddTextBlock(inttostr(NoteNo) + '> '); //TBpre.TextStyle.Font.Style := TBpre.TextStyle.Font.Style + [fsBold]; TBpre.TextStyle.Font.Style := [fsBold]; end; if RadioShort.Checked then TB := KMemo1.Blocks.AddTextBlock(Copy(DiffText, 1, 50)) else TB := KMemo1.Blocks.AddTextBlock(DiffText); if NoteNo = 1 then TB.TextStyle.Brush.Color := BitBtnUseRemote.Color; if NoteNo = 2 then TB.TextStyle.Brush.Color := BitBtnUseLocal.Color; KMemo1.blocks.AddParagraph(); end; procedure TFormSDiff.AddHeader(Title : string); var TB: TKMemoTextBlock; begin KMemo1.Clear(False); TB := KMemo1.Blocks.AddTextBlock(Title); TB.TextStyle.Font.Size := 16; TB.TextStyle.Font.Style := [fsBold]; KMemo1.blocks.AddParagraph(); end; function TFormSDiff.CanResync(const SL1, SL2 : TStringList; const Spot1, Spot2, End1, End2 : integer) : integer; var Offset : integer; begin Result := 0; for Offset := Spot1 to End1 do if RemoveXML(SL1[Offset]) = RemoveXML(SL2[Spot2]) then exit(1); for Offset := Spot2 to End2 do if RemoveXML(SL2[Offset]) = RemoveXML(SL1[Spot1]) then exit(2); end; // Returns a new (synced) Pos, showing intermediate lines. function TFormSDiff.Resync(const Target : string; NoteNo : integer; const SL : TStringList; var Spot : integer) : integer; begin Result := Spot; while RemoveXML(Target) <> RemoveXML(SL[Result]) do begin AddDiffText(RemoveXML(SL[Result]), NoteNo); inc(Result); end; end; procedure TFormSDiff.GotoEnd(const NoteNo : integer; const SL : TStringList; const Spot, TheEnd : integer); var I : integer; begin for I := Spot to TheEnd - 1 do AddDiffText(RemoveXML(SL[I]), NoteNo); end; procedure TFormSDiff.FormShow(Sender: TObject); var TestDate: TDateTime; //LastChange : string; ErrorSt : string; begin LabelLocal.Caption := GetNoteLastChangeSt(LocalFileName, ErrorSt); if ErrorSt <> '' then ShowMessage(ErrorSt); if not MyTryISO8601ToDate(LabelLocal.Caption, TestDate, False) then Showmessage('Invalid last sync date in local version of note'); LabelRemote.Caption := GetNoteLastChangeSt(RemoteFileName, ErrorSt); if ErrorSt <> '' then ShowMessage(ErrorSt); if not MyTryISO8601ToDate(LabelLocal.Caption, TestDate, False) then Showmessage('Invalid last sync date in remote version of note'); // Go and get Title and last-change-date from both versions of note (* TestDate := GetNoteChangeGMT(LocalFileName, LastChange); if (TestDate > now()) or (TestDate < (Now() - 36500)) then // TDateTime has integer part no. of days, fraction part is fraction of day. // we have here in the future or more than 100years ago - Fail ! // +++++++++++++++++++++++++++++++++++++++++++++++++ // ToDo : this is wrong, see how to do it in sync // +++++++++++++++++++++++++++++++++++++++++++++++++ Showmessage('Invalid last sync date in local version of note') else LabelLocal.Caption := LastChange; GetNoteChangeGMT(RemoteFileName, LastChange); if (TestDate > now()) or (TestDate < (Now() - 36500)) then Showmessage('Invalid last sync date in remote version of note') else LabelRemote.Caption := LastChange; *) CheckFiles(); end; procedure TFormSDiff.KMemo1Change(Sender: TObject); begin end; (* function TFormSDiff.GetNoteChangeGMT(const FullFileName : ANSIString; out LastChange : ANSIString) : TDateTime; var Doc : TXMLDocument; Node : TDOMNode; begin if not FileExistsUTF8(FullFileName) then begin DebugLn('ERROR - File not found, cant read note change date for ', FullFileName); Result := 0.0; exit(); end; try ReadXMLFile(Doc, FullFileName); Node := Doc.DocumentElement.FindNode('last-change-date'); LastChange := Node.FirstChild.NodeValue; finally Doc.free; // xml errors are caught in calling process end; Result := GetDateFromStr(LastChange); end; function TFormSDiff.GetDateFromStr(const DateStr: ANSIString): TDateTime; var TimeZone : TDateTime; begin try if not TryEncodeTimeInterval(strtoint(copy(DateStr, 29, 2)), // Hour strtoint(copy(DateStr, 32, 2)), // Minutes 0, // Seconds 0, // mSeconds TimeZone) then DebugLn('Fail on interval encode '); except on EConvertError do begin DebugLn('FAIL on converting time interval ' + DateStr); DebugLn('Hour ', copy(DateStr, 29, 2), ' minutes ', copy(DateStr, 32, 2)); end; end; try if not TryEncodeDateTime(strtoint(copy(DateStr, 1, 4)), // Year strtoint(copy(DateStr, 6, 2)), // Month strtoint(copy(DateStr, 9, 2)), // Day strtoint(copy(DateStr, 12, 2)), // Hour strtoint(copy(DateStr, 15, 2)), // Minutes strtoint(copy(DateStr, 18, 2)), // Seconds strtoint(copy(DateStr, 21, 3)), // mSeconds Result) then DebugLn('Fail on date time encode '); except on EConvertError do begin DebugLn('FAIL on converting date time ' + DateStr); end; end; try if DateStr[28] = '+' then Result := Result - TimeZone else if DateStr[28] = '-' then Result := Result + TimeZone else debugLn('******* Bugger, we are not parsing DATE String - Please Report ********'); except on EConvertError do begin DebugLn('FAIL on calculating GMT ' + DateStr); end; end; { debugln('Date is ', DatetoStr(Result), ' ', TimetoStr(Result)); } end; *) procedure TFormSDiff.RadioLongChange(Sender: TObject); begin CheckFiles(); end; const LinesXML = 16; // bit arbitary, seems notes have about 16 lines of XML header and footer procedure TFormSDiff.CheckFiles(); var SL1, SL2 : TStringList; Pos1, Pos2, Offset1, Offset2, End1, End2 : integer; Sync : Integer; begin Pos1 := 0; Pos2 := 0; Offset2 := 0; Offset1 := 0; SL1 := TStringList.create; // This may generate a EFOpenError !! SL2 := TStringList.create; // This may generate a EFOpenError !! try // open the two files and find their beginnings and ends of content try SL1.LoadFromFile(RemoteFileName); except on E: EFOpenError do debugln('Unable to find remote file in repo ' + RemoteFileName); end; try SL2.LoadFromFile(LocalFileName); except on E: EFOpenError do debugln('Unable to find local file ' + LocalFileName); end; AddHeader(NoteTitle); AddDiffText('Remote File ' + inttostr(SL1.Count-LinesXML) + ' lines ', 1); AddDiffText('Local File ' + inttostr(SL2.Count-LinesXML) + ' lines ', 2); while (Pos1 < SL1.Count) and (0 = pos('GH->TB cycle). HISTORY 2020-12-22 Extracted from the NextCloud Notes Branch 2020-??-?? Moved the Normalising code into a stand alone unit. 2021/06/15 Format lines that are all mono differenly so they show as a block. 2021/06/29 Merged this file back to tomboy-ng 2021/07/22 Make GetMDcontent more tolerent of passed ID/FFN 2021/07/30 Now use someutuls fro tb_util instead of implementing itself. Must sync to TB-NG 2021/07/30 Use the RemoveNoteMetaData( from TT_Utils, need merge TT_utils with TB_Utils 2021/08/19 Rewrite ProcessMarkup to use ST.Replace() approach 2021/09/28 Enabled multilevel bullets 2021/10/17 Rewrite most of monospace code. 2022/10/17 Remove underline tags around Title when exporting, confuses Importer. } interface uses Classes, SysUtils; type { TExportCommon } TExportCommon = class private {returns -1 if there is not a tag starting at index (1 based), else ret length of tag if there is a tag but its not the one we want. Ret 0 if right tag found.} function CheckForTag(index: integer; const Tag, St: string): integer; function ConvertBullets(Str: string): string; function ConvertMono(var InSt: string): boolean; function FindInStringList(const StL: TStringList; const FindMe: string): integer; // Make content suitable to write out as a PO file, no merging is going to happen ! procedure ProcessHeadings(StL: TStringList); procedure ProcessMarkUp(StL: TStringList); public DebugMode : boolean; NotesDir : string; // dir were we expect to find our TB notes // Takes a note ID (no extension) or a FFN inc path and .note // and fills out the passed StringList that must have been created) // with a commonmark version of the note. // returns an empty list on error. function GetMDcontent(ID : string; STL : TstringList) : boolean; end; implementation uses LazFileUtils{$ifdef LCL}, lazlogger {$endif}, laz2_DOM, laz2_XMLRead, notenormal, tb_utils; function TExportCommon.GetMDcontent(ID : string; STL : TStringList): boolean; var Normaliser : TNoteNormaliser; begin if FileExists(ID) then StL.LoadFromFile(ID) else if FileExists(NotesDir + ID + '.note') then StL.LoadFromFile(NotesDir + ID + '.note') else exit(False); // OK, now first line contains the title but some lines may have tags wrong side of \n, so Normalise Normaliser := TNoteNormaliser.Create; Normaliser.NormaliseList(StL); Normaliser.Free; StL.Delete(0); STL.Insert(0, GetTitleFromFFN(NotesDir + ID + '.note', False)); RemoveNoteMetaData(STL); ProcessHeadings(StL); // Makes Title big too ! ProcessMarkUp(StL); result := (Stl.Count > 2); end; function TExportCommon.FindInStringList(const StL : TStringList; const FindMe : string) : integer; var I : integer = 0; begin while i < StL.Count -1 do begin if pos(FindMe, StL.strings[i]) > 0 then exit(i); inc(i); end; result := -1; end; {We have to deal with two sorts of mono, full line where we apply 4 spaces to left and in-line where we use back ticks. A four leading space line can have additional spaces and they are preserved. The 'four' is my choice, when converting back, I'll assume, if there are at least four its mono, tag it up and remove first four spaces. No other codes are allowed on that line including backticks. A full line mono is a line that has text, has the mono html tags at beginning and end of line. But other tags and whitespace are allowed between the start and mono tag and between the and end of line. github will only display other font styles with mono if we use back tick and then only if the other tags appear, initiall, before the backtick, thus **`bold mono`** As the backtick looks very ugly in a block, I will use it only in-line and therefore leading space mono will need to be stripped of any other enhancements. } function TExportCommon.CheckForTag(index : integer; const Tag, St : string) : integer; begin if (St.Length < Index) or (St[Index] <> '<') then exit(-1); if copy(St, Index, Tag.Length) = Tag then exit(0); // OK, so it should be a tag but not the one we want. Result := 1; while (St.Length >= (Index + Result)) do begin if St[Index+Result] = '>' then exit(Result+1); inc(Result); end; result := -1; end; function TExportCommon.ConvertMono(var InSt : string) : boolean; var St : string; RetValue, i : integer; begin result := false; if pos('', InSt) > 0 then begin // Lists have priority over Mono InSt := InSt.Replace('', '`', [rfReplaceAll]); InSt := inSt.Replace('', '`', [rfReplaceAll]); end; if (pos('', InSt) = 0) or (pos('', inSt) = 0) then exit; St := InSt; i := 1; while St.Length >= i do if St[i] = ' ' then inc(i) else break; // whitespace allowed and retained RetValue := CheckForTag(i, '', St); // start with first non-space we find while RetValue > 0 do begin St := St.Remove(i, RetValue); // Remove any tags that appear before RetValue := CheckForTag(i, '', St); end; if RetValue <> 0 then begin InSt := InSt.Replace('', '`', [rfReplaceAll]); InSt := inSt.Replace('', '`', [rfReplaceAll]); exit; end; // OK, we now have a leading mono tag, i points to its start, add 11 for next char after tag i := St.IndexOf('<', i+11-1) +1; // we know there is at least one there. RetValue := CheckForTag(i, '', St); // one based while RetValue > 0 do begin // a non-target tag, remove St := St.Remove(i-1, RetValue); // zero based RetValue := St.IndexOf('<', i) +1; // 0 based. Can we find another ? if RetValue > 0 then begin // i remains one based. i := RetValue; RetValue := CheckForTag(i, '', St); end; end; // OK, here i should be pointing to , add tag length and clear away any trailing tags // i := pos('', St) + 12; // must still be there. i := i + 12; // length tag RetValue := CheckForTag(i, '', St); // only interested in pos or neg numbers while RetValue > 0 do begin St := St.Remove(i-1, RetValue); // remove is zero based. RetValue := CheckForTag(i-1, '', St); // Kek ? why -1 ????? end; if St.Length < i then begin St := St.Replace('', '', [rfReplaceAll]); St := St.Replace('', '', [rfReplaceAll]); InSt := ' ' + St; // yes, we passed all the tests, change to leading space mono Result := true; // ToDo - should i remove any tags between and ? end else begin InSt := InSt.Replace('', '`', [rfReplaceAll]); InSt := inSt.Replace('', '`', [rfReplaceAll]); end; //writeln(InSt); end; // This version uses the CommonMark model of noting heading with ---- ===== on line underneath procedure TExportCommon.ProcessHeadings(StL : TStringList); var i : integer = 1; PosI, L : integer; AddedHeading : Boolean = false; begin // The Title will be wrapped with underline tags, upsets import, get rid of them STL[0] := (STL[0]).Replace('', ''); STL[0] := (STL[0]).Replace('', ''); // We now have a clean title in first st, lets mark it up as really big. StL.Insert(1, '==========='); repeat inc(i); if not AddedHeading then begin // this adds a blank line between paras, MD style StL.Insert(i, ''); inc(i); end; AddedHeading := False; if (StL.Strings[i] = '') or (StL.strings[i][1] <> '<') then continue; if copy(Stl.Strings[i], 1, length('')) = '' then begin PosI := pos('', Stl.Strings[i]); if PosI = 0 then continue; L := length(Stl.Strings[i]); if PosI -1 + length('') = L then begin StL.insert(i, copy(Stl.Strings[i], length('')+1, L - length(''))); StL.Delete(i+1); inc(i); StL.Insert(i, '--------'); AddedHeading := True; end; end; if copy(Stl.Strings[i], 1, length('')) = '' then begin PosI := pos('', Stl.Strings[i]); if PosI = 0 then continue; L := length(Stl.Strings[i]); if PosI -1 + length('') = L then begin StL.insert(i, copy(Stl.Strings[i], length('')+1, L - length(''))); StL.Delete(i+1); inc(i); StL.Insert(i, '========'); AddedHeading := True; end; end; until I >= StL.Count-1; end; // This version does heading in the leading ### model (* procedure TExportNote.ProcessHeadings(StL : TStringList); var i : integer = -1; PosI, L : integer; //Blar : string; begin repeat inc(i); if (StL.Strings[i] = '') or (StL.strings[i][1] <> '<') then continue; if copy(Stl.Strings[i], 1, length('')) = '' then begin //blar := Stl.Strings[i]; PosI := pos('', Stl.Strings[i]); if PosI = 0 then continue; L := length(Stl.Strings[i]); if PosI -1 + length('') = L then begin StL.insert(i, '### ' + copy(Stl.Strings[i], length('')+1, L - length(''))); StL.Delete(i+1); end; end; if copy(Stl.Strings[i], 1, length('')) = '' then begin //blar := Stl.Strings[i]; PosI := pos('', Stl.Strings[i]); if PosI = 0 then continue; L := length(Stl.Strings[i]); if PosI -1 + length('') = L then begin StL.insert(i, '## ' + copy(Stl.Strings[i], length('')+1, L - length(''))); StL.Delete(i+1); end; end; until I >= StL.Count-1; end; *) { must convert upto level 6 bullets to md. We use 3 spaces, ahead of marker to indicate each level. In the xml, each level is indicated by an additional wrap of CONTENT. Must start with the deepest bullet and work back up. } function TExportCommon.ConvertBullets(Str : string) : string; var Pre, Post, Spaces : string; i : integer = 5; j : integer; begin Result := Str; while i >= 0 do begin Pre := ''; Post := ''; Spaces := ''; for j := 0 to i do begin Pre := Pre + ''; Post := Post + ''; end; for j := 1 to (i*3) do Spaces := Spaces + ' '; Result := Result.Replace(Pre, Spaces + '* '); Result := Result.Replace(Post, ''); dec(i); end end; procedure TExportCommon.ProcessMarkUp(StL : TStringList); var StIndex : integer; TempSt: string; DeleteNext : boolean = false; // no blank lines following Monospace begin StIndex := -1; while StIndex < StL.Count -1 do begin inc(StIndex); if DeleteNext and (Stl[StIndex] = '') then begin Stl.Delete(StIndex); DeleteNext := False; dec(StIndex); continue; end; if (length(StL.Strings[StIndex]) < 2) then continue; // no room for a tag in there. TempSt := StL.Strings[StIndex]; DeleteNext := ConvertMono(TempSt); TempSt := TempSt.Replace('', '**', [rfReplaceAll]); TempSt := TempSt.Replace('', '**', [rfReplaceAll]); TempSt := TempSt.Replace('', '*', [rfReplaceAll]); TempSt := TempSt.Replace('', '*', [rfReplaceAll]); // TempSt := TempSt.Replace('', '`', [rfReplaceAll]); // TempSt := TempSt.Replace('', '`', [rfReplaceAll]); TempSt := TempSt.Replace('', '', [rfReplaceAll]); TempSt := TempSt.Replace('', '', [rfReplaceAll]); TempSt := TempSt.Replace('', '~~', [rfReplaceAll]); TempSt := TempSt.Replace('', '~~', [rfReplaceAll]); TempSt := TempSt.Replace('', '', [rfReplaceAll]); TempSt := TempSt.Replace('', '', [rfReplaceAll]); TempSt := TempSt.Replace('', '', [rfReplaceAll]); TempSt := TempSt.Replace('', '', [rfReplaceAll]); TempSt := ConvertBullets(TempSt); // TempSt := TempSt.Replace('', '* '); // TempSt := TempSt.Replace('', ''); TempSt := RestoreBadXMLChar(TempSt); StL.Insert(StIndex, TempSt); StL.Delete(StIndex + 1); end; end; end. tomboy-ng_0.39-1/source/spelling.lrj0000644000175000017500000000325314551457644017270 0ustar dbannondbannon{"version":1,"strings":[ {"hash":5925932,"name":"tformspell.caption","sourcebytes":[83,112,101,108,108],"value":"Spell"}, {"hash":165180142,"name":"tformspell.labelprompt.caption","sourcebytes":[67,108,105,99,107,32,97,32,119,111,114,100,32,116,111,32,117,115,101,32,105,116,46],"value":"Click a word to use it."}, {"hash":192952813,"name":"tformspell.label4.caption","sourcebytes":[83,117,115,112,101,99,116,32,119,111,114,100,32,45],"value":"Suspect word -"}, {"hash":267249588,"name":"tformspell.labelsuspect.caption","sourcebytes":[76,97,98,101,108,83,117,115,112,101,99,116],"value":"LabelSuspect"}, {"hash":125781284,"name":"tformspell.buttonuseandnextword.caption","sourcebytes":[85,115,101,32,97,110,100,32,78,101,120,116,32,87,111,114,100],"value":"Use and Next Word"}, {"hash":33092355,"name":"tformspell.labelstatus.caption","sourcebytes":[76,97,98,101,108,83,116,97,116,117,115],"value":"LabelStatus"}, {"hash":226631924,"name":"tformspell.labelcontext.caption","sourcebytes":[76,97,98,101,108,67,111,110,116,101,120,116],"value":"LabelContext"}, {"hash":136098853,"name":"tformspell.buttonskip.hint","sourcebytes":[83,107,105,112,32,106,117,115,116,32,116,104,105,115,32,105,110,115,116,97,110,99,101],"value":"Skip just this instance"}, {"hash":369152,"name":"tformspell.buttonskip.caption","sourcebytes":[83,107,105,112],"value":"Skip"}, {"hash":258652622,"name":"tformspell.buttonignore.hint","sourcebytes":[73,103,110,111,114,101,32,97,108,108,32,105,110,115,116,97,110,99,101,115,32,102,111,114,32,116,104,101,32,114,117,110],"value":"Ignore all instances for the run"}, {"hash":83777157,"name":"tformspell.buttonignore.caption","sourcebytes":[73,103,110,111,114,101],"value":"Ignore"} ]} tomboy-ng_0.39-1/source/index.lfm0000644000175000017500000000140414551457644016545 0ustar dbannondbannonobject FormIndex: TFormIndex Left = 388 Height = 222 Top = 152 Width = 466 Caption = 'Heading in this Note' ClientHeight = 222 ClientWidth = 466 OnActivate = FormActivate OnShow = FormShow LCLVersion = '2.1.0.0' object ListBox1: TListBox Left = 0 Height = 188 Top = 34 Width = 466 Align = alClient ItemHeight = 0 OnClick = ListBox1Click ScrollWidth = 464 TabOrder = 0 TopIndex = -1 end object Panel1: TPanel Left = 0 Height = 34 Top = 0 Width = 466 Align = alTop Caption = 'Single lines, all Huge, Large Bold or Large' TabOrder = 1 end object Label1: TLabel Left = 206 Height = 19 Top = 98 Width = 47 Caption = 'Label1' ParentColor = False end end tomboy-ng_0.39-1/source/syncutils.pas0000644000175000017500000005041714551457644017510 0ustar dbannondbannonunit syncutils; { Copyright (C) 2017-2020 David Bannon License: This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html ------------------ A Unit to support the tomboy-ng sync unit HISTORY 2018/10/25 Much testing, support for Tomdroid. 2018/10/28 Added SafeGetUTCC.... 2018/06/05 Func. to support Tomboy's sync dir names, rev 431 is in ~/4/341 2019/06/07 Don't check for old sync dir model, for 0 its the same ! 2019/07/19 Added ability to escape ' and " selectivly, attributes ONLY 2020/04/24 Make debugln use dependent on LCL, now can be FPC only unit 2020/08/01 Can now handle 'Zulu' datestrs, ones without timezone, with 'Z' 2021/08/31 Added sha to TNoteInfo 2021/09/12 Taught GetNoteLastChangeSt() to also get create date. 2021/09/27 Added function to return text name for TSyncTransport Type } {$mode objfpc}{$H+} interface uses Classes, SysUtils, dateutils, LazLogger; type TSyncTransport=(SyncFile, // Sync to locally available dir, things like smb: mount, google drive etc SyncGitHub); // sends markdown notes to/from github. type TSyncAction=(SyUnset, // initial state, should not be like this at end. SyNothing, // This note, previously sync'ed has not changed. SyUploadNew, // This a new local note, upload it. SyUploadEdit, // A previously synced note, edited locally, upload. SyDownload, // A new or edited note from elsewhere, download. SyDeleteLocal, // Synced previously but no longer present on server, delete locally SyDeleteRemote, // Marked as having been deleted locally, so remove from server. SyClash, // Edited both locally and remotly, policy or user must decide. SyError, SyAllRemote, // Clash Decision - Use remote note for all subsquent clashes SyAllLocal, // Clash Decision - Use local note for all subsquent clashes SyAllNewest, // Clash Decision - Use newest note for all subsquent clashes SyAllOldest); // Clash Decision - Use oldest note for all subsquent clashes // Indicates the readyness of a sync connection type TSyncAvailable=(SyncNotYet, // Initial state. SyncReady, // We are ready to sync, looks good to go. SyncNoLocal, // We don't have a local manifest, only an error if config thinks there should be one. SyncNoRemoteMan, // No remote manifest, an uninitialized repo perhaps ? SyncNoRemoteRepo, // Filesystem is OK but does not look like a repo, maybe no serverID. SyncBadRemote, // Has either Manifest or '0' dir but not both. SyncNoRemoteDir, // Perhaps sync device is not mounted, Tomdroid not installed ? SyncNoRemoteWrite, // no write permission, do not proceed! SyncMismatch, // Its a repo, Captain, but not as we know it. SyncXMLError, // Housten, we have an XML error in a manifest ! SyncBadError, // Some other error, must NOT proceed. SyncNetworkError, // Remove server/device not responding SyncCredentialError); // Unsuitable user:password type TRepoAction = ( RepoJoin, // Join (and use) an existing Repo RepoNew, // Create (and use) a new repo in presumably a blank dir RepoUse, // Go ahead and use this repo to sync RepoForce, // Force join or create, even if existing credentuals don't work RepoTest); // Just have a look, maybe call SetTransport ? type PNoteInfo=^TNoteInfo; TNoteInfo = record ID : ANSIString; // The 36 char ID LastChangeGMT : TDateTime; // Compare less or greater than but not Equal ! CreateDate : ANSIString; LastChange : ANSIString; // leave as strings, need to compare and TDateTime uses real Rev : Integer; // Not used for uploads, Trans knows how to inc its own. Deleted: Boolean; SID : longint; // Short ID, clumbsy alt to the GUID/UUID we should use Action : TSyncAction; Title : ANSIString; Sha : ANSIString; // The sha of an uploaded note. Stored in local manifest, Github mode. end; type { ---------- TNoteInfoList ---------} { TNoteInfoList } TNoteInfoList = class(TList) private function Get(Index: integer): PNoteInfo; public ServerID : string; // Partially implemented, don't rely yet .... LastSyncDateSt : string; // Partially implemented, don't rely yet .... LastSyncDate : TDateTime; // Partially implemented, don't rely yet .... LastRev : integer; // Partially implemented, don't rely yet .... destructor Destroy; override; function Add(ANote : PNoteInfo) : integer; function FindID(const ID : ANSIString) : PNoteInfo; function ActionName(Act : TSyncAction) : string; procedure DumpList(const Wherefrom : string); property Items[Index: integer]: PNoteInfo read Get; default; end; { ------------- TClashRecord ------------- } { A couple of types used to manage the data involved in handling a sync clash. } type TClashRecord = record Title : ANSIString; NoteID : ANSIString; //ServerLastChange : ANSIString; //LocalLastChange : ANSIString; ServerFileName : string; LocalFileName : string; end; type TProceedFunction = function(const ClashRec : TClashRecord): TSyncAction of object; type TProgressProcedure = procedure(const St : string) of object; { takes a path to the server and a rev number and returns a Tomboy style sync dir. or, if NoteID (without '.note') is supplied, a FullNoteName } function GetRevisionDirPath (ServerPath : string; Rev : integer; NoteID : string = '') : string; { Returns True if this Sync Dir is in correct (ie Tomboy or tomboy-ng later than may 2019 mode) place. eg revision 431 should be in $SYNCDIR/4/431 but might be in 0/431 } function UsingRightRevisionPath(ServerPath : string; Rev : integer) : boolean; // Takes a normal Tomboy DateTime string and converts it to UTC, ie zero offset function ConvertDateStrAbsolute(const DateStr : string) : string; // Returns the LCD string, '' and setting Error to other than '' if something wrong function GetNoteLastChangeSt(const FullFileName : string; out Error : string; CDateInstead : boolean = false) : string; { ret true if it really has removed the indicated file. Has proved necessary to do this on two end user's windows boxes. Writes debuglns if it has initial problems, returns F and sets ErrorMsg if fails.} function SafeWindowsDelete(const FullFileName : string; var ErrorMsg : string) : boolean; function SyncTransportName(TheType : TSyncTransport) : string; RESOURCESTRING rsNewUploads = 'New Uploads '; rsEditUploads = 'Edit Uploads '; rsDownloads = 'Downloads '; rsLocalDeletes = 'Local Deletes '; rsRemoteDeletes = 'Remote Deletes '; rsClashes = 'Clashes '; rsDoNothing = 'Do Nothing '; rsSyncERRORS = 'ERRORS (see console log) '; rsNoNotesNeededSync = 'No notes needed syncing. You need to write more.'; rsNotesWereDealt = ' notes were dealt with.'; rsChangeExistingSync = 'Change existing sync connection ?'; rsNotRecommend = 'Generally not recommended.'; rsNextBitSlow = 'Next bit can be a bit slow, please wait'; { -------------- implementation ---------------} implementation uses laz2_DOM, laz2_XMLRead, LazFileUtils, tb_utils; function SyncTransportName(TheType : TSyncTransport) : string; begin Result := ''; case TheType of SyncFile : result := 'SyncFile'; SyncGitHub : result := 'SyncGithub'; end; end; function SafeWindowsDelete(const FullFileName : string; var ErrorMsg : string) : boolean; begin // This whole block is here because of issue #132 where windows seemed to have problems // moving, deleting a note before a new version is copied over. Is the problem // that windows deletefileUTF8() is not settings its return value correctly ?? if not DeleteFile(FullFileName) then begin ErrorMsg := SysErrorMessage(GetLastOSError); {$ifdef LCL}Debugln{$else}writeln{$endif}('Failed using DeleteFileUTF8 - file name is :' + FullFilename); {$ifdef LCL}Debugln{$else}writeln{$endif}('OS Error Msg : ' + ErrorMsg); if not FileExistsUTF8(FullFileName) then debugln('But, FileExists says its gone, proceed !') else begin {$ifdef LCL}Debugln{$else}writeln{$endif}('I can confirm its still there .'); {$ifdef LCL}Debugln{$else}writeln{$endif}('Trying a little sleep...'); sleep(10); if not DeleteFileUTF8(FullFileName) then begin if not FileExistsUTF8(FullFileName) then {$ifdef LCL}Debugln{$else}writeln{$endif}('DeleteFileUTF8 says it failed but FileExists says its gone, proceed !') else exit(false); end; end; end; Result := true; end; function GetNoteLastChangeSt(const FullFileName : string; out Error : string; CDateInstead : boolean = false) : string; var Doc : TXMLDocument; Node : TDOMNode; // LastChange : string; begin if not FileExistsUTF8(FullFileName) then begin Error := 'ERROR - File not found, cannot read note change date for ' + FullFileName; exit(''); end; try ReadXMLFile(Doc, FullFileName); if CDateInstead then Node := Doc.DocumentElement.FindNode('create-date') else Node := Doc.DocumentElement.FindNode('last-change-date'); if Node = nil then begin Error := 'ERROR - cannot find date in ' + FullFileName; exit(' '); end; Result := Node.FirstChild.NodeValue; finally Doc.free; end; end; { ---------------- TNoteInfoList ---------------- } function TNoteInfoList.Add(ANote : PNoteInfo) : integer; begin result := inherited Add(ANote); end; { This will be quite slow with a big list notes, consider an AVLTree ? } function TNoteInfoList.FindID(const ID: ANSIString): PNoteInfo; var Index : longint; begin Result := Nil; for Index := 0 to Count-1 do begin if Items[Index]^.ID = ID then begin Result := Items[Index]; exit() end; end; end; function TNoteInfoList.ActionName(Act: TSyncAction): string; begin Result := ' Unknown '; case Act of SyUnset : Result := ' Unset '; SyNothing : Result := ' Nothing '; SyUploadNew : Result := ' UploadNew '; // we differentiate in case of a write to remote fail. SyUpLoadEdit : Result := ' UpLoadEdit '; SyDownload: Result := ' Download '; SyDeleteLocal : Result := ' DeleteLocal '; SyDeleteRemote : Result := ' DeleteRemote '; SyError : Result := ' ** ERROR **'; SyClash : Result := ' Clash '; SyAllLocal : Result := ' AllLocal '; SyAllRemote : Result := ' AllRemote '; SyAllNewest : Result := ' AllNewest '; SyAllOldest : Result := ' AllOldest '; end; while length(result) < 15 do Result := Result + ' '; end; procedure TNoteInfoList.DumpList(const Wherefrom: string); var P : PNoteInfo; St : string; begin debugln(''); debugln('----------- List MetaData ' + Wherefrom + ' -------------'); for P in self do begin St := ' ' + inttostr(P^.Rev); while length(St) < 5 do St := St + ' '; debugln('ID=' + copy(P^.ID, 1, 9) + St + ActionName(P^.Action) + ' ' + P^.Title + ' sha=' + copy(P^.Sha, 1, 9)); debugln(' CDate=' + P^.CreateDate + ' LCDate=' + P^.LastChange); end; debugln('-------------------------------------------------------'); (* for I := 0 to Count -1 do begin St := ' ' + inttostr(Items[i]^.Rev); while length(St) < 5 do St := St + ' '; // St := Meta.ActionName(Meta.Items[i]^.Action); debugln('ID=' + copy(Items[I]^.ID, 1, 9) + St + ActionName(Items[i]^.Action) + ' ' + Items[I]^.Title + ' sha=' + copy(Items[I]^.Sha, 1, 9)); debugln(' CDate=' + Items[i]^.CreateDate + ' LCDate=' + Items[i]^.LastChange); end; *) end; destructor TNoteInfoList.Destroy; var I : integer; begin for I := 0 to Count-1 do dispose(Items[I]); inherited; end; function TNoteInfoList.Get(Index: integer): PNoteInfo; begin Result := PNoteInfo(inherited get(Index)); end; function GetRevisionDirPath(ServerPath: string; Rev: integer; NoteID : string = ''): string; begin result := appendpathDelim(appendpathdelim(serverPath) + inttostr(Rev div 100) + pathDelim + inttostr(rev)); if NoteID <> '' then result := result + NoteID + '.note'; end; function UsingRightRevisionPath(ServerPath: string; Rev: integer): boolean; var FullDirName : string; begin FullDirname := GetRevisionDirPath(ServerPath, Rev); // debugln('Right sync Dir is ' + FullDirName); Result := DirectoryExists(FullDirName); // we hope its in 'wrong' place .... // Just to be carefull ... {FullDirname := appendpathdelim(serverPath) + '0' + pathDelim + inttostr(rev); if DirectoryExists(FullDirName) then begin debugln('ERROR, Sync Repo has two sync directories for rev no ' + inttostr(rev)); debugln('We will use ' + GetRevisionDirPath(ServerPath, Rev)); end; } //result := true; end; // Takes a normal Tomboy DateTime string and converts it to UTC, ie zero offset function ConvertDateStrAbsolute(const DateStr : string) : string; var Temp : TDateTime; begin if DateStr = '' then exit(''); // Empty string // A date string should look like this - 2018-01-27T17:13:03.1230000+11:00 33 characters ! // but on Android, its always 2018-01-27T17:13:03.1230000+00:00 ie GMT absolute if length(DateStr) <> 33 then begin {$ifdef LCL}Debugln{$else}writeln{$endif}('ERROR ConvertDateStrAbsolute received invalid date string - [' + DateStr + ']'); exit(''); end; Temp := TB_GetGMTFromStr(DateStr) {- GetLocalTimeOffset()}; Result := FormatDateTime('YYYY-MM-DD',Temp) + 'T' + FormatDateTime('hh:mm:ss.zzz"0000+00:00"',Temp); end; { This function is used if we get a datetime str in UTC format, no time zone specified, just a 'Z'. The time is already in GMT. Gnote gives us 6 decimal places after second but we can cope with nany. Must have yyyy-mm-ddThh:mm:ssZ and opt .nnn.. between 'ss and 'Z' } (* function GetZuluDateTime(const DateStr: ANSIString): TDateTime; var Tstr : string = ''; MilliSeconds : TDateTime = 0.0; Places : integer; begin result := 0.0; if pos('Z', DateStr) < 1 then exit(0); if pos('.', DateStr) > 0 then begin // we make no assumption about number of decimal places in mSec Places := pos('Z', DateStr) - pos('.', DateStr) -1; if Places > 3 then Places := 3; if Places > 0 then begin Tstr := copy(DateStr, pos('.', DateStr)+1, Places); // note, only 3 places of mSec are read if TStr <> '' then try while Places < 3 do begin TStr := TStr + '0'; inc(Places); end; debugln('TStr = ' + TStr); if not TryEncodeTimeInterval(0, 0, 0, strtoint(TStr), MilliSeconds) then // Hour, Min, Sec, mSec, outVar {$ifdef LCL}Debugln{$else}writeln{$endif}('Fail on interval encode '); except on EConvertError do begin {$ifdef LCL}Debugln{$else}writeln{$endif}('FAIL on converting time interval ' + DateStr); {$ifdef LCL}Debugln{$else}writeln{$endif}('Hour ', copy(DateStr, 29, 2), ' minutes ', copy(DateStr, 32, 2)); end; end; end; end; try if not TryEncodeDateTime( strtoint(copy(DateStr, 1, 4)), // Year strtoint(copy(DateStr, 6, 2)), // Month strtoint(copy(DateStr, 9, 2)), // Day strtoint(copy(DateStr, 12, 2)), // Hour strtoint(copy(DateStr, 15, 2)), // Minutes strtoint(copy(DateStr, 18, 2)), // Seconds 0, Result) then {$ifdef LCL}Debugln{$else}writeln{$endif}('Fail on date time encode '); except on EConvertError do begin {$ifdef LCL}Debugln{$else}writeln{$endif}('FAIL on converting date time ' + DateStr); exit(0.0); end; end; Result := Result + milliSeconds; end; *) (* function GetGMTFromStr(const DateStr: ANSIString): TDateTime; var TimeZone : TDateTime; begin if DateStr = '' then exit(0); // Empty string // A date string should look like this - 2018-01-27T17:13:03.1230000+11:00 33 characters ! // But from GNote looks like this 2018-01-27T17:13:03.123000Z 27 char, Zulu time, one less dec second digit, its GMT if length(DateStr) <> 33 then begin {$ifdef LCL}Debugln{$else}writeln{$endif}('ERROR received invalid date string - [' + DateStr + ']'); exit(0); end; try if not TryEncodeTimeInterval( strtoint(copy(DateStr, 29, 2)), // Hour strtoint(copy(DateStr, 32, 2)), // Minutes 0, // Seconds 0, // mSeconds TimeZone) then {$ifdef LCL}Debugln{$else}writeln{$endif}('Fail on interval encode '); except on EConvertError do begin {$ifdef LCL}Debugln{$else}writeln{$endif}('FAIL on converting time interval ' + DateStr); {$ifdef LCL}Debugln{$else}writeln{$endif}('Hour ', copy(DateStr, 29, 2), ' minutes ', copy(DateStr, 32, 2)); end; end; try if not TryEncodeDateTime(strtoint(copy(DateStr, 1, 4)), // Year strtoint(copy(DateStr, 6, 2)), // Month strtoint(copy(DateStr, 9, 2)), // Day strtoint(copy(DateStr, 12, 2)), // Hour strtoint(copy(DateStr, 15, 2)), // Minutes strtoint(copy(DateStr, 18, 2)), // Seconds strtoint(copy(DateStr, 21, 3)), // mSeconds Result) then {$ifdef LCL}Debugln{$else}writeln{$endif}('Fail on date time encode '); except on EConvertError do begin {$ifdef LCL}Debugln{$else}writeln{$endif}('FAIL on converting date time ' + DateStr); exit(0.0); end; end; try if DateStr[28] = '+' then Result := Result - TimeZone else if DateStr[28] = '-' then Result := Result + TimeZone else {$ifdef LCL}Debugln{$else}writeln{$endif}('******* Bugger, we are not parsing DATE String ********'); except on EConvertError do begin {$ifdef LCL}Debugln{$else}writeln{$endif}('FAIL on calculating GMT ' + DateStr); exit(0.0); end; end; { writeln('Date is ', DatetoStr(Result), ' ', TimetoStr(Result)); } end; *) (* function SafeGetUTCfromStr(const DateStr : string; out DateTime : TDateTime; out ErrorMsg : string) : boolean; begin ErrorMsg := ''; if length(DateStr) = 33 then // This is the Tomboy standard DateTime := TB_GetGMTFromStr(DateStr) else if pos('Z', DateStr) > 0 then DateTime := GetZuluDateTime(DateStr) // Gnote does this else begin ErrorMsg := 'Date String wrong length'; DateTime := 0.0; exit(False); end; // if to here, we have at least tried to convert it. if DateTime < 1.0 then begin ErrorMsg := 'Invalid Date String'; exit(False); end; if (DateTime > (now() + 36500)) or (DateTime < (Now() - 36500)) then begin ErrorMsg := 'Date beyond expected range'; DateTime := 0.0; exit(False); end; // TDateTime has integer part, no. of days, fraction part is fraction of day. // 100years ago or in future - Fail ! exit(True); end; *) end. tomboy-ng_0.39-1/source/colours.lrj0000644000175000017500000000246014551457644017140 0ustar dbannondbannon{"version":1,"strings":[ {"hash":170919299,"name":"tformcolours.caption","sourcebytes":[70,111,114,109,67,111,108,111,117,114,115],"value":"FormColours"}, {"hash":93865765,"name":"tformcolours.label1.caption","sourcebytes":[83,97,109,112,108,101],"value":"Sample"}, {"hash":169650899,"name":"tformcolours.label2.caption","sourcebytes":[83,101,116,32,67,111,108,111,117,114,115],"value":"Set Colours"}, {"hash":5966629,"name":"tformcolours.speedtitle.caption","sourcebytes":[84,105,116,108,101],"value":"Title"}, {"hash":371956,"name":"tformcolours.speedtext.caption","sourcebytes":[84,101,120,116],"value":"Text"}, {"hash":32370148,"name":"tformcolours.speedbackground.caption","sourcebytes":[66,97,99,107,103,114,111,117,110,100],"value":"Background"}, {"hash":234009348,"name":"tformcolours.speedhighlight.caption","sourcebytes":[72,105,103,104,108,105,103,104,116],"value":"Highlight"}, {"hash":180128884,"name":"tformcolours.speeddefault.caption","sourcebytes":[68,101,102,97,117,108,116],"value":"Default"}, {"hash":77089212,"name":"tformcolours.speedcancel.caption","sourcebytes":[67,97,110,99,101,108],"value":"Cancel"}, {"hash":1339,"name":"tformcolours.speedok.caption","sourcebytes":[79,75],"value":"OK"}, {"hash":5440803,"name":"tformcolours.speedlinks.caption","sourcebytes":[76,105,110,107,115],"value":"Links"} ]} tomboy-ng_0.39-1/source/mainunit.lfm0000644000175000017500000044342514551457644017277 0ustar dbannondbannonobject MainForm: TMainForm Left = 452 Height = 294 Hint = 'If the yellow tomboy-ng icon is visible in your System Tray, you can dismiss this window.' Top = 303 Width = 565 Caption = 'tomboy-ng' ClientHeight = 294 ClientWidth = 565 OnClose = FormClose OnCreate = FormCreate OnDestroy = FormDestroy OnKeyDown = FormKeyDown OnResize = FormResize OnShow = FormShow LCLVersion = '3.0.0.3' object ImageNotesDirTick: TImage AnchorSideTop.Control = LabelNotesFound Left = 24 Height = 18 Top = 70 Width = 18 Picture.Data = { 1754506F727461626C654E6574776F726B477261706869631E02000089504E47 0D0A1A0A0000000D494844520000001200000012080600000056CE8E57000000 32695458744465736372697074696F6E000100000078DA4B5448CE484DCE56C8 4D2CCA5648CC4B514854482ECA2F2E060B000095390A3495891EA60000000473 424954080808087C0864880000019749444154388DA5D0CF2BE4711CC7F1E730 6D0C22318C0B6DC248898C03263F929264C6CCC9D59FE0B6873D3BC9EDFBF163 E4A01C8861C45CA444324A0AED8E3DEC2E11B71529F39DF9BEF7C0C6C14EBE5F EFEBFBDDE3FD7ABFC16A69E4382384ED21BA2D1B28F22AB6D8F1EB48E3297FD0 70675840B2CBAB586BF0D2AA27E0EA37516CFC348BD85C1B2CF81248FF03E28C 3083C27C98FC05BEF4DD213E1D298BB28C22D334629BA4C57B811E3090CA5D8E D0709846D0C872C7880705F1C4B94551691E010A16F93AF088F4DE228E39862D 2168B83C71EE030652B1C526CA1A43F12AE38329A4ED1C1D45DDFF271505256B 6C664ED3F5469AC2A6EF4F695C1BCCA6DDE88CB03898443AAF4939236828F2FE F572E719F1E948DB392914D569A18C29DA6B0FF8E14B207E1DA93BE4973D440F 0A6A0F38090AF2799B68FA07BC9CE7280A33D67E49322848D70D46D10AE18E2B 8CFE07C41E62E87DD073D92669A9D9E7DBC023E24F220103693E238146BE2908 008DACC22546BD17E84141DC3162E691D7E926F054ED715CBACEF4872000149F 50D4BF67F42F557996F53F6FF18A0000000049454E44AE426082 } end object ImageNotesDirCross: TImage AnchorSideTop.Control = LabelNotesFound Left = 8 Height = 18 Top = 70 Width = 18 Picture.Data = { 1754506F727461626C654E6574776F726B47726170686963F402000089504E47 0D0A1A0A0000000D494844520000001200000012080600000056CE8E57000000 32695458744465736372697074696F6E000100000078DA4B5448CE484DCE56C8 4D2CCA5648CC4B514854482ECA2F2E060B000095390A3495891EA60000000473 424954080808087C0864880000026D49444154388D9D53CF4B5451183D6FE6DD F7DB99FBE65DB3D060A468DFA2A085B46C13D4AA558B3641EBA06DCBFE84DECD C47E410BCD858D36686AA66262669458915112280646A64433BE79EF6B31EF99 9A8ED2D95DEEC7B9E79CEF5C2086CFA1E13FE073300050004072384702FDF94A AAD2F55D0D6F5CF9B12F02E4A2F455AFA25E9AD3CB2DB86502DD0EEB08206835 95A35E873DF0DDDAEA7C0E5670D8ED95548E2A105470580F00A095E3D48CEE7C 8B20A80C8F862C7D58BAE0BB90D43DB5F5FE92E2510441EF3467B98DE3F4E681 E609C3FC1042500841E3A639E373346E26911C0DA3A6315D81A008825E1AD627 C971EC9FD72487376C19E3413C3865585F24C7D1F8A1FCA4617D8C20A8024123 A631255D1CD8D5BFE4B0FA6DBD584655FA1BDD5E941CE7A775FB6B0441EB1034 68E98392A3AE568E559B2EB4A2AD75FE8E73584C738A20A8A478D4676B8F2587 B127C9863217E982C3BAD62188504F0104F53A5A6FD29BED48EDCA4438DC1868 27D4F89806D014B0E38A82FCBED5F82E0E4E1AD65C6267C43416129BAF0C6BDE 77D1B437094766CC345F27C1F6D95A41BA308BB6D6992CE08569CEFA1CB95A4A D880A50F54E2150F5AFA9074ABC1FA1C5ABFAD1783B867CF2C7D34B9DBAE0405 87B5278D1DADF664CB8AA50B6BD832C643085A87474F1CEDA1E4D5FFBA818E4C FADACF54EE6F635D34ECA45A727813A6F93E82A03525478FEAD4EB1B97ED59E5 CCA29AAD10EA6956739677ACFDD6089ADFEAF612A19E96D23CBC9B55CEE14E1E E876586749F1685ECD94DA385A6A912468E538F999657E95E151C1613D4AEC9D 1D0AD8CDB55438767135BAB71F2200B89F4D5DE061FAEC821A5CFE031665FE71 44225A800000000049454E44AE426082 } end object Label3: TLabel AnchorSideTop.Control = LabelNotesFound AnchorSideTop.Side = asrBottom Left = 56 Height = 21 Top = 97 Width = 217 BorderSpacing.Top = 6 Caption = 'Dictionary Config (optional)' end object Label4: TLabel AnchorSideTop.Control = Label3 AnchorSideTop.Side = asrBottom Left = 56 Height = 21 Top = 124 Width = 173 BorderSpacing.Top = 6 Caption = 'Sync Config (optional)' end object ImageSpellTick: TImage AnchorSideTop.Control = Label3 Left = 24 Height = 18 Top = 97 Width = 18 Picture.Data = { 1754506F727461626C654E6574776F726B477261706869631E02000089504E47 0D0A1A0A0000000D494844520000001200000012080600000056CE8E57000000 32695458744465736372697074696F6E000100000078DA4B5448CE484DCE56C8 4D2CCA5648CC4B514854482ECA2F2E060B000095390A3495891EA60000000473 424954080808087C0864880000019749444154388DA5D0CF2BE4711CC7F1E730 6D0C22318C0B6DC248898C03263F929264C6CCC9D59FE0B6873D3BC9EDFBF163 E4A01C8861C45CA444324A0AED8E3DEC2E11B71529F39DF9BEF7C0C6C14EBE5F EFEBFBDDE3FD7ABFC16A69E4382384ED21BA2D1B28F22AB6D8F1EB48E3297FD0 70675840B2CBAB586BF0D2AA27E0EA37516CFC348BD85C1B2CF81248FF03E28C 3083C27C98FC05BEF4DD213E1D298BB28C22D334629BA4C57B811E3090CA5D8E D0709846D0C872C7880705F1C4B94551691E010A16F93AF088F4DE228E39862D 2168B83C71EE030652B1C526CA1A43F12AE38329A4ED1C1D45DDFF271505256B 6C664ED3F5469AC2A6EF4F695C1BCCA6DDE88CB03898443AAF4939236828F2FE F572E719F1E948DB392914D569A18C29DA6B0FF8E14B207E1DA93BE4973D440F 0A6A0F38090AF2799B68FA07BC9CE7280A33D67E49322848D70D46D10AE18E2B 8CFE07C41E62E87DD073D92669A9D9E7DBC023E24F220103693E238146BE2908 008DACC22546BD17E84141DC3162E691D7E926F054ED715CBACEF4872000149F 50D4BF67F42F557996F53F6FF18A0000000049454E44AE426082 } end object ImageSpellCross: TImage AnchorSideTop.Control = Label3 Left = 8 Height = 18 Top = 97 Width = 18 Picture.Data = { 1754506F727461626C654E6574776F726B47726170686963F402000089504E47 0D0A1A0A0000000D494844520000001200000012080600000056CE8E57000000 32695458744465736372697074696F6E000100000078DA4B5448CE484DCE56C8 4D2CCA5648CC4B514854482ECA2F2E060B000095390A3495891EA60000000473 424954080808087C0864880000026D49444154388D9D53CF4B5451183D6FE6DD F7DB99FBE65DB3D060A468DFA2A085B46C13D4AA558B3641EBA06DCBFE84DECD C47E410BCD858D36686AA66262669458915112280646A64433BE79EF6B31EF99 9A8ED2D95DEEC7B9E79CEF5C2086CFA1E13FE073300050004072384702FDF94A AAD2F55D0D6F5CF9B12F02E4A2F455AFA25E9AD3CB2DB86502DD0EEB08206835 95A35E873DF0DDDAEA7C0E5670D8ED95548E2A105470580F00A095E3D48CEE7C 8B20A80C8F862C7D58BAE0BB90D43DB5F5FE92E2510441EF3467B98DE3F4E681 E609C3FC1042500841E3A639E373346E26911C0DA3A6315D81A008825E1AD627 C971EC9FD72487376C19E3413C3865585F24C7D1F8A1FCA4617D8C20A8024123 A631255D1CD8D5BFE4B0FA6DBD584655FA1BDD5E941CE7A775FB6B0441EB1034 68E98392A3AE568E559B2EB4A2AD75FE8E73584C738A20A8A478D4676B8F2587 B127C9863217E982C3BAD62188504F0104F53A5A6FD29BED48EDCA4438DC1868 27D4F89806D014B0E38A82FCBED5F82E0E4E1AD65C6267C43416129BAF0C6BDE 77D1B437094766CC345F27C1F6D95A41BA308BB6D6992CE08569CEFA1CB95A4A D880A50F54E2150F5AFA9074ABC1FA1C5ABFAD1783B867CF2C7D34B9DBAE0405 87B5278D1DADF664CB8AA50B6BD832C643085A87474F1CEDA1E4D5FFBA818E4C FADACF54EE6F635D34ECA45A727813A6F93E82A03525478FEAD4EB1B97ED59E5 CCA29AAD10EA6956739677ACFDD6089ADFEAF612A19E96D23CBC9B55CEE14E1E E876586749F1685ECD94DA385A6A912468E538F999657E95E151C1613D4AEC9D 1D0AD8CDB55438767135BAB71F2200B89F4D5DE061FAEC821A5CFE031665FE71 44225A800000000049454E44AE426082 } end object ImageSyncTick: TImage AnchorSideTop.Control = Label4 Left = 24 Height = 18 Top = 124 Width = 18 Picture.Data = { 1754506F727461626C654E6574776F726B477261706869631E02000089504E47 0D0A1A0A0000000D494844520000001200000012080600000056CE8E57000000 32695458744465736372697074696F6E000100000078DA4B5448CE484DCE56C8 4D2CCA5648CC4B514854482ECA2F2E060B000095390A3495891EA60000000473 424954080808087C0864880000019749444154388DA5D0CF2BE4711CC7F1E730 6D0C22318C0B6DC248898C03263F929264C6CCC9D59FE0B6873D3BC9EDFBF163 E4A01C8861C45CA444324A0AED8E3DEC2E11B71529F39DF9BEF7C0C6C14EBE5F EFEBFBDDE3FD7ABFC16A69E4382384ED21BA2D1B28F22AB6D8F1EB48E3297FD0 70675840B2CBAB586BF0D2AA27E0EA37516CFC348BD85C1B2CF81248FF03E28C 3083C27C98FC05BEF4DD213E1D298BB28C22D334629BA4C57B811E3090CA5D8E D0709846D0C872C7880705F1C4B94551691E010A16F93AF088F4DE228E39862D 2168B83C71EE030652B1C526CA1A43F12AE38329A4ED1C1D45DDFF271505256B 6C664ED3F5469AC2A6EF4F695C1BCCA6DDE88CB03898443AAF4939236828F2FE F572E719F1E948DB392914D569A18C29DA6B0FF8E14B207E1DA93BE4973D440F 0A6A0F38090AF2799B68FA07BC9CE7280A33D67E49322848D70D46D10AE18E2B 8CFE07C41E62E87DD073D92669A9D9E7DBC023E24F220103693E238146BE2908 008DACC22546BD17E84141DC3162E691D7E926F054ED715CBACEF4872000149F 50D4BF67F42F557996F53F6FF18A0000000049454E44AE426082 } end object ImageSyncCross: TImage AnchorSideTop.Control = Label4 Left = 8 Height = 18 Top = 124 Width = 18 Picture.Data = { 1754506F727461626C654E6574776F726B47726170686963F402000089504E47 0D0A1A0A0000000D494844520000001200000012080600000056CE8E57000000 32695458744465736372697074696F6E000100000078DA4B5448CE484DCE56C8 4D2CCA5648CC4B514854482ECA2F2E060B000095390A3495891EA60000000473 424954080808087C0864880000026D49444154388D9D53CF4B5451183D6FE6DD F7DB99FBE65DB3D060A468DFA2A085B46C13D4AA558B3641EBA06DCBFE84DECD C47E410BCD858D36686AA66262669458915112280646A64433BE79EF6B31EF99 9A8ED2D95DEEC7B9E79CEF5C2086CFA1E13FE073300050004072384702FDF94A AAD2F55D0D6F5CF9B12F02E4A2F455AFA25E9AD3CB2DB86502DD0EEB08206835 95A35E873DF0DDDAEA7C0E5670D8ED95548E2A105470580F00A095E3D48CEE7C 8B20A80C8F862C7D58BAE0BB90D43DB5F5FE92E2510441EF3467B98DE3F4E681 E609C3FC1042500841E3A639E373346E26911C0DA3A6315D81A008825E1AD627 C971EC9FD72487376C19E3413C3865585F24C7D1F8A1FCA4617D8C20A8024123 A631255D1CD8D5BFE4B0FA6DBD584655FA1BDD5E941CE7A775FB6B0441EB1034 68E98392A3AE568E559B2EB4A2AD75FE8E73584C738A20A8A478D4676B8F2587 B127C9863217E982C3BAD62188504F0104F53A5A6FD29BED48EDCA4438DC1868 27D4F89806D014B0E38A82FCBED5F82E0E4E1AD65C6267C43416129BAF0C6BDE 77D1B437094766CC345F27C1F6D95A41BA308BB6D6992CE08569CEFA1CB95A4A D880A50F54E2150F5AFA9074ABC1FA1C5ABFAD1783B867CF2C7D34B9DBAE0405 87B5278D1DADF664CB8AA50B6BD832C643085A87474F1CEDA1E4D5FFBA818E4C FADACF54EE6F635D34ECA45A727813A6F93E82A03525478FEAD4EB1B97ED59E5 CCA29AAD10EA6956739677ACFDD6089ADFEAF612A19E96D23CBC9B55CEE14E1E E876586749F1685ECD94DA385A6A912468E538F999657E95E151C1613D4AEC9D 1D0AD8CDB55438767135BAB71F2200B89F4D5DE061FAEC821A5CFE031665FE71 44225A800000000049454E44AE426082 } end object Label5: TLabel Left = 24 Height = 22 Top = 43 Width = 222 Caption = 'Welcome to tomboy-ng !' Font.Height = -18 Font.Name = 'Lucida Grande' ParentFont = False end object LabelNotesFound: TLabel AnchorSideTop.Control = Label5 AnchorSideTop.Side = asrBottom Left = 56 Height = 21 Top = 70 Width = 11 BorderSpacing.Top = 5 Caption = 'X' end object LabelError: TLabel AnchorSideTop.Control = Label4 Left = 24 Height = 19 Hint = 'Launch from commandline to see errors or see Config->SnapShot->Recover ...' Top = 159 Width = 11 BorderSpacing.Top = 35 Caption = 'X' Font.Height = -16 Font.Style = [fsBold] ParentFont = False ParentShowHint = False ShowHint = True OnClick = LabelErrorClick end object CheckBoxDontShow: TCheckBox AnchorSideTop.Control = Label4 AnchorSideTop.Side = asrBottom AnchorSideBottom.Control = Owner AnchorSideBottom.Side = asrBottom Left = 16 Height = 25 Hint = 'You can reverse this from Settings' Top = 254 Width = 262 Anchors = [akLeft, akBottom] BorderSpacing.Top = 14 BorderSpacing.Bottom = 15 Caption = 'Don''t Show for normal startup' TabOrder = 3 OnChange = CheckBoxDontShowChange end object ButtMenu: TBitBtn AnchorSideLeft.Control = Owner AnchorSideTop.Control = Owner Left = 2 Height = 30 Top = 2 Width = 120 BorderSpacing.Left = 2 BorderSpacing.Top = 2 Caption = 'Menu' Glyph.Data = { 36090000424D3609000000000000360000002800000018000000180000000100 2000000000000009000064000000640000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000003232 3238333333050000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00000000000000000000000000000000000000000000000000002E2E2E163636 36F93C3C3CF0393939863737371C000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00000000000000000000000000000000000000000000000000003737377D8080 80F6DEDEDEFF727272FA3A3A3ADC000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00000000000000000000000000003434348D34343440555555033D3D3DEBD9D9 D9FFFFFFFFFF777777F536363672000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00000000000000000000000000003E3E3EEB464646F53B3B3BEB595959F2FFFF FFFFEEEEEEFF3A3A3AF630303010000000000000000000000000000000000000 000000000000000000004D4D4DFF4D4D4DFF4D4D4DFF4D4D4DFF4D4D4DFF4D4D 4DFF4D4D4DFF4D4D4DFF4D4D4DFF3E3E3EFFE8E8E8FFCDCDCDFFCECECEFFFFFF FFFF9E9E9EFC3E3E3EB100000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFF474747FFEAEAEAFFFFFFFFFFFFFFFFFFFFFF FFFFACACACFC434343F5404040D0323232510000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFF454545FFEDEDEDFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFCFCFCFFF383838F9323232420000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFF000000FF000000FF000000FF0000 00FF000000FFFFFFFFFFFFFFFFFF414141FFF0F0F0FFFFFFFFFFFFFFFFFFFFFF FFFFD8D8D8FF3E3E3EF43333334B000000000000000000000000000000000000 000000000000000000004D4D4DFFFAFAFAFFFAFAFAFFFAFAFAFFFAFAFAFFFAFA FAFFFAFAFAFFFAFAFAFFFAFAFAFF3F3F3FFFF2F2F2FFFFFFFFFFFFFFFFFFD9D9 D9FF3E3E3EF53434344E00000000000000000000000000000000000000000000 000000000000000000004D4D4DFF4D4D4DFF4D4D4DFF4D4D4DFF4D4D4DFF4D4D 4DFF4D4D4DFF4D4D4DFF4D4D4DFF383838FFF5F5F5FFFFFFFFFFDBDBDBFF3E3E 3EF6353535570000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFAFAFAFFFAFAFAFFFAFAFAFFFAFAFAFFFAFA FAFFFAFAFAFFFAFAFAFFFAFAFAFF3A3A3AFFF8F8F8FFE0E0E0FF424242F53636 365A000000000000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFF000000FF000000FF000000FF0000 00FF000000FFFFFFFFFFFFFFFFFF383838FFDDDDDDFF424242FF3636365E0000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFF363636FF494949FF454545FF000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFF000000FF000000FF000000FF0000 00FFFFFFFFFFFFFFFFFFFFFFFFFF353535FFAEAEAEFF4D4D4DFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFDFDFDFFA9A9A9FFFFFFFFFF4D4D4DFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFF000000FF000000FF000000FF0000 00FF000000FF000000FFFFFFFFFFFFFFFFFFFFFFFFFF4D4D4DFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF4D4D4DFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFF000000FF000000FF000000FF0000 00FF000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF4D4D4DFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF4D4D4DFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFF4D4D4DFF4D4D4DFF4D4D4DFF4D4D4DFF4D4D 4DFF4D4D4DFF4D4D4DFF4D4D4DFF4D4D4DFF4D4D4DFF4D4D4DFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000 } OnClick = ButtMenuClick TabOrder = 0 end object LabelBadNoteAdvice: TLabel AnchorSideTop.Control = LabelError AnchorSideTop.Side = asrBottom Left = 24 Height = 21 Top = 190 Width = 165 BorderSpacing.Top = 12 Caption = 'LabelBadNoteAdvice' end object BitBtnQuit: TBitBtn AnchorSideLeft.Control = BitBtnHide AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = ButtMenu AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = ButtMenu AnchorSideBottom.Side = asrBottom Left = 197 Height = 30 Top = 2 Width = 366 Anchors = [akTop, akLeft, akRight, akBottom] BorderSpacing.Right = 2 Caption = 'Quit' OnClick = BitBtnQuitClick TabOrder = 2 end object BitBtnHide: TBitBtn AnchorSideLeft.Control = ButtMenu AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = ButtMenu AnchorSideBottom.Control = ButtMenu AnchorSideBottom.Side = asrBottom Left = 122 Height = 30 Top = 2 Width = 75 Anchors = [akTop, akLeft, akBottom] Caption = 'Hide' OnClick = BitBtnHideClick TabOrder = 1 end object ButtSysTrayHelp: TBitBtn AnchorSideLeft.Control = ImageAboutLaz AnchorSideTop.Control = Label4 AnchorSideRight.Control = BitBtnQuit AnchorSideRight.Side = asrBottom Left = 360 Height = 28 Top = 124 Width = 219 Anchors = [akTop] Caption = 'SysTray Help' OnClick = ButtSysTrayHelpClick TabOrder = 4 end object ImageAboutLaz: TImage AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = Owner AnchorSideBottom.Side = asrBottom Left = 360 Height = 128 Top = 161 Width = 200 Anchors = [akRight, akBottom] AutoSize = True BorderSpacing.Right = 5 BorderSpacing.Bottom = 5 OnClick = ImageAboutLazClick Picture.Data = { 07545069786D617044DA00002F2A2058504D202A2F0A73746174696320636861 72202A206C617A617275735F61626F75745F6C6F676F5F78706D5B5D203D207B 0A2232303020313238203235362032222C0A2220200963204E6F6E65222C0A22 2E2009632023303230323032222C0A222B2009632023413839383544222C0A22 402009632023323031453142222C0A22232009632023383931463032222C0A22 242009632023324334353634222C0A22252009632023464346334243222C0A22 262009632023364434343137222C0A222A2009632023383734413137222C0A22 3D2009632023464544363644222C0A222D2009632023383438343945222C0A22 3B2009632023364534373332222C0A223E2009632023424630343143222C0A22 2C2009632023354534383233222C0A22272009632023453039393136222C0A22 292009632023383736363235222C0A22212009632023374136333332222C0A22 7E2009632023374131333032222C0A227B2009632023413739423732222C0A22 5D2009632023384537353246222C0A225E2009632023344334343146222C0A22 2F2009632023343731323036222C0A22282009632023364536303638222C0A22 5F2009632023434543303932222C0A223A2009632023334532303042222C0A22 3C2009632023354234423431222C0A225B2009632023383737413645222C0A22 7D2009632023443739463539222C0A227C2009632023364137423938222C0A22 312009632023324335413933222C0A22322009632023433241323743222C0A22 332009632023464334323037222C0A22342009632023354236353639222C0A22 352009632023334231313036222C0A22362009632023463144423934222C0A22 372009632023433738373137222C0A22382009632023324133394145222C0A22 392009632023394339393839222C0A22302009632023373332313044222C0A22 612009632023334235433841222C0A22622009632023394538363331222C0A22 632009632023454334323043222C0A22642009632023453741384233222C0A22 652009632023454433393034222C0A22662009632023324530453035222C0A22 672009632023423442333938222C0A22682009632023353437333944222C0A22 692009632023444642393644222C0A226A2009632023344236343841222C0A22 6B2009632023304531323143222C0A226C2009632023343433393244222C0A22 6D2009632023414541323834222C0A226E2009632023454244424233222C0A22 6F2009632023373136333742222C0A22702009632023374238424136222C0A22 712009632023374237453742222C0A22722009632023313431463737222C0A22 732009632023333134413645222C0A22742009632023424139433530222C0A22 752009632023333836363939222C0A22762009632023443434383243222C0A22 772009632023384238343730222C0A22782009632023434138463942222C0A22 792009632023383834343544222C0A227A2009632023414237373235222C0A22 412009632023353535444233222C0A22422009632023433633313230222C0A22 432009632023364535343438222C0A22442009632023383736413630222C0A22 452009632023424442314241222C0A22462009632023414238383336222C0A22 472009632023344236463944222C0A22482009632023373537443942222C0A22 492009632023343935433836222C0A224A2009632023353436353941222C0A22 4B2009632023354332333041222C0A224C2009632023334435333745222C0A22 4D2009632023443844414441222C0A224E2009632023384537383345222C0A22 4F2009632023434343334141222C0A22502009632023374135453234222C0A22 512009632023453943383734222C0A22522009632023383232313037222C0A22 532009632023363737354132222C0A22542009632023384139384234222C0A22 552009632023394139304133222C0A22562009632023384434373531222C0A22 572009632023344433303134222C0A22582009632023394441434243222C0A22 592009632023413238463645222C0A225A2009632023413336413239222C0A22 602009632023463345384338222C0A22202E09632023414239463932222C0A22 2E2E09632023354637323930222C0A222B2E09632023394132433345222C0A22 402E09632023383238424136222C0A22232E09632023393439394146222C0A22 242E09632023354335343542222C0A22252E09632023384238343536222C0A22 262E09632023343236303846222C0A222A2E09632023373438344133222C0A22 3D2E09632023384136413344222C0A222D2E09632023333036363944222C0A22 3B2E09632023434442303545222C0A223E2E09632023323430363032222C0A22 2C2E09632023464341463044222C0A22272E09632023374135363144222C0A22 292E09632023373031333033222C0A22212E09632023333635333837222C0A22 7E2E09632023433134393243222C0A227B2E09632023373634393639222C0A22 5D2E09632023363137464137222C0A225E2E09632023364133303134222C0A22 2F2E09632023444542344242222C0A22282E09632023453143383846222C0A22 5F2E09632023333736313938222C0A223A2E09632023384538433838222C0A22 3C2E09632023373137303741222C0A225B2E09632023433038393330222C0A22 7D2E09632023433942303732222C0A227C2E09632023434536413738222C0A22 312E09632023333135463931222C0A22322E09632023343836323933222C0A22 332E09632023334534394238222C0A22342E09632023394639323537222C0A22 352E09632023433537343746222C0A22362E09632023354636453936222C0A22 372E09632023434239423335222C0A22382E09632023323833373438222C0A22 392E09632023453845334343222C0A22302E09632023343236393939222C0A22 612E09632023323330453036222C0A22622E09632023364338364139222C0A22 632E09632023384235383041222C0A22642E09632023363736453845222C0A22 652E09632023364235363732222C0A22662E09632023374531333032222C0A22 672E09632023463246324546222C0A22682E09632023344331433038222C0A22 692E09632023423241423939222C0A226A2E09632023394541364236222C0A22 6B2E09632023423943324343222C0A226C2E09632023344633413142222C0A22 6D2E09632023423032443346222C0A226E2E09632023433642353932222C0A22 6F2E09632023384338423735222C0A22702E09632023363836443643222C0A22 712E09632023453241413343222C0A22722E09632023323833393535222C0A22 732E09632023413037383431222C0A22742E09632023383735393234222C0A22 752E09632023393238464135222C0A22762E09632023374337363530222C0A22 772E09632023463546364634222C0A22782E09632023394138373432222C0A22 792E09632023364234443145222C0A227A2E09632023343935334243222C0A22 412E09632023314530353033222C0A22422E09632023363137363938222C0A22 432E09632023364137434131222C0A22442E09632023353636383841222C0A22 452E09632023383639314237222C0A22462E09632023414238443533222C0A22 472E09632023373938344334222C0A22482E09632023323435353930222C0A22 492E09632023314332393941222C0A224A2E09632023433534353535222C0A22 4B2E09632023374338344130222C0A224C2E09632023434341383539222C0A22 4D2E09632023363236433837222C0A224E2E09632023344432363044222C0A22 4F2E09632023444442443844222C0A22502E09632023343836383938222C0A22 512E09632023393636353039222C0A22522E09632023353436433936222C0A22 532E09632023373337444336222C0A22542E09632023384333413534222C0A22 552E09632023394241324237222C0A22562E09632023354136453843222C0A22 572E09632023333332313135222C0A22582E09632023424435323632222C0A22 592E09632023444643434236222C0A225A2E09632023463143443842222C0A22 602E09632023414442354333222C0A22202B09632023323935463943222C0A22 2E2B09632023364433423131222C0A222B2B09632023434143394345222C0A22 402B09632023383937393534222C0A22232B09632023444141383838222C0A22 242B09632023313731363138222C0A22252B09632023424538443441222C0A22 262B09632023393638353531222C0A222A2B09632023373536323441222C0A22 3D2B09632023394337373239222C0A222D2B09632023414241324231222C0A22 3B2B09632023344135323545222C0A223E2B09632023353033433342222C0A22 2C2B09632023373837343839222C0A22272B09632023364338324135222C0A22 292B09632023363236414332222C0A22212B09632023434139453533222C0A22 7E2B09632023393336373233222C0A227B2B09632023394439414144222C0A22 5D2B09632023383938454135222C0A225E2B09632023334536313934222C0A22 2F2B09632023333936374133222C0A22282B09632023423031313236222C0A22 5F2B09632023344536393936222C0A223A2B09632023333235313834222C0A22 3C2B09632023373834453141222C0A225B2B09632023414237443642222C0A22 7D2B09632023363136384245222C0A227C2B09632023414239323346222C0A22 312B09632023464442443245222C0A22322B09632023413531463331222C0A22 332B09632023424536433641222C0A22342B09632023314130343033222C0A22 352B09632023333634334235222C0A22362B09632023374236423445222C0A22 372B09632023354136443936222C0A22382B09632023374138444232222C0A22 392B09632023333035453942222C0A22302B09632023334534434138222C0A22 612B09632023373035353335222C0A22622B09632023323233313845222C0A22 632B09632023354435423739222C0A22642B09632023363937353934222C0A22 652B09632023354637384131222C0A22662B09632023354532453130222C0A22 672B09632023454144304437222C0A22682B09632023393538453646222C0A22 692B09632023373736433636222C0A226A2B09632023463745414233222C0A22 6B2B09632023463645384539222C0A226C2B09632023364237324332222C0A22 6D2B09632023464446454644222C0A226E2B09632023334536383938222C0A22 6F2B09632023384633363443222C0A22702B09632023334134383543222C0A22 712B09632023374334353134222C0A22722B09632023464143453636222C0A22 732B09632023454442423636222C0A22742B09632023373233423433222C0A22 752B09632023414237413342222C0A22762B09632023333036323943222C0A22 772B09632023354537323941222C0A22782B09632023453245384542222C0A22 792B09632023334236323844222C0A227A2B09632023393735443235222C0A22 412B09632023383537423843222C0A22422B09632023394238433535222C0A22 432B09632023343935344145222C0A22442B09632023423041434237222C0A22 452B09632023444241443546222C0A22462B09632023374137363636222C0A22 472B09632023354433413136222C0A222E202E202E202E202E202E202E202E20 2E202E202E202E202E202E202E202E202E202E202E202E202E202E202E202E20 2E202E202E202E202E202E202E202E202E202E202E202E202E202E202E202E20 2E202E202E202E202E202E202E202E202E202E202E202E202E202E202E202E20 2E202E202E202E202E202E202E202E202E202E202E202E202E202E202E202E20 2E202E202E202E202E202E202E202E202E202E202E202E202E202E202E202E20 2E202E202E202E202E202E202E202E202E202E202E202E202E202E202E202E20 2E202E202E202E202E202E202E202E202E202E202E202E202E202E202E202E20 2E202E202E202E202E202E202E202E202E202E202E202E202E202E202E202E20 2E202E202E202E202E202E202E202E202E202E202E202E202E202E202E202E20 2E202E202E202E202E202E202E202E202E202E202E202E202E202E202E202E20 2E202E202E202E202E202E202E202E202E202E202E202E202E202E202E202E20 2E202E202E202E202E202E202E202E202E202E202E202E202E202E202E202E20 222C0A222E202E206B206B206B206B206B206B206B206B206B206B206B206B20 6B206B206B206B206B206B206B206B206B206B206B206B206B206B206B206B20 6B206B206B206B206B206B206B206B206B206B206B206B206B206B206B206B20 6B206B206B206B206B206B206B206B206B206B206B206B206B206B206B206B20 6B202E206B206B206B202E206B206B202E206B206B202E206B206B206B206B20 6B206B206B206B206B206B206B206B206B206B206B206B206B206B206B206B20 6B206B206B206B206B206B206B206B206B206B206B206B206B206B206B206B20 6B206B206B206B206B206B206B206B206B206B206B206B206B206B206B202E20 6B202E206B202E206B206B202E206B206B206B206B206B206B206B206B206B20 6B206B206B206B206B206B206B206B206B206B206B206B206B206B20242B6B20 242B6B206B206B206B206B206B206B206B206B206B206B206B206B206B206B20 6B206B206B202E206B206B202E206B206B202E206B202E206B202E206B202E20 6B202E206B202E206B206B202E206B202E202E20222C0A222E206B20642B642B 642B7C207C2048204820482048204820642B642E362E4D2E362E442E442E4A20 442E6A206A20442E6A206A206A206A206A2049206A206A20492049204920262E 262E6120612061204C2061204C2061204C2061204C20212E212E4C20212E6120 4C2061204C204C204C2049204C204C204C20612061203120212E3A2B212E3A2B 3A2B212E3A2B3A2B3A2B3A2B3A2B3A2B212E212E212E212E3A2B3A2B3A2B212E 212E6120212E612061206120262E322E262E262E262E262E262E322E322E322E 262E4920492049206A2049206A206A206A206A20522E522E562E6820562E522E 442E6A206A206A20322E262E262E212E6120312031203A2B31203A2B3A2B3120 3120212E3120212E212E212E6120262E5F2B562E562E362E362E772B53205320 5320642B53207C207C20432E272B272B622E622E622E272B7C205320772B4A20 49204920262E6A20522E522E4A20322E262E212E212E3A2B482E482E482E482E 482E482E482E482E3120482E3120482E482E482E3120482E482E482E482E482E 482E482E6B202E20222C0A222E206B20772B422E7C20642B7C207C20432E4820 2A2E432E7C20642B7C20652B2E2E772B522E522E522E522E522E4A20522E442E 4A204A206A205F2B6A206A205F2B6A206A206A206A206A20322E322E262E262E 262E262E5E2B262E792B6120612061206120262E262E262E262E5E2B6120262E 6120612061206120612061203120212E212E212E3A2B212E6120212E212E212E 212E212E212E212E612061206120612061206120612061205E2B262E5E2B5E2B 5E2B5E2B5E2B6E2B262E262E262E262E262E262E322E6E2B6A20322E6A206A20 4920322E6A20442E322E6A205F2B372B522E522E522E772B4A20522E5F2B502E 5E2B5E2B612061206120212E312073203A2B3A2B3120312E3120312E61206120 262E5F2B68206820772B772B772B4D2E372B372B372B372B372B772B772B422E 422E7C20622E272B622E272B272B2A2E432E372B6A20262E322E502E6A204A20 5F2B6A20502E5E2B312E3A2B482E482E482E482E482E482E482E482E482E482E 482E482E482E482E482E482E482E482E482E482E482E3A2B6B202E20222C0A22 2E206B20422E422E7C20432E642B48207C204820482048204820642B642B642B 422E422E772B6820562E522E522E522E522E522E522E6820442E522E522E6A20 5F2B6A206A20502E5F2B502E502E502E322E6E2B262E262E262E322E262E6120 612061206120262E6E2B502E502E792B6120262E262E61206120612061203120 312E212E212E6120212E212E212E6120212E212E6120612061206120212E212E 6120612061206120612061205E2B5E2B61205E2B262E6120262E792B5E2B792B 262E262E6A20262E322E262E322E262E4920262E492049206A206A20322E6A20 502E5F2B522E522E772B772B522E4A20522E4A20322E502E322E5E2B262E6120 61203A2B482E3A2B312031206120212E6120212E792B502E4720522E522E522E 522E372B4A20522E372B372B362E53205320652B652B652B5D2E422E622E272B 432E772B5320372B4A20322E322E322E322E6A20522E5F2B5F2B5E2B61203120 482E482E482E482E482E482E482E482E482E482E482E482E482E482E482E482E 482E482E482E482E482E482E6B202E20222C0A222E20242B2E2E422E53205320 4820532048204820482048204820482048207C20422E772B422E772B522E522E 522E522E522E562E6820562E6820562E5F2B442E522E562E522E6A205F2B5F2B 5F2B6A206A206A206A20322E262E262E6A2061206120612049206E2B6A20502E 6A20502E262E61204C2049204C20612061206120312E792B312E6120312E6120 312061203120212E212E212E212E212E312E6120612061206120612061206120 6120262E262E6120212E61206120612061204920792B792B262E262E792B262E 262E49206A2049206A20562E562E562E49206A206A206A206A205F2B6A20522E 422E422E522E5F2B322E322E502E502E262E262E612061204C203A2B31206120 312031203A2B61206120322E6A206A206A20442E372B362E772B5320772B772B 432E432E422E422E422E6820562E6820652B652B522E7D2B322E4A205F2B6A20 322E502E6A20522E6820522E4720322E6120212E482E482E482E482E482E482E 482E482E482E482E482E482E482E482E482E482E482E482E482E482E482E482E 6B202E20222C0A222E206B20642B422E5D2E7C20432E642B4820482048204B2E 4B2E2A2E2A2E7C20432E5320422E422E772B652B6820772B6820772B522E772B 772B772B68206820562E522E562E522E5F2B5F2B5F2B522E442E522E5F2B442E 6A206A20492049206A20492049206A206A20522E522E522E6A206A20262E792B 6120262E262E61206120612061206120212E6120612061206120612061206120 61206120612061205E2B5E2B5E2B5E2B61206120612061206120792B312E212E 612061206120612061206120792B262E6E2B262E6A20702E7020342E67205F20 692E2B202B2077202E2E6A206A20502E5F2B6820772B6820522E47205F2B502E 5F2B4720502E6A20502E502E792B61206120612061206120262E262E322E6A20 6A204A204A20442E522E372B5320432E432E53205320772B522E6A20502E322E 322E262E502E47205F2B5F2B322E262E322E262E502E5F2B522E522E68205F2B 4720262E6120312E3120482E482E482E482E482E482E482E482E482E482E482E 482E482E482E482E482E482E482E482E482E482E6B202E20222C0A222E206B20 562E652B642B7C20432E4820642B48204B2E48204B2E482048204820432E432E 7C205320422E2E2E2E2E562E562E562E772B562E422E422E422E422E2E2E6820 562E562E562E442E562E562E562E442E562E442E442E6A206A20442E442E442E 442E4A20372B372B5320372B4A206A20322E322E6A20262E792B6A20262E262E 262E6120792B6120612061206120612061206120262E262E262E6120262E262E 262E49206A2049206120212E61206120612061206120792B61206120792B792B 4920792B562E71203920342E5F207D2E3B2E69206220752B4C2E5120262B402B 7120562E522E5F2B4720502E502E502E502E47204720502E5F2B472047204720 6A20502E322E49204920262E322E5F2B6A204A20442E442E4A20362E4A20372B 362E53205320772B372B4A204A206A206A206A20262E262E322E322E502E502E 5F2B322E262E322E502E302E68206820682047206A20262E612061203120482E 482E482E482E482E482E482E482E482E482E482E482E482E482E482E482E482E 482E482E482E73206B202E20222C0A222E20242B2E2E422E652B7C207C20642B 4820642B482048204B2E48202A2E48202A2E48202A2E48207C20432E7C207C20 652B2E2E2E2E772B422E2E2E422E422E642B422E422E2E2E422E2E2E2E2E422E 2E2E562E2E2E422E2E2E562E562E562E562E562E372B442E362E362E53205320 372B4A205F2B502E6A206A206A206E2B6A206A206A206A206A206A206A206A20 6A206A206A206A206A203420442E3420462B70206F2E3920692E71206F2E6F2E 6F2E70206F2E54203A2E54206F2E54207020712034203B2B252E342E4E20792E 3B2E252B5B2E5120722B46205B2E252B252B252B4C2E32206F2E2E2E522E5F2B 262E262E262E262E322E6A20502E4720522E6820502E502E5F2B502E4A20502E 4A205F2B522E362E372B772B362E772B362E772B5320772B772B372B372B442E 372B4A205F2B5F2B322E4920262E262E4920502E5F2B472047205F2B68206820 6820682047205F2B792B6120262E262E7520312E482E482E482E482E482E482E 482E482E482E482E482E482E482E482E482E482E482E482E482E482E6B202E20 222C0A222E206B20642B7C207C207C2048204820482048204820482048204820 48204B2E4B2E4B2E482048204820432E4820432E432E432E7C207C207C207C20 7C207C207C207C20422E422E422E652B652B652B432E7C20652B7C207C20422E 2E2E2E2E422E2E2E772B772B772B772B772B772B642B442E2E2E422E422E7C20 71207120462B682B6F2E682B342E342E252E682B7B20252E762E342E262B782E 6D202B207C2B7C2B7420282E4C2E5D203220692074202B205F20422B5F205F20 5F203B2E6D2029205D205D205020272E3D2B472B372E452B7D20752B51207D20 452B5120722B4C2E452B452B4F2E67206F2E422E47206A20262E262E792B792B 502E6A20502E5F2B5F2B522E5F2B522E4A20522E5F2B522E372B372B362E362E 772B53205320432E53205320642E372B4D2E372B442E562E68206820522E5F2B 6A206A206A206120262E322E502E47204720522E68206820682047206A206A20 6A20302E5F2E3120482E482E482E482E482E482E482E482E482E482E482E482E 482E482E482E482E482E482E482E482E6B202E20222C0A222E20242B642B642B 642B7C2048204820482048204B2E48204B2E4B2E482048204B2E4B2E4B2E4820 4B2E2A2E2A2E2A2E2A2E2A2E7C202A2E7C2048202A2E7C207C20482048202A2E 272B2A2E2A2E272B272B7C20432E432E7C20652B7C20652B7C20432E5320772B 5320532048202A2E2A2E6F2E3920282E6E2E74206E2E6E2E7C2B3B2E3B2E7C2B 3B2E7C2B7A204C2E7C2B62207A20452B4620252B212B4C2E732B252B452B3620 3B2E6920282E4C2E5A2E6D20212B4F2E362051207420512074205D207E2B2C20 4E2E5E20512E272E4620712E732B69205A2E2920252B742051207A20712E712E 732B3B2E692067206F2E6820442E6A20262E262E6E2B6A206E2B502E502E5F2B 5F2B522E522E522E772B772B772B772B772B362E772B372B362E772B772B772B 772B772B362E772B772B772B422E422E422E422E2E2E372B522E5F2B502E502E 6A20502E302E302E502E502E5F2B4720472047204720502E5F2E312E3120482E 482E482E482E482E482E482E482E482E3820482E482E482E482E482E482E482E 482E482E2E202E20222C0A222E206B207C207C207C2048204820412B48204B2E 48204B2E482048204B2E4B2E4B2E4B2E4B2E2D202D2070204B2E4B2E2A2E2A2E 4B2E4B2E2A2E71204B2E4B2E702070204B2E4B2E2A2E2A2E2A2E2A2E432E7C20 7C20652B422E652B7C20422E772B362E2E2E642B2A2E682B6B2E5F205F203B2E 3D2B4C2E3B2E372E4C2E5B2E4C2E7A204C2E252B212B7A2B372E752B7A205120 4620732B452B692051206220752B36205A2E692046204F2E512074203D206920 5F203D203D2B692069203B2E7420452B7420472B3C2B4E2E472B3C2B3A204620 7E2B272E5120252B252B512051202920732B732B3720372E712E692069207D2E 672067206F2E71207C202E2E6A20262E5E2B492049204A20522E362E772B652B 772B532053205320772B772B772B5320772B53205320772B53205320432E7C20 7C20432E432E2A2E272B432E772B68206820522E4720502E322E322E792B6120 6A206A2047206820682068206E2B202B482E482E482E482E482E482E482E482E 482E482E482E482E482E3820482E482E482E482E482E482E6B202E20222C0A22 2E206B202C2B642B482048202A2E482048202D202D202D20402E2D202D204B2E 2D202D207020402E2D20402E402E2D204B2E70204B2E4B2E70204B2E2D202D20 7020402E7020402E2A2E2A2E7C20272B7C205D2E7C20652B7C202E2E422E562E 2E2E422E70206D2067202B205D2029207C2B512E5B2E7A207C2B5B2E3D2B252B 4C2E7A2B69203D2B7A2069207A20732B452B252B3C2B452B752B4C2E732B4C2E 69205A2E732E4F2E5A2E692074207D206920692074203D2B3B2E3D2B212B3B2E 4620252B5020262066205E2E632E7E2B2E2B752B5B2E5B2E7D20452B512E5B2E 5120252B6920732B27202720712E372E372E452B512051204C2E282E5F207D2E 54202E2E6A20492049204A20562E362E772B5320652B5320652B432E432E532E 432E2A2E432E432E432E432E2A2E2A2E4B2E2A2E2A2E2A2E2A2E2A2E70202A2E 7C2068206820522E5F2B502E502E322E502E6A206E2B6A204720682068206820 6820302E2D2E202B482E482E482E482E482E482E482E482E482E482E482E482E 482E482E482E482E482E482E6B202E20222C0A222E206B204820482048204820 48204B2E4B2E4B2E4B2E70204B2E7020402E5D2B402E402E5D2B2D2070202D20 2D204B2E402E2D207020402E2D20402E402E402E2D204B2E402E702070202A2E 2A2E7C20622E432E7C20432E422E422E422E422E7C20682B7B203B2E74207C2B 6220272E372E69205B2E5A207E2B2E2B252B7A205B2E372E372E7E2B452B252B 5A20732B7E2B4C2E5A2E51205F204F2E752B212B692069206920282E3D2E632E 732B69207C2B472B512E372E7D205B2E452B36205A2E4F2E252B5A202E2B2620 2620472B5720272E752B512E69204C2E5B2E7D205A20452B51204C2E452B2720 37207A20712E712E372E452B712E732B712E3B2E51206D206F2E702E562E522E 522E772B772B652B772B432E5320432E432E432E4820532E482048204820472E 402E402E402E402E402E70204B2E4B2E4B2E7020272B5D2E652B68204720502E 262E6E2B6E2B792B6E2B502E5F2B6820652B652B47204720302E202B202B482E 482E482E482E482E482E482E482E482E482E482E482E482E482E482E482E482E 6B202E20222C0A222E206B2048202C2B48204B2E48204B2E4B2E4B2E2D20402E 2D20382B402E402E402E402E402E402E4B2E402E402E2D20402E2D202D20402E 2D202D202D20402E402E4B2E70202A2E2A2E2A2E2A2E2A2E272B272B7C207C20 422E2E2E642B7120692E2B20252E5D20632E7A205B2E5B2E752B6920712E7D20 732E7A2B462057202A20252B742E5A206920792E252B6920452B36202B20732E 632E46202E2B4620212B2C203D2B6220632E4C2E7420472B2E2B752B452B4620 62205B2E3B2E7E2B7D205A2E2B20292029204E2E2E2B792E4E2E26205A20752B 732B252B5A20722B69205A2E6920512E27207A20712E7D20712E5A207A20732B 7D20712E712E712E722B51204C2E2B2059204B2E7C20642B642B422E652B432E 432E432E2A2E2A2E702070204B2E402E5D2B752E5D2B452E452E5D2B5D2B5D2B 402E70204B2E4B2E2A2E622E5D2E652B6820502E6120792B6E2B792B792B502E 6E2B5F2B682068206820682047205F2E3120482E482E482E482E482E482E482E 482E482E482E482E482E482E482E482E482E482E6B202E20222C0A222E20242B 642B432E482048204B2E48204B2E4B2E4B2E4B2E70202D20402E402E402E2D20 402E2D20402E5D2B5D2B5D2B5D2B402E402E2D202D204B2E4B2E4B2E4B2E2A2E 2A2E272B7C207C207C20422E7C20432E432E422E422E422E252E342E5D20272E 7C2B26207E2B5A207D205B2B212B252B212B36207D20212B26203C2B2E2B3C2B 3D2E26203D2E5E2E212B3B207A2B732B26205A202F2E4F2E6920732E29205A20 252B5A205A207E2B7E2B3C2B7A2B7A20752B662B712B5A207D20252B4C2E4C2E 7C2B752B742E742E50207E2B262057205A205A20372E732B452B512074207420 212B732B732B712E7E2B502037203D2B7A20712E372E4C2E372E7C2B46203B2E 712E37204C2E74203D2B4E2028203C2E642B432E48202A2E7020382B7020382B 452E402E402E402E2D20752E752E5420752E5D2B5D2B402E2A2E382B4B2E622E 5D2E5D2E502E7520792B61205E2B6E2B302E6A205F2B68206820652B522E262E 262E6120212E482E482E482E482E482E482E482E482E482E482E482E482E482E 482E482E482E482E6B202E20222C0A222E20242B7C207C207C20482048204820 2D204B2E4B2E4B2E4B2E4B2E2D20402E7020402E402E4B2E472E4B2E532E532E 402E2D20402E402E402E4B2E4B2E48207C207C207C207C205D2E422E422E422E 7C20272B7C207C207C20762E362B2620512E2620512E252B452B7A20452B7D20 5A2E69204F2E69203D2B232B5720472B66203C2B6C2E3520272E3D2E732E3C2B 732E7D20252B732B5120622074203D2E662B452B7C2B252B462026206920372E 7D207D20752B452B452B7D207E2B452B5A2069203B2E3D2B3C2B2E2B3520742E 752B3A20682E712B752B5A20732B722B46204C2E452B51206920372E57204E2E 7A2B632E2E2B252B372E472B662B66202E2B632E3720712E37203720752B512E 7A2B3C2B362B6F2E402E4B2E382B382B402E452E452E452E752E452E7020452E 452E452E452E5D2B402E472E2A2E272B272B272B6820502E61203120312E312E 312E5E2B4720302E47205D2E68205F2B322E262E322E5E2B61203120482E482E 482E482E482E482E482E482E482E482E482E482E482E202B482E482E6B202E20 222C0A222E206B20642B5320432E7C202A2E4B2E48204820482048204B2E4B2E 4B2E4B2E2D20482053207D2B432B7A2E352B332E7A2E4120292B532E4B2E4B2E 4B2E7C207C207C20422E652B7C20422E642B422E422E652B7C206F2E252E572E 3A20662B5D20752B682E5B2E212B742E452B252B272E282E282E7A20282E6A2B 452B742E4B20662B35204B203D2B3A202E2B7420272E472B372E232B29205A20 732E5A2E4F2E3220472B7A2B7D20232B5A205E2E6920732E712B4620452B452B 212B69205B2E372E452B742E4B20712B7A2B452B36205A202E2B37207D205A2E 752B252B51206920452B7A203C2B662B5E2E7E2B512E632E7A2B712B752B7E2B 682E66204E2E2E2B30205A203720732B712E5A2037203720372E212B4C2E7B20 7020702070207020402E402E402E402E402E5D2B452E232E5420452E70202A2E 652B772B772B4720502E6E2B75206120312031203120312E61205E2B502E522E 6820522E502E41205E2B5E2B5E2B6120482E482E482E482E482E482E482E482E 482E482E482E482E202B482E3120482E6B202E20222C0A222E206B20652B642B 422E7C20432E482048204820482048204B2E2A2E4B2E2A2E53207A2E352B302B 7A2E412041207D2B41207A2E332E432B642E2A2E2A2E272B5D2E7C205D2E422E 7C20422E422E422E422E422E6F2E5E20792E472B4B204B203D2B732E3D2B7420 782E662B452B4F2E7A2B5A2E5120212B36205A2E4620462E682E682E2E2B3C2B 272E3A204E2E7A20662B2A20452B252B3C2B4F2E5120232B282E2E2B252B232B 46202C20252B212B4C2E5B2E252B372E3D2E212B69203B2E752B372E74205A20 2A202E2B2E2B27205A207A203A20472B4B20712E212B212B4C2E7A2B7A20712E 5B2E7A2B2F20662B3A202E2B632E2E2B5A206220662B342B612E6C2E682E2A20 2720312B712E372037202720712E2720712E4C2E74205D2B2A2E2A2E272B432E 2A2E2A2E2A2E7020402E452E232E402E2A2E362E772B522E4A205E2B5E2B792B 5F2E5F2E312E312E6120312E61206E2B5F2B522E6820522E5F2B322E322E5E2B 5E2B392B3120202B482E482E482E202B482E482E482E202B482E482E202B482E 3120482E6B202E20222C0A222E20242B7C205D2E432E432E432E2C2B642B4820 4820482048204B2E48204D2E352B352B302B41207D2B6C2B6C2B6C2B6C2B292B 41207A2E302B4A20642B7C20422E5D2E2E2E652B422E422E422E422E68203420 362B5E204E2E4B2026207A2B5020262029206C2E732E252B74205A20712E6920 3D2B282E7D2E4F2E282E6E207E2B272E352026202C20662B742E2E2B742E3220 50205B2B732B7D2E7E2B252B5A2E462E4F2E4C2E732E2A20252B512E2E2B4620 46203D2B662B7A2B272E252B212B372E37204C2E232B7A2B5A207D205B2E452B 21202E2B2E2B252B712E7A205B2E732B712E512E742E742E682E4E2E682E3520 4B202E2B2E2B4E2E3520612E342B3E2E2F207A2B2720712E272037202720712E 732B7D20712E2C2E452B7D2E5D2B272B7C202A2E432E4820432E48202A2E7020 70202A2E5320372B522E322E6120312E61203120312E3120312031203120312E 5E2B502E472068206820522E5F2B5F2B47205F2B5E2B6120392B202B202B482E 482E482E202B202B482E482E202B202B482E3120482E482E6B202E20222C0A22 2E206B20422E422E7C20432E432E48204820482048202D20482048206C2B352B 38207A2E4120292B6C2B532E472E532E472E532E6C2B7D2B7A2E352B372B7C20 422E422E422E68202E2E422E422E7C2071203B2B382E792E472B3C2B4E2E742E 3C2B4E2E742E4E2E5020792E3C2B742B5B2E7D207A2B4F2E3B2E4F2E5F205A2E 7420272E2F20712B472B3520272E35202E2B46202E2B5A205A2E32205E2E252B 232B5D206920272E252B5A2E32202A20742E7E2B4E2E5A207A207A2026207A20 732E3D2B5A205A20632E5A202A20452B6920732E472B5E2E632E2E2B5B2E7D20 372E742E3720742E2920662B682E682E2620352066204B20712B4B202F206620 342B342B66202A207A2B512E5A207A2037205B2E3B2E372E372E712E27205120 692E2A2E7C207C20642B642B2E2E2E2E642B432E2A2E272B272B652B522E262E 212E61203120312031203120312031203120792B792B6E2B302E502E502E4720 4720502E682047202F2B392B31203120202B202B482E482E482E482E202B482E 482E202B482E202B202B31206B202E20222C0A222E206B202E2E7C20652B652B 4820642B482048204B2E4B2E4B2E7120302B3820352B7A2E7D2B6C2B472E472E 452E452E472E472E472E6C2B4120302B302B2E2E2E2E422E422E422E422E422E 2E2E422E252E6C2E572E66202C202C20662B3D2E742E232B32205A207E2B3520 742E232B2E2B752B5120282E51203620262B32205A2E4620792E7E2B742E3B20 272E472B2E2B5A20322074204C2E252B4F2E5A2E74205B2B452B232B4C2E3220 5020712B752B752B742E3D2B2920272E272E7E2B272E472B29207A2B372E4620 5A20742E472B2E2B2E2B5E2E2A205E2E7D205A205A205A20732B46204E2E2E2B 662B3520682E66203E2E4B205E2E292E2F203E2E342B3E2E3E2E4B20682E5E2E 30205E2E662B57203A20682E7A2B27202720452B67202A2E5320362E362E362E 362E362E362E5320422E432E272B5D2E68205E2B262E212E212E212E31203120 3120202B3120312E392B312E5F2E75202F2B5F2E2F2B2F2B2F2B5F2E5F2E392B 392B31203120202B202B482E202B202B482E202B202B3120202B3120482E3120 6B202E20222C0A222E206B20562E2E2E642B2E2E642B642B4820482048204B2E 48207D2B622B3820332E41206C2B6C2B452E5820602E552E5420452E472E532E 292B432B352B522E2E2E422E2E2E2E2E2E2E422E2E2E762E5D2021205020572E 4E2E682E7A2B7A207A2B732B29203C2B212B732E212B452B752B7D20232B5B2E 212B4C2E6A2B6A2B5A2E7D2E57204E2E3D2B2E2B2F20742E662B26207E2B682E 252B4F2E2920732E512050207E2B6920252B46207D20232B452B7D204C2E2620 3A206620682E4E2E3C2B2F20712B2A203D2B57204E2E2E2B26205A202A20712B 752B7A20732B632E7A207D20372E612B662066204B20712B662B342B3E2E412E 3E2E3E2E2F203E2E35202F202F202F202F202E2B4E2E2F202A20742E4E2E2F20 3720732B452B362045207C207C20532053205320532053205320432E2A2E272B 2A2E432E652B5F2B6E2B6120392B3120312E312E312E312E3120312E312E762B 312E392B5F2E312E5F2E5F2E2F2B5E2B5F2E392B31203120392B31203120202B 482E202B482E202B202B482E202B3120312031206B202E20222C0A222E206B20 362E362E362E2E2E5320532048207C202A2E48202A2E432B622B38207A2E4120 6C2B472E54204D20782B6B2E5420452E472E532E292B4120352B432B772B562E 2E2E2E2E2E2E562E3B2B572057205020742E3A20662B5E2E5B2B252B5E2E232B 252B782069203B2E742E2620452B372E46205A2E7420282E6A2B74203B2E212B 5920472B3C2B7E2B742E29204E2E742E5B2B252B3B2E232B742E252B282E732E 232B7D2E5A206920742E752B732E2A204620792E742B662B4B206620712B742E 712B662B662B682E2E2B632E472B3C2B3D2B252B252B5B2E5A20372E712E212B 212B2A202E2B35203520572035202F204B20662B4B204B20292E2F204B203020 2F206620682E6620352035202A20712E4F2E7A2B352E722B732B3620442B432E 432E2A2E48202A2E4B2E2A2E432E4B2E2A2E70207020432E652B68205F2B6E2B 6120312E6120312E202B3120312E312E762B792B5F2E5F2E3120312031203120 3120392B5F2E392B31203120312031203120312031203120202B482E202B202B 31203120312031206B202E20222C0A222E206B20442E562E562E362E2E2E422E 642B7C20432E48207C202420492E38207A2E41206C2B532E54206B2E4D20602E 5420452E472E472E6C2B4120352B212E772B68202E2E68202E2E34202C202C20 2C2026205720682E472B2E2B662B452B46205A20272E732B50207E2B752B752B 452B7E2B752B732B7E2B74203620252B7D20362069202C203A2029207A2B3B20 35202E2B3C2B2920272E232B4F2E6E2E4C2E26204C2E422B662B6920212B452B 6920212B5A20272E472B35204E2E2E2B682E3A206620682E3C2B5E2E7A2B2E2B 682E5A20472B742E732B69207D20452B7A2B212B212B7A2B272E742B682E4B20 4B20742E742E662B2E2B5E2E2F202F202F202F2066203E2E662035204B20662B 2E2B7A20512074207A2B712E722B36206A2E7C20652B272B622E622E4B2E472E 70207020472E452E5420452E622E432E5F2B6E2B5E2B5F2E792B312E312E202B 202B312E312E312E312E312E3120312031203120482E3120392B392B392B3120 3120482E31203120312031203120202B482E482E482E482E482E31206B202E20 222C0A222E206B20442E442E372B442E2E2E642B652B7C20432E5D2E2C2B622B 492E3820332E4120292B532E472E452E552E54205420552E472E532E6C2B4120 332E302B372B2E2E562E2E2E562E3B2B6C2050204E2E3B205720682E5720472B 5A20212B742E3D2B3D2E46203C2B272E752B3C2B7E2B3A203B204C2E452B6A2B 6E203620512069204C2E4C2E3E2B4E2E5A20662B5E2E742E26202E2B2E2B212B 29206C2E252B252B7C2B7D2E232B4F2E2620462E252B46202920472B4E2E472B 4E2E662B66202F20682E2E2B712B712B252B69207E2B5E2E5A20252B7A20212B 252B452B46207A20612B26203A20662B4B20742E4E2E2E2B272E5E2E712B632E 2F202F203E2E2F2035202F20682E682E5E2E682E662B632E46205A205A202720 712E36205F207C20432E432E4820432E272B7020382B7020452E542054205420 382B272B522E5F2B302E6E2B75202D2E312E312E312E31203120312E312E3120 31203120312031203120482E3120762B3120392B392B312031203120392B482E 482E482E3120482E482E482E482E3A2B6B202E20222C0A222E206B20442E442E 562E442E562E2E2E422E7C207C20432E432E622B492E3820332E7A2E7D2B292B 532E532E472E5420602E602E452E6C2B292B7A2E352B302B522E772B562E2E2E 34206C2035205720472B57204E2E682E3A20742E732E4E2E612B3220682E2620 462E4E2057204E2E732E7A2B212B212B29205A2E362B2B205A2E4F2E51203220 792E4B20742E4E2E2620272E4E2E3D2E3D2B7420792E472B212B462E3A204620 50203D2B7E2B4C2E452B4C2E742E7A2B472B472B2F203E2E2F203E2E2F20682E 3520742E252B262B3D2E662B272E372E452B74203C2B5A207D207A203C2B2A20 2620272E2F20712B682E682E712B682E2E2B2E2B3E2E2F202F205E2E682E2F20 682E682E712B2E2B2E2B2E2B5720662B5B2E5B2E712E722B2B2B272B652B652B 652B652B5D2E272B432E2A2E4B2E452E54205420452E472E652B47207520792B 792B2D2E312E2D2E312E792B6E2B47204720302E762B202B3120202B3120482E 3120202B202B392B392B392B392B2F2B4720762B202B482E482E202B3120202B 392B31206B202E20222C0A222E206B202E2E372B562E772B562E6820422E652B 422E5D2E642B382072203820352B7A2E4120292B6C2B532E532E452E5820602E 472E6C2B7D2B7A2E3820302B372B562E562E562E3C20612B4E204E2E742B3A20 3A203520472B612B792E472B742E252B5B2B7D2029203C2B6C2E662B742E792E 742E4C2E46207D2074204F2E25205F204F2E7D2E4C2E7A2B512E4E2E712B272E 662B6220292029207A2B252B74203D2E2E2B752B462046202920742E252B3B2E 272E742E3B20472B4B20682E2620662B4E2E2E2B4B20712B472B6620272E2E2B 4B20752B5020752B7A2B742E46203C2B472B2E2B26203C2B352079203C2B4E2E 742B4E2E572057204E2E4B203C2B712B2E2B2F205E2E2E2B632E632E2E2B2E2B 572E352026204E2E2C20422B6D202E2E4720502E522E6820772B68206820772B 642E4820472E382B7020622E422E522E792B7520792B312E792B75202D2E6820 5D2E5D2E5D2E68206E2B3120202B202B3120202B392B202B3120392B392B392B 202B47205D2E68202F2B392B31203120392B392B2F2B31206B202E20222C0A22 2E206B20642B772B2E2E772B2E2E2E2E422E422E422E7C20642B702B72207220 3820332E7A2E7D2B7D2B292B6C2B532E472E472E6C2B7D2B4120332E352B212E 372B772B2E2E492057203A202620732E792E6F20652E572E682E6620682E3D2B 29203A202620212B5B2B6C2E3C2B512E26204E2E7A2B7A204E2E7A2B51205A2E 7D2E74203620602036202C204E2E2A207A20272E7A203D2B4E2E4E2E3C2B3D2B 5020682E3D2E62206C2E2E2B2A202E2B632E752B3C2B7E2B3A20662B472B682E 26204E2E662B4B20682E272E3C2B4E2E3A2026203D2B5A20472B632E232B4C2E 5D205A207E2B3D2B5E2E5E2E43206F202820652E632B41204920432B302B3B2B 652E26207E2B712B7A2B512E512E512E272E4E2E662066202620472B6620792E 3A2E502E792B792B792B792B262E792B502E502E372B532048202D20402E382B 272B6820502E6E2B792B792B312E312E6E2B5D2E5D2E622E5D2E4720302E6120 31203120482E392B502E5F2E5F2E6120392B2F2B5F2E47205D2E47204720202B 392B31205F2E5E2B302E5E2B6B202E20222C0A222E206B20422E2E2E422E422E 642B422E422E422E2E2E422E772B4C207220492E492E3820332E7A2E41207D2B 7D2B292B7D2B7D2B41207A2E332E382038204A20422E422E2E2E3B2B57204E2E 792E622040202C2B6C2B242E572E662B3C2B5020612B472B272E212B3D2B3520 662B7A2B4E2E3E2E26203D2B512E7A203C2B732E282E32206A2B32204F2E402B 35202E2B742E4B20742E29202E2B272E3D2E66202E2B4E203D2E3B2066202E2B 29205A20792E3C2B4E2E632E29203B203C2B57202C20682E4B20662B4B206620 4E2E272E4B203520472B212B212B252B3B2E5D2026205D202920662B3C2B4420 2C2B772B372B68204720502E6E2B5F2E612061204A207720462E4620752B7A20 5A207E2B5720342B342B35202A207A205B2B692E7020792B312E312E312E6120 792B262E5F2B372B432E472E4820472E452E452E622E68206A20792B312E312E 312E202B2D2E472047205D2E652B502E262E302E47205F2E322E47205D2E432E 432E322E502E502E2D2E2D2E472047202F2B392B5F2E392B392B31202F2B5E2B 6B202E20222C0A222E206B207C20652B652B7C20652B7C20422E422E2E2E422E 422E442E72207220722038203820352B7A2E7A2E7A2E7A2E412041207A2E332E 352B3820302B6820652B652B442E6C2021203D2E5D20462043202C2B432E362E 722E6620662066206620742E3A2026206220732E252B7E2B212050202920272E 29205A203D2B252B722B6A2B602036204F2E282E472B662B682E732E4E2E2620 732E272E792E3A202620792E6620742E7E2B5A20472B4E2E3A20662B2F20662B 272E792E3A205A206C2E662B57204E2E5E2E572066206620712B5E2E272E7420 7420612B472B4620752B472B26202E2B732E2C2B432E272B272B422E652B6820 6820302E61206120262E372B642B7B2B59205920262B44205E20342B572E612B 732E462032206A2E6E2B312E312E312E312E312E6120792B5F2B522E2A2E4B2E 402E452E452E7020622E652B4720792B6120312E3120312E3120762B2F2B6820 5D2E6820502E6820622E5D2E5D2E452E5420542058205420622E652B68204720 2F2B47202F2B392B6120392B5F2E212E392B61206B202E20222C0A222E206B20 422E7C207C207C207C207C20652B422E422E422E422E642B3B2B72207220492E 492E38203820352B352B332E332E332E352B38203820352B5F2B422E7C207C20 3B2B4020662B4E2E3A20732E762E48204820412B4A20382E66204E2E4E2E272E 792E742E742E662B462029203520742E252B5020732E7420792E472B74203220 74204F2E5A2E592E3C203E2E472B7A204E2E472B3C2B2C207E2B29205A20272E 26205D20292050203A20662066204E2E2E2B26202E2B7E2B792E612B272E472B 3A20412E682E4E2E3520682E2E2B2E2B682E792E3C2B792E3C2B3D2B3D2B2620 5A20752B5B202D202A2E70202A2E432E5D2E652B5D2E47206E2B262E322E322E 502E522E362E442E4D2E492049203C2035203A2057203A2E5D2B6A203120312E 312031203120312061206E2B68205D2E272B452E452E402E7020432E6820302E 6A206E2B792B3120312E482E482E762B2F2B2F2B682047205F2B652B382B382B 2A2E382B54205820602E58205420432E372B5F2B652B652B502E5F2E302E302E 302E392B392B392B6B202E20222C0A222E206B20422E652B7C20432E432E7C20 7C207C202E2E422E2E2E422E772B302B72207220492E492E38203820352B3820 352B382038203820352B5E2B6C2B652B432E7C20242E2C205D20752B612B792E 2C2B4820482048204820642E3E2B682E35204B20742E662B212B732B3B2E462E 752B74205A2E392E36206A2B462E732E7D207A207A206E204F2E4C2E77203520 712B742E632E742E682E26203A20792E7E2B472B6C2E5E203A2050202620472B 472B472B712B2C202C20272E572E612E682E4B202E2B4E2E2E2B472B4E2E2A20 2E2B5E2E662B26203C2B472B472B29203D2B7E2B5D20592048204B2E4B2E7020 432E272B272B652B5F2B5F2B502E502E502E6A20502E502E502E262E61206120 3120522E6F206F20412B48206A20312E6120312E612031206120312E262E502E 6820622E5D2E2A2E452E452E2A2E422E68206E2B75207520792B312E762B762B 31203120392B392B2F2B502E302E4720652B382B382B452E54206A2E602E552E 552E58205420232E552E452E362E322E5F2B47204720392B3120212E6B202E20 222C0A222E206B20422E7C20422E5D2E272B432E432E432E7C205320422E772B 422E422E4120622B7220492E492E492E38203820382038203820332E4A20772B 7C207C20432E702E3C2066205720732E782E3A20652E48204B2E2D202D204820 632B6C204E2E472B6C2E3520252B3620462050204C2E4C2E5A2E732E3D2B3620 6A2B5A2E212B692051206E2E7D2E732E6E2E662B5E2E4B202E2B272E662B2E2B 3E2E4E2E512E5720662035206620272E3A2035205720632E632E682E3E2E2E2B 2E2B35203B203A2066204E2E682E3E2E662B2A202A202A204E2E3C2B7A20512E 3D2B3D2B29203B205B202D2048204820382B402E70202A2E432E522E322E502E 522E5F2B522E6820682068206820502E6120212E3120312E322E4A20522E5E2B 392B3120312031203120312E312061205F2E502E68205D2E622E652B2A2E452E 432E5F2B502E7520312E792B392B392B392B392B202B392B31205F2E5E2B5E2B 5E2B262E5F2B432E472E382B54205420552E6A2E552E602E442B2B2B6B2E2D2B 402E402E432E5F2B5D2E5F2B5E2B61206B202E20222C0A222E20242B422E7C20 7C20652B7C205D2E7C20432E652B7C207C20422E7C20422E5320372B332E3820 3820382038203820352B332E392B292B6820532053207C20432E702E29203C2B 4E2E6620362B692B3C2E2A2E2A2E472E2D202D20472E652E572E3A204E2E3A20 272E752B3B2E3B2E7C2B4E2E6220232B7D2E6E20362B62205A2E212B69203620 6B2B282E742026202E2B682E6620662B632E7A2B662B712B632E272E2E2B2A20 2E2B2A20682E352066203C2B632E2A20472B272E7E2B4E2E35203A203E2E4E2E 682E682E2E2B712B2A207A2B5A20462062205B2E3D2B3C2B3B20412B2D20402E 402E5D2B452E452E402E4B2E7C20772B652B6820522E6820522E522E522E522E 502E47206E2B792B792B762B762B312E3120392B312E392B392B392B3120392B 312061205F2E502E682068206820522E372B422E652B68206E2B612031203120 312031203120202B3120392B392B392B392B2F2B5E2B302E502E6820652B272B 382B542054207B2B552E442B45202B2B2F2E4520442B602E552E7C207020622E 6820322E6B202E20222C0A222E206B20422E422E642B7C207C207C207C20432E 432E7C205320642B532053207C205320422E292B4A20292B292B502E292B652B 652B652B652B422E652B7C205D2E3B2B3E2B5A20732E5E2E612B412B4B2E4820 2D2048204B2E4B2E4B2E4B2E302B572E35202F20662B742E212B212B4C2E372E 252B692036206A2B32207D2E6E2E3A2029205A2E6A2B592E3C2B712B712B4B20 2F20682E4B20632E2E2B712B272E3A20472B792E682E5E2E2E2B472B2F203520 4E2E2A203A206620712B4B205E2E7A2B712B5E2E5E2E712B2A20632E5A207A20 37205B2E46204620752B7720412B4B2E4B2E70205D2B452E552E232E5420402E 4B2E70202A2E7C20522E372B372B522E522E47205F2B302E302E6E2B792B792B 3120212E312061203120312E312E392B392B31205F2E392B392B2F2B302E302E 68206820522E47205F2B5F2B502E5F2E3120312031203120202B3120202B482E 392B392B392B392B5F2E5E2B502E682068205D2E452E452E5420232E7B2B2D2B 442B2B2B2B2B2B2B2B2B4F206B2E552E70205420382B652B6B202E20222C0A22 2E20242B422E422E652B7C207C207C2048207C207C204820432E7C207C20642B 7C207C207C207C205320652B652B652B652B652B652B652B7C205D2E422E7C20 422E6C20572E2E2B252B742044205B202D204B2E4B2E4B2E48202D204B2E2D20 2A2E4D2E6C2066202E2B2A203C2B46202E2B752B372E7E2B212B3B2E36202520 6E203220592E462E282E25204F2E662B662B2F20682E682E2F20272E662B4B20 712B352035202E2B3A20682E612E612E3520662B5E2E512E4B20662B5A205A20 7A20742E4B20302030205E2E2A202A20512E3D2B7C2B422B422B772071202D20 70202A2E432E432E2A2E402E5420552E552E7B2B752E5D2B402E2A2E432E432E 2A2E432E7C20432E652B47206E2B5E2B61205F2E5E2B5E2B5F2E6120392B312E 312E762B312E312E5F2E6E2B61202F2B302E302E472068204720472047204720 472047202D2E312E202B312031203120202B202B3120392B392B392B392B5E2B 6E2B47206820652B622E382B452E5420552E552E442B45206B2E2F2E2B2B2B2B 2F2E602E552E452E7020622E6B202E20222C0A222E206B202E2E422E642B642B 7C20642B642B642B4820642B48207C207C207C2053207C207C20432E4820432E 5D2E652B422E5D2E432E7C20422E642B7C20422E702E3D2E212B5020472B5B2B 5B20412B4B2E4B2E4B2E2D204B2E4B2E2D20452E2D20472E642B7B2E742B742E 252B5A2E232B4C2E3D203620282E7E2B46204F2E5F2025206A2B392E6E206E20 6D202F202F202F203E2E2F20682E3C2B4E2E66203A20682E35204E2E6620342B 2E20342B3E2E742E2920272E5020472B792E572050203C2B4B205E2E2E2B2E2B 2A20742E2920762E77202D204820432E2A2E2A2E4B2E2A2E7C207C202A2E7020 452E232E232E552E232E232E402E4B2E432E2A2E2A2E7020402E382B622E772B 5F2B6E2B6E2B5E2B302E5E2B5E2B5F2E61205F2E762B762B312E312E392B762B 392B2F2B2F2B302E2F2B6E2B2F2B302E6E2B2F2B4720302E47202D2E31203120 312031203120202B3120392B2F2B61205F2E5E2B5E2B502E302E47205D2E622E 382B5420452E5420552E442B452045202B2B2B2B6B2E442B6A2E5420452E7020 242B2E20222C0A222E206B202E2E422E422E2E2E5320642B5320642B48205320 642B48205320482048207C207C20432E4820432E2A2E7C207C20432E7C207C20 652B7C20422E422E34204620732B44203E2E472B77204820472E48204B2E4B2E 4B2E402E2D205D2B402E752E402E6D206E20322032203620742050203B2E3620 5A2E282E6E2036207D2E782E2B206A2B4E202B20612B4B204B20292E2F202F20 2F205E2E3A203E2E3E2E3520292E662B3520342B342B3E2E3520682E5720612E 3A203E2E682E682E412E612E3E2E2F204B204B20262044205B20482048202A2E 2A2E432E272B622E2A2E272B432E7C20432E4B2E2A2E452E452E232E232E5520 4420412B2D204B2E70205420232E5420382B772B4A20262E262E5E2B5E2B322E 5E2B2F2B792B5F2E792B312E312E312E312E762B762B762B2D2E2F2B302E2F2B 752047202F2B75206E2B2F2B302E2F2B392B31203120482E202B202B392B392B 2D2E762B7520302E302E4720302E502E6820652B532E5D2E382B452E232E232E 6A2E442B442B45204520602E602E5820232E5420242B2E20222C0A222E206B20 4D2E562E362E2E2E642B5320642B53205320642B48207C207C207C207C204820 48202A2E48202A2E432E432E7C207C207C207C207C207C207C202E2E6C204E2E 732E7D207E2B7B2E412B4B2E4B2E4B2E4B2E402E402E402E402E402E5D2B4B2E 28203D2E36207B204E2E212B74203B205B2E5A2E212057207D2E25206E2E4E2E 462E6020342E6C2E612E4B20712B4320742B4E2E4B202E2B4B202F204B20682E 662B3B20472B6620682E472B612B4E2E6620412E2E2B472B3C2B3D2E66202E20 412E3E2E35202F203C20642B5320642B652B272B432E70207020702070202A2E 272B2A2E432E53205320532E452E5D2B752E44206F2B332B5520752E452E5420 552E552E552E7020772B5F2B322E502E502E262E5E2B322E6120792B792B7520 312E312E312E312E5F2E312E312E392B2F2B2F2B392B75202F2B2F2B2F2B2F2B 2F2B2F2B762B392B392B3120202B202B3120202B392B392B2F2B302E68206820 4720302E302E4720652B532E382B472E472E452E232E2D2B2D2B2D2B442B602E 4520602E6A2E232E242B2E20222C0A222E206B20562E372B2E2E362E362E642E 642E642E53205320642B4820532048207C202A2E48202A2E4B2E2A2E48204820 4820482048204820482048207C20252E43203C2B252B5A2E2F2E402B412B4820 4B2E4B2E4B2E2D202D20452E402E752E692E5F206D20452B6A2B51207A20372E 5A2E5120692036203B2E752B3B2E2520362032205120252067206B20342B2F20 7B2E2C2B2C2B4D2E282044207A2B742E7B2E28203C2E642E692B652E652E692B 77203D2E2E2B412E662B3D2B5D20732E4E2E35204E2E352066203B203C2E652B 422E422E2E2E7C20432E2A2E382B702070202A2E2A2E70205D2E772B772B642B 4820472E5520542E2B2E63207C2E5520232E5420232E552E54202A2E5320432E 372B322E522E522E5E2B6E2B6E2B5E2B6E2B792B792B762B312E312E792B312E 312E762B31202F2B2F2B75202F2B2F2B2D2E6E2B2D2E5F2E5F2E392B392B392B 202B202B392B3120392B392B5F2E302E682068202F2B5E2B2F2B302E68205D2E 652B272B532E472E452E452E232E5420552E6A2E602E442B442B6A2E242B2E20 222C0A222E206B20362E562E362E772B772B362E362E642E642B5320642B5320 48207C20482048204B2E4B2E4B2E48204B2E4B2E4B2E4B2E2A2E4B2E2A2E2A2E 7C20762E752B69203B2E6E2E7D2E3A2E2D202D204B2E2D202D20402E402E402E 462B6D203620362051203B2E74204E205B2E46207C2B5720472B4C2E5A2E4C2E 792E3B2E3B2E2C2074206E205E203E2E35205E2E692B48207C2048202C2B6C2B 482071202C2B2C2B4B2E472E2A2E482053202C2B77203D2B272E2F20662B3C2B 4E2E682E682E2E2B632E272E3A203C20432E432E7C20432E432E432E272B7020 702070207020382B382B70202A2E432E5320432E4820472E692B302023206320 6320332B5520232E54205420402E4B2E4B2E472E53205320532E772B322E262E 262E6E2B792B792B312E6120312E762B312E5F2E312E312E392B762B762B392B 762B2D2E2D2E75202F2B762B2F2B5F2E3120392B202B3120202B392B392B392B 2F2B2D2E2F2B47204720302E502E472068205D2E5D2E432E2A2E472E452E452E 452E452E7B2B232E752E2D2B602E452040202E20222C0A222E206B20562E772B 772B2E2E362E362E772B362E642E642E53205320482048202A2E48204B2E4B2E 70204B2E4B2E4B2E4B2E2D204B2E2D204B2E2D20762E29202E2B46202920572E 692B4B2E402E2D20452E402E452E5D2B692E692E5E20512E74202C205E204620 74206C2E662B372E4C2E3C2B4B203D2B742074203D2B3D2B622029204E20702E 3A20682E5E2E6F202C2B432E432E432E432E48204820432E2A2E432E2A2E2A2E 272B4820432E432E412B362B4E2E2A207A20512E2920712B4B20632E5A202920 4E2E632B432E272B2A2E2A2E70202A2E2A2E2A2E2A2E2A2E7020382B7020452E 7020432E652B5320432E2C2B3B20292E7E20632063207620352E7B2B232E452E 472E4B2E4B2E2A2E272B272B2A2E5D2E522E5F2B322E792B792B792B762B312E 312E762B762B312E392B3120392B3120202B762B2D2E762B762B5F2E5F2E762B 392B392B392B392B202B392B202B392B392B762B2F2B47202F2B2F2B202B5F2E 6E2B472068205D2E622E622E382B382B532E532E452E452E452E452E5D2B5520 442B6A2E242B2E20222C0A222E206B20562E522E522E522E772B772B2E2E5320 772B5320642B642B642B48204B2E4B2E4B2E4B2E2D204B2E4B2E402E402E7020 402E402E402E2A2E43205B2B232B7D2E592E2A2B6F20402E402E5D2B5D2B5D2B 3920422B282E3B2E5B2E212B742026205A20452B4C2E2C206620512E74207420 3D2B3A20682E3C2B472B66204020242B6B20612E35203520472B2C2B4B2E432E 4820432E7C2053207C20272B432E432E7C20432E432E432E7C207C20642B5E20 612E4E2E3D2B3D2E462E272E4E2E29205D207E2B5B2B2C2B2A2E482048207020 702070204B2E2A2E70207020382B70207020382B382B5D2E372B652B432E6F20 3020292E7E20762033203320582E5B2B5520232E2A2E5320272B2A2E4B2E2A2E 7020622E272B272B5D2E4720792B792B612061203120202B202B762B3120392B 202B202B392B762B762B762B762B312E392B5F2E5F2E392B392B392B392B3120 3120392B3120482E2D2E2F2B2D2E47202F2B2F2B392B5F2E302E68205D2E5D2E 532E432E432E362E4B2E532E472E452E5420452E232E5420242B2E20222C0A22 2E206B20522E562E522E522E772B2E2E772B642B2E2E642B642B2C2B48204820 48204B2E4B2E4B2E402E4B2E4B2E402E2D20402E5D2B402E5D2B702E4E2E272E 282E2520672E67205D2B5D2B5D2B5D2B5D2B3920282E732E452B7A207D205A2E 51203B2E3620452B212B50204E2E2E2B2620272E742E472B26202C2066206620 342B342B342B66204E2E66203E2B642B4820272B2A2E432E5D2E422E642B7C20 432E7C20432E432E432E432E7C20652B562E572E682E262026203E2E612B572E 35203C2B5720472B692E412B7C20772B642B48204B2E4B2E7020472E70207020 402E702070202A2E2A2E272B652B772B432E742B3020292E7E20422033203320 6320582E5B2B452E382B2A2E2A2E702070202A2E622E5D2E432E622E622E652B 262E6120612031203120202B202B762B31203120392B392B392B392B75202F2B 5F2E61205E2B5F2E5F2E5F2E762B762B762B392B3120392B5F2E392B392B2D2E 2D2E2F2B2F2B2F2B2F2B2F2B5F2E2F2B502E47206820652B5320522E5320432E 4B2E452E382B472E452E452E6B202E20222C0A222E206B20522E522E522E6820 6820372B422E2E2E53205320432E4820642B642B482048204B2E4B2E4B2E4B2E 2D202D20402E402E402E5D2B3A2E252E3B205E2E742E6E2E392E5820752E752E 452E452E5D2B7B205A2E5120722B752B252B6A2B462E272E51207C2B732E252B 262043205A204420692B412B6C2066206620412E66203A20662B2620472B7B2E 632B642B432E432E432E432E7C205320652B422E432E432E432E7C20432E272B 272B432E432E5E2057202920632E2E2B2920612E612E26202E2B26206E2E7C20 362E5320532053205320432E432E2A2E2A2E2A2E70207020472E432E2A2E272B 652B772B632B5E2E292E7E207E20232033206520652063207E2E412B2A2E7020 382B382B382B7020432E362E772B652B652B68206E2B6120212E6120312E202B 202B202B392B312031203120392B392B5F2E75205F2E312E5F2E5E2B2F2B5F2E 762B762B5F2E392B392B392B392B392B762B202B2F2B2D2E2F2B2F2B2F2B2F2B 2F2B502E4720502E4A20502E262E4A20522E432E452E452E402E382B7020472E 242B2E20222C0A222E206B206A20522E522E442E422E68202E2E5320642B642B 532048204820642B482048202A2E48204B2E4B2E70202D202D205D2B402E3A2E 202E74204F2E232B26205B2B6E2E232E232E232E232E752E3A2E262B282E5120 4620452B282E6A2B6E2E3C2B452B462E3D2E59206F20692B2D20412B2D202C2B 572E342B342B342B35204B2057204E2E4E2E2820362E422E422E422E422E772B 422E422E5D2E622E272B432E272B272B272B272B2A2E432E5D2E702E2C203A20 2620742046203A202E2B752B462E7B2055207C20372B362E772B652B422E5320 422E53207C20432E4820272B2A2E432E2A2E272B652B372B742B3020292E292E 7E202320332033206520632065205620412B402E452E5420382B2A2E7C20642B 432E2A2E7C205320522E6120212E3120312E202B202B202B392B212E392B5E2B 6E2B502E302E5F2E5E2B5E2B5F2E6E2B2F2B2F2B5F2E762B2F2B392B6120392B 31203120762B762B202B2D2E202B392B392B5F2E392B5E2B502E5E2B522E6C2B 68206C2B432E432E2A2E382B452E272B70202A2E242B2E20222C0A222E206B20 442E522E5F2B522E562E362E2E2E772B5320642B642B48204820482048204820 48204B2E4B2E4B2E4B2E70207020402E4B2E772069204F2E36202520692E202E 7B2B232E232E232E7B2B7B2B452E252E4C2E722B5B2E452B6A2B3B2E4620612B 4E20692E32207B2B2D205D2B752E752E402E2E2E572E342B2E203E2E682E662B 35205720652E4D2E422E562E772B68206820522E652B622E2A2E652B5D2E272B 272B622E272B272B622E622E432E702E3A20272E3D2E752B6220472B632E5B2E 51202B207720642B772B772B6820772B772B652B422E652B422E5320432E7C20 7C20432E2A2E432E652B632B5E2E662E7E207E20292E662E6320332033206520 65204220582E2D20452E5420382B2A2E7C204820402E7020452E382B2A2E772B 262E5E2B3120202B202B202B3120312061205F2B4720502E322E322E502E502E 472047202F2B762B5F2E762B762B392B392B392B392B392B392B762B202B202B 762B392B5F2E302E4720502E47206820652B5D2E5320522E432E432E772B432E 622E2A2E472E382B242B2E20222C0A222E206B206A20522E5F2B522E68202E2E 772B562E5320642B642B48202C2B482048202D2048204B2E70202D202D20402E 2D205D2B702E2C2062204C2E5F202520672E45205420232E7B2B7B2B7B2B7B2B 7B2B77202B203D204620372E732B6220282E6E2E412B55207B2B7B2B7B2B232E 232E5520452E3420402066203E2E35203A20472B272E4420642B2E2E6820522E 562E4720472047205F2B652B5D2E5D2E68206820652B5D2E272B5D2E5D2E5D2E 7C2034203A20272E50203A2057203C2B3C2B4620452B7D2E4F202A2E5D2E652B 522E522E522E6820652B432E422E422E5320642B7C20432E432E432E53203B20 302023202320292E7E207E206320332033206520332065206D2E7A2B412B452E 2A2E2A2E2A2E452E752E452E232E5420452E432E522E6E2B31203120202B3120 31205F2E502E6C2B682068206820522E502E4720682047205F2E392B762B392B 392B392B392B392B392B392B392B762B762B762B392B392B762B2F2B47204720 47206820652B5D2E652B532E622E432E5F2B4A20522E5D2E432E2A2E242B2E20 222C0A222E206B20442E522E522E522E562E562E562E362E772B642B53204820 48204820482048204B2E4B2E4B2E4B2E70204B2E5D2B67205B204E2E662B472B 612B592E392E5820752E232E7B2B2D2B7B2B7B2B7B2B3A2E21204C2E732B452B 452B2620462E4F202D2B7B2B7B2B552E7B2B7B2B232E232E402E3E2B3A20682E 3520342B342B682E742E2C2B422E562E522E47206A20522E5F2B502E5F2B502E 68206820502E47204720302E502E502E502E6A205F2B702E6C2E3C2B3A207E2B 632E3C2B512E5A20752B46202D2B2A2E432E772B522E5F2B5F2B522E652B432E 5320772B422E432E7C207C20432E652B642E5E2E2320232023207E20292E292E 7E2E33203320652065206320422042207A2B4820432E2A2E5D2B232E232E752E 452E5D2B472E472E652B312E202B202B3120202B762B502E522E5D2E272B532E 68204720652B68202F2B392B3120392B392B392B3120392B392B392B392B392B 392B392B202B202B392B392B5F2E2F2B2F2B2F2B302E502E472068205D2E622E 532E652B5F2B47205F2B522E652B53206B202E20222C0A222E206B206A204A20 522E522E522E372B362E362E2E2E53205320642B642B48204820482048204B2E 4B2E4B2E402E70207B206E206020592E4F2E5B2B612B592E6B2E232E232E232E 55207B2B7B2B7B2B7B2B7B2B28205A20722B732B3620282E4F2E442B552E7B2B 7B2B232E7B2B7B2B552E232E3C2E40203E2E682E4E2E3A202F20472B2820642B 652B422E422E422E6820522E6A20322E322E262E322E262E612031206120392B 392B312E202B3120262E702E40206C2E742E252B732E712B632E372E5120672B 2D2B7C20652B68205F2B502E502E522E652B652B432E5320422E432E432E422E 652B362E7B2E3020232023202320292E7E207E20422033203320332033206520 63207E2E582E71204B2E402E452E5D2B452E452E472E402E5320422E5F2B392B 312E202B202B762B2F2B47206C2B272B622E652B292B652B502E5E2B5F2E5F2E 762B202B202B202B202B392B392B392B392B762B762B392B392B392B392B392B 392B392B5E2B2F2B302E302E502E47206820652B68204720522E682047204720 5D2E622E6B202E20222C0A222E206B206A205F2B5F2B522E442E442E562E442E 362E772B642B5320642B642B642B48204820482048204B2E7120702E3C20422B 282E282E6A2B6B2B4F20452055205520552055207B2B7B2B7B2B232E2D2B7B2B 412B3B20212B732B6A2B4F2E32207B2B2D2B7B2B552E7B2B7B2B552E7B2B752E 632B66206620352066203C2B742E212071202A2E5D2E432E272B652B562E442E 6A206A206A20262E262E6120792B312E392B3120392B312031203120792B762E 57202C20612B50205D202E2B632E212B5A2E282E542068206820522E5F2B322E 322E5F2B522E772B522E772B652B652B652B652B652B4A205E2E522052202320 23207E20292E292E322B3320652033206520652042207E2E5B202D207020402E 5D2B452E452E2A2E2A2E432E4A2049205E2B792B312E5F2E6120762B47206820 622E472E5320772B6820522E47206E2B762B31203120202B2D2E2D2E202B762B 392B392B202B392B202B762B392B392B392B392B3120392B5F2E2F2B2F2B2F2B 4720652B5D2E5F2B4720652B502E502E302E47204720272B242B2E20222C0A22 2E206B206A206A206A204720442E522E562E442E362E772B422E5320642B5320 642B642B642B7C2048202A2E462B6C20572046204C2E2C206E20782B602E232E 752E752E232E552055207B2B7B2B7B2B7B2B7B2B55203C203C2B5B2E36206E20 6E2E7B2B2D2B2D2B2D2B2D2B2D2B552E2D2B702E382E412E682E4E2E6620792E 5D20402B402E4B2E2A2E2A2E70205D2E772B442E442E442E522E322E262E6120 312E6120312E392B31203120482E482E6A20612B792E50203D2E792E3D2E792E 472B742E4C2E6E204B2E422E652B4720322E262E262E5E2B4720652B522E522E 522E522E772B652B772B652E30205220522023205220292E292E292E322B6520 33203320652065207E2E7A2B472E452E452E452E452E5420452E2A2E652B4A20 5E2B5E2B5E2B5F2E5F2E75207520752068205D2E622E432E652B652B68205F2B 4720302E2F2B762B202B202B202B202B202B202B2D2E392B202B392B202B392B 392B392B392B392B212E392B2F2B68204720762B47205D2E5D2E652B532E652B 47205F2B502E4720302E68206B202E20222C0A222E206B206A20522E562E522E 562E372B362E2E2E362E2E2E2E2E5320772B642B53205320642B7C20402E442B 6D20572E712B282E6020402B4520442B752E452E752E752E552055207B2B5520 7B2B7B2B7B2B2D2B2D2B692B4E2E512E732B6A2B6E202D2B6A2E442B2D2B6A2E 2D2B2D2B54203B2B342B612E66203A203A202C206C2E242E6F2E452E70207020 272B432E432E432E642B652B652B772B522E5F2B262E312E312031203120482E 482E312034202120512E4E2E3D2E74202B20572E612E3520742E4F207C206820 652B4720792B262E5E2B212E61205F2B47204A20502E322E4720772B4A205E2E 522023202320232023207E20292E7E20662E6520332065204220762056207C20 7020382B452E452E452E382B472E652B652B502E4A205E2B5F2E262E6E2B302E 302E472068206820272B5D2E682068206820302E502E5F2E392B202B202B202B 202B2D2E202B762B392B202B762B202B392B392B392B3120392B392B3120392B 2F2B2F2B47202F2B2F2B5D2E652B5D2E382B5D2E652B4720302E302E6E2B502E 6B202E20222C0A222E206B206A205F2B522E5F2B522E442E372B562E362E2E2E 362E2E2E772B2E2E2E2E422E4D2E7C207B20392E282E462E5B2B6E20672E2B2B 552E402E2D20402E232E752E232E7B2B7B2B7B2B7B2B2D2B7B2B552E7B2B2D20 4E2E2A207D203D20592E67202D2B442B2D2B2D2B2D2B2D2B2D206C2040203E2E 612E57202920792E3A206C204B2E5420702070202A2E2A2E2A2E2A2E70207020 7020272B422E68205F2B6120212E3120312E312E3120312E342050205D20742E 7E2B792E77206620472B712B212B592E272B68205D2E4720302E61205E2B6120 212E502E502E502E502E4A20502E6820632B5E2E522052202320232023207E20 292E7E20662E42206520652065207E2E3C2E272B382B382B382B382B622E5D2E 68205F2B502E302E5E2B5E2B5E2B5E2B6E2B6E2B6820682047205D2E272B5320 68205F2B502E502E5F2E392B392B762B2D2E2D2E202B202B202B202B762B202B 762B202B762B392B392B392B392B392B392B3120392B762B2F2B2F2B2F2B4720 472047206820652B652B652B68206E2B6E2B302E6B202E20222C0A222E206B20 442E562E522E652B562E772B362E2E2E772B772B772B362E772B2E2E562E562E 3B2B4020572074206D2050206E20672E4D20232E4B2E402E452E752E452E232E 552055207B2B7B2B7B2B2D2B7B2B2D2B2D2B2D2B28202620752B51206A2B592E 442B2D2B442B442B442B442B7120572E3A20662035202620792E21203C2B762E 772054205420402E70202A2E4B2E70205420232E5420382B7020272B68204720 6E2B61203120312E312E61205E2029207E2B57205A2059207B203A20742E252B 5A2E4D20622E6820652B682047205E2B2F2B5E2B392B5E2B5E2B5E2B5F2E502E 302E502E502E34207B2E5E2E52205220662E7E20292E7E20662E422065206520 42206F20432E622E382B382B622E5D2E772B4720502E302E5E2B302E2F2B2F2B 302E502E502E68205D2E682068206820652B652B652B502E5E2B392B5F2E5F2E 762B202B202B2D2E202B2D2E202B202B202B762B762B762B392B392B392B3120 392B392B392B392B5F2E392B5F2E5E2B302E302E68204720522E502E68206820 682047206E2B792B6B202E20222C0A222E206B20522E6820522E652B772B562E 562E372B442E442E372B562E562E2E2E7C2039205E2066205E2E2F2E6E202A2B 672B2B2B552E2A2E4B2E2D20452E752E55205520232E7B2B7B2B7B2B2D2B2D2B 2D2B2D2B2D2B2D2B5520612B512E692036206E204D20442B442B442B442B2D2B 552057203520682E572057203A20792E472B612B402B232E5420402E70204B2E 4B2E5D2B232E54205420452E382B2A2E652B522E302E792B792B312E312E312E 6120612B742E742E4320462E202E3B207A2B5B2E282E4D20622E5D2E68204720 4720302E5E2B5E2B5E2B5F2E612061205E2B5F2E262E502E502E472068203420 7B2E5E2E52202320292E292E7E20322B6520422056205320652B272B5D2E652B 472047206A20262E262E392B392B5E2B5E2B5E2B5E2B5E2B502E682047204720 68205D2E622E6820302E5E2B432B392B392B312E762B762B2D2E2D2E202B202B 202B202B202B202B202B202B392B392B392B392B392B392B392B392B392B2F2B 2F2B2F2B302E472068204720292B302E472047206E2B7520792B6E2B6B202E20 222C0A222E206B20562E562E772B772B772B372B372B442E442E442E442E442E 562E7C206720392E6E2E4E2E712B6020772E692E692E752E4B2E4B2E472E2D20 5D2B452E232E752E55207B2B2D2B7B2B2D2B2D2B2D2B442B2D2B442B442B5B20 742E5B2E36206A2B392E452045202D2B442B442B2D2B55203E2B3A20472B2620 472B50202620272E422B252E3A2E54205D2B5D2B542054205420452E54205420 452E7020652B68204720502E792B792B312E312E312E3420502026205E2E5B2B 782E272E5A20632E7A206A2E68206820682047204720502E2F2B5E2B392B5E2B 5E2B61205F2E61205F2E5F2E302E302E302E502E6A204120242E742B3020292E 292E2320762056204D2E302E4720302E302E6E2B752061207520612031206120 392B392B762B2F2B2F2B2F2B682068204720682068204720502E2F2B5F2E392B 5F2E5E2B392B392B392B202B202B202B2D2E202B202B202B762B392B762B392B 392B392B392B392B5F2E5F2E2F2B2F2B5F2E4720682047204720472047204720 47204720502E6E2B312E792B792B322E6B202E20222C0A222E206B20772B2E2E 772B772B2E2E362E2E2E772B562E372B562E3420702B5E206F2E60206D2B4520 5B2B6B2B392E602E5D2B48204B2E2D205D2B2D20752E752E55207B2B7B2B7B2B 2D2B2D2B2D2B2D2B442B442B442B2D2B442B55202A2B632E452B3620672E4520 4520452045204520442B45202D2B3C20572E472B26206C2E272E3D2E3D2B362B 762E252E5D2B382B7020702070207020452E542054207020432E652B6820302E 7520392B202B312E392B61206C2E662B782E21202620272E5A205B2E5A2E6A2E 302E472047206820502E522E502E5E2B5F2E5F2E5F2E392B392B5E2B2F2B5F2E 2F2B502E302E302E5E2B5E2B5E2B4920242E3E2B5E2E292E5620652E4A202F2B 2F2B2F2B792B312E312E312E762B392B392B3120392B5F2E5F2E2F2B47204720 47202F2B472047202F2B762B392B5F2E392B5F2E5F2E5F2E5F2E762B2D2E202B 2D2E202B202B2D2E202B392B202B392B202B202B392B392B392B5E2B2F2B2F2B 5F2E302E2F2B472047204720682047202F2B2F2B2F2B2F2B2F2B2F2B5F2E5F2E 762B792B6B202E20222C0A222E206B20422E422E422E422E772B2E2E362E562E 362E562E48202D205E20612E3E2E262B2520672E6E204D205820402E2A2E4B2E 4B2E2D202D202D20752E752E232E7B2B7B2B7B2B2D2B2D2B2D2B2D2B2D2B2D2B 4520442B4520692E5B2029205B2E512025204D20442B2D2B4520452045204520 442B7B2B5E2040203A2057202C20792E292029202920402B6D2039205D2B5D2B 70205D2B5420542054205D2B622E5D2E68206E2B6120762B392B392B31206120 3C20272E29203A20632E712B272E212B282E6720302E302E6820682047204720 302E302E5F2E5F2E2F2B5E2B2F2B2F2B302E302E2F2B5F2E5E2B302E302E302E 2F2B2F2B5E2B262E432B3B2B3B2B5E2B5F2E5F2E5F2E5F2E5F2E61205F2E6120 392B5F2E392B5F2E392B2F2B302E2F2B47202F2B2F2B2D2E2F2B762B392B5F2E 392B2F2B2F2B5F2E2F2B2F2B762B762B762B762B202B202B202B202B762B202B 762B202B762B392B392B392B392B392B392B2F2B2F2B2D2E47202F2B47204720 47202F2B6E2B2F2B5F2E2D2E2F2B2F2B2D2E2F2B762B5F2E6B202E20222C0A22 2E206B202E2E422E422E422E772B422E772B2E2E362E7C2039204F204F205B20 35203B2060206B2B6B2E3920702070207120402E402E5D2B752E752E752E5520 232E7B2B552E2D2B2D2B2D2B442B2D2B45202D2B45204520442B452055202920 7E2B4C2E51206A2B592E2F2E452045202D2B2D2B2D2B7B2B55203C2E3E2B5720 2C202C205E20792E272E2120252E7B20682B5420752E5420232E232E54204B2E 5D2E4720502E5F2E392B392B762B762B3120312E3B2B792E272E7A2B5A207A2B 2A203B2E36205820302E6E2B47206820502E502E302E302E2F2B5F2E6E2B302E 47206E2B47204720302E2F2B5F2E2F2B47204720302E5E2B762B392B5F2E6120 392B5F2E5F2E5F2E392B392B762B5F2E762B5F2E392B5F2E5F2E5F2E5F2E2F2B 2F2B2F2B2F2B2F2B2F2B2D2E2F2B2F2B5F2E2F2B392B5F2E2F2B762B2F2B2F2B 2F2B762B762B2F2B202B202B762B202B762B762B762B762B762B202B762B392B 2F2B392B392B392B762B762B2F2B47202F2B2F2B47202D2E2D2E2D2E5F2E762B 2D2E762B2D2E2D2E2D2E75206B202E20222C0A222E206B20422E422E2E2E2E2E 772B562E2E2E2E2E6820702E702B3C207B20392E7720472B4F206A2E70204B2E 70202D20402E2D202D202D20452E55205520232E7B2B7B2B7B2B2D2B2D2B2D2B 2D2B2D2B45202D2B32204520452045206A2E50202C20512E4620692025202520 392E592E2D2B7B2B2D2B2D2B7B2B232E752E2D2071207120462B762E702E612B 702E682B77203A2E5420752E232E5D2B472E432E322E5E2B312E5F2E312E392B 392B3120312E31203C2026203C2B472B272E7A2046204C2E36206B2E68207520 5E2B68206820472047206E2B5F2E2F2B6E2B2F2B302E47204720472075202F2B 302E302E2F2B2F2B5F2E2F2B5F2E392B392B392B392B392B392B392B392B392B 392B392B5F2E392B762B5F2E392B392B392B2F2B762B2F2B2F2B2D2E392B5F2E 2D2E2F2B2F2B2F2B2F2B2F2B762B2F2B2F2B2F2B762B392B202B762B762B762B 202B762B202B762B202B762B762B762B762B762B762B5F2E392B392B762B2F2B 2D2E2D2E2F2B2D2E2F2B2F2B752075202D2E202B762B2D2E2D2E2D2E2D2E7520 6B202E20222C0A222E206B202E2E772B772B362E2E2E362E562E2E2E562E382E 2E206B2035205920672B44207B2B2D204B2E71204B2E2D202D205D2B2D205520 752E55207B2B55207B2B552E2D2B2D2B2D2B2D2B45202D2B4520452045204520 2D2B4520692E4420662035203C2B372E36203620592E25206E2E44204F20782B 6B2E3A2E682B6D206F2E67207B2B39203920392058206A2E67202D2B2D2B602E 2D2B442B232E4820382B382B652B6820562E5F2B47205F2B6A205F2B702B6620 3A20662B472B792E57203C2B62207B207020302E61206E2B4720472047202F2B 5F2E762B5F2E7520302E47202F2B2F2B5F2E752075202F2B202B2D2E302E2F2B 762B3120392B392B392B392B392B392B762B762B202B202B762B762B762B5F2E 392B392B392B5F2E392B392B392B762B762B762B392B762B392B392B762B5F2E 2F2B5F2E762B392B392B202B392B762B762B762B202B762B202B762B762B202B 762B392B392B392B5F2E762B5F2E2F2B392B762B2D2E2D2E2D2E2D2E2D2E2F2B 2D2E2D2E2D2E2D2E2D2E202B202B2D2E202B762B6B202E20222C0A222E206B20 642B422E422E2E2E772B2E2E562E562E49204020612E342B612E2C206E20602E 71204B2E702070204B2E2D202D202D20752E5520452E5520232E7B2B7B2B2D2B 552E2D2B45202D2B452045202D2B442B4520452045204520692E55204020342B 4E2E212B51203B2E212B36203620732E762E422B422B2A2B762E2120402B342E 402B422B402B782E7B20422B7B20402B262B5920262B6D20682B402B5F203920 682B362B6F2E67207B206A2E77206F2E39203C20402B362B662B2F203A203A20 572E5720252E5D2B68205F2E2F2B2F2B472047202F2B5F2E5F2E2D2E2F2B7520 762B312E762B312E202B312E5F2E2F2B2D2E2D2E392B392B392B392B392B392B 202B202B392B202B392B392B202B392B762B392B5F2E392B392B392B392B392B 762B2D2E202B762B762B202B762B762B392B392B392B392B392B392B392B392B 202B762B202B202B762B762B762B762B762B2D2E762B762B762B762B392B5F2E 392B5F2E392B392B2D2E2D2E2D2E2D2E2D2E2D2E2D2E202B2D2E2D2E2D2E2D2E 2D2E2D2E2D2E2D2E6B202E20222C0A222E206B20642B2E2E422E772B5320422E 562E442E5E20612E3B203B2035203B204520552E272B48204B2E70202D20402E 2D202D20752E752E55207B2B7B2B552E7B2B2D2B2D2B2D2B2D2B452045204520 45204520452045202D2B442B3220442B412B6C20402066204E2E2620372E6920 7420632E4320792E5E202C20612B212021202120362B2120762E5D202120362B 212029202120502029203D2E612B272E612B2C2026206C2E5020612B3D2E3D2E 502029202120262B6D206E2E3220262B262B682B402B21204E205F204D206820 2D2E47202F2B47202F2B2D2E392B5F2E3120312E312E312E762B2D2E762B202B 2D2E2D2E762B202B392B392B392B392B392B392B392B762B762B202B202B202B 202B392B762B5F2E392B392B392B392B3120392B392B2D2E762B762B762B392B 392B392B392B3120392B392B392B392B392B392B392B762B392B202B392B762B 762B762B392B762B762B762B762B2F2B392B5F2E392B5F2E5F2E5F2E762B2D2E 2D2E2D2E2D2E2D2E2D2E202B2D2E2D2E2D2E2D2E2D2E2D2E2D2E762B6B202E20 222C0A222E20242B53205320642B642B2E2E362E2E2E562E242E572E742E5A20 29203B206F2E2A2E7C20482048204B2E4B2E402E402E5D2B452E452E232E452E 232E7B2B7B2B7B2B2D2B2D2B2D2B45202D2B45202D2B45202D2B45204520442B 2D2B2D2B3A2E462B692B5E2057204E2E2E2B29205020612B3C20472B5E20792E 2A2B362B2120362B21202120362B362B212021202A2B792E612B2C20612B2C20 6C2E57204E2E472B3E2B4E2E4E2E4E2E2E2B612B2620472B472B2620612B3B20 792E612B4420402B5D20402B782E782B672E5D2E2F2B2F2B2F2B2F2B762B312E 392B392B392B6120392B312E792B762B202B2D2E202B762B762B2D2E47204720 292B652B652B502E392B392B202B202B202B3120202B202B762B762B2F2B5F2E 392B392B392B392B392B392B762B5F2E5F2E762B762B5F2E5F2E5F2E5F2E392B 392B2F2B392B392B392B2F2B2F2B392B762B392B392B392B762B392B392B392B 392B392B5F2E5F2E5F2E5F2E392B5F2E392B762B762B762B762B392B392B202B 2D2E2D2E2D2E202B762B2D2E762B5F2E6B202E20222C0A222E206B20642B362E 642E362E362E362E2E2E2E2E7120572E682E742B3D2E5B20412B642B48204820 4820482048202D202D20402E5D2B452E752E452E552055207B2B7B2B7B2B2D2B 442B2D2B452045204520452045202D2B2D2B78202D2B5520692B762E71202A2B 43203C20612B272E5020612B612B4320362B43202A2B362B762E362B402B762E 402B402B5B20762E762E692B762E362B612B2C206C203E2B57203B20612B6C2E 572E572E4E2E3B20792E3C202C203B202C202C20472B432050202A2B2A2B2A2B 402B6E2E602E2D2E752075202D2E5F2E61203120312E392B31203120392B392B 392B762B762B2D2E762B202B2D2E472047202F2B5D2E472E382B68205E2B392B 392B392B202B392B392B392B762B762B2D2E2D2E5F2E762B762B392B392B392B 392B762B5F2E2F2B762B762B762B5F2E5F2E392B392B392B392B392B392B392B 392B392B392B2F2B392B392B2F2B392B2F2B392B5F2E5F2E392B392B432B392B 5F2E5F2E5F2E5F2E5F2E762B762B2F2B2F2B762B762B2D2E2D2E2D2E762B7520 7520792B6B202E20222C0A222E206B20362E4D2E362E362E2E2E372B562E362E 642E4E2E7A2B232B232B202E2D207C207C207C204820482048204820472E2D20 472E2D20472E452E232E452E7B2B7B2B7B2B7B2B2D2B2D2B2D2B2D2B2D2B2D2B 4520442B2D2B2D2B202E762E792E762E402B762E362B362B362B4420362B5020 2A2B612B21202A2B362B362B362B362B402B402B402B252E252E7720252E252E 252E762E2A2B2A2B2A2B43205E203B20612B3C205720572E572E792E44202A2B 43202A2B2A2B43207B2E2A2B442044205B2044205B206E2E452E5F2E762B5F2E 5F2E312E392B392B612031205F2E392B312E312E2D2E202B312E762B202B2D2E 2D2E2D2E2F2B2F2B6820472E622E47202F2B392B392B392B392B392B3120392B 762B392B762B762B762B762B392B762B762B392B392B392B762B762B2D2E392B 762B2F2B2F2B392B2F2B392B392B2F2B202B7A2E2F2B392B392B392B392B392B 392B5F2E392B392B392B5E2B5F2E392B762B5E2B392B61205F2E762B5F2E392B 5F2E762B5F2E5F2E2F2B5F2E5F2E5F2E7520762B2D2E5F2E6B202E20222C0A22 2E206B204D2E4D2E372B4D2E362E362E372B362E4D2E4420232B602025204D20 4B2E642B642B642B482048204B2E4B2E2D202D202D202D202D20752E452E5520 552055207B2B7B2B7B2B7B2B2D2B2D2B2D2B2D2B2D2B442B442B55205B20612B 792E792E362B762E362B2A2B612B2A2B432043202A2B2A2B762E362B762E462B 402B5B205B20252E712077207720772077202D207720772077207120252E762E 692B362B402B762E28205E2057203E2B4420402B362B3D2E3D2E362B612B3D2E 262B402B402B402B402B59202B2B622E312E5F2E792B5F2E312E312E392B312E 312E312E6120312E5F2E2D2E312E2D2E762B762B2D2E2D2E392B5F2E2F2B502E 502E5E2B392B392B392B392B392B392B392B392B392B202B312E202B762B762B 392B762B2F2B762B762B202B762B762B762B75202D2E2F2B2F2B762B392B7A2E 202B392B392B392B392B392B392B392B392B5F2E392B392B5F2E5F2E392B5F2E 5F2E5F2E392B5F2E392B5F2E5F2E762B5F2E762B5F2E762B5F2E762B2F2B2D2E 2D2E5F2E75205F2E2F2B312E6B202E20222C0A222E206B207D2B4D2E442E4D2E 362E562E2E2E362E562E2D206D206E2025204D202A2E5320642B432E2C2B4820 48204B2E4B2E4B2E402E2D20472E472E452E452E452E752E752E552055205520 7B2B7B2B2D2B2D2B442B2D2B3A2E43206C2E2C202A2B612B2C20252E462B692B 2A2B2A2B432043204320432043202A2B2820362B692B692B462B5B205B205B20 772077202D203A2E6F2E402E6F2E6F2E7720772077205B205B205B205B20692B 3C206C2E362B402B5B20402B762E362B3B20442044204E2044204420402B422B 6D205420792B5F2E312E5F2E5F2E5F2E5F2E5F2E5F2E5F2E762B792B312E312E 312E312E762B5F2E762B5F2E5F2E5F2E61205E2B2F2B5E2B2F2B762B5F2E392B 392B392B392B392B762B312E762B2D2E392B762B392B392B392B762B5F2E392B 75206E2B2D2E6E2B47202F2B2F2B392B762B762B392B392B2F2B392B392B7A2E 2F2B392B5F2E392B5F2E392B2F2B5F2E2F2B2F2B5F2E5F2E5F2E5F2E5F2E5F2E 5F2E5F2E2F2B2F2B2F2B5F2E762B5F2E762B5F2E5F2E2F2B762B2F2B5F2E5F2E 6B202E20222C0A222E206B204D2E4D2E372B4D2E372B442E562E362E562E2E2E 7120682B692E6A2E71207C2053207C20642B48204B2E4B2E4B2E2D20402E402E 402E2D20472E2D20472E2D202D20752E752E55205520232E7B2B2D2B2D2B5520 3C20572E572E792E762E2A2B2820762E462B692B362B692B2A2B2A2B2A2B4320 4320432028203C203C202C203C20432028202A2B412B772077202D2077207120 412B77202C2B5B205B20762E5B20362B2A2B242E6C2E57203E2B612B612B4320 612B43202C20612B44204420362B2A2B4420682B39202A2E792B792B792B5F2E 5F2E2D2E2D2E2D2E2D2E2D2E2D2E2D2E2D2E6E2B752061207520792B5F2E5F2E 762B392B5E2B61206120392B2F2B762B5E2B5F2E5F2E392B5F2E312E312E762B 762B2D2E762B762B392B392B5E2B5F2E2F2B502E472068206820682047202F2B 2D2E392B392B392B7A2E202B2F2B2F2B2F2B762B392B5F2E392B2F2B5F2E2F2B 392B2F2B392B5F2E392B2F2B5F2E5F2E2F2B2F2B302E762B762B5F2E2F2B5F2E 5F2E5F2E2F2B2D2E762B7520762B2D2E2F2B792B6B202E20222C0A222E206B20 642E362E4D2E372B642E2E2E562E442E562E562E562E562E2E2E652B7C205320 642B642B482048204B2E2D20402E402E402E2D204B2E4B2E482048202D202D20 2D20452E752E452E232E452E5520232E752E242E572E612E572E762E252E7120 5B20462B692B692B6F20282028202A2B652E2A2B43202A2B2A2B2A2B43202A2B 2A2B4320432028202A2B692B762E702E2A2B2820242E3C203C202C205E203E2B 6C206C2E6C203E2B6C2057203E2B2A2B2A2B44202A2B432043202A2B402B5B20 772077206D20682B6A2E502E7520752075207520752075207520792B7520792B 792B75206E2B68204720792B5F2E5F2E5F2E5F2E5F2E392B392B432B6120392B 2F2B2F2B302E502E5E2B6120262E6120312E792B762B2D2E762B762B762B392B 5E2B6120502E6820472068205D2E682047202F2B2F2B5F2E392B392B392B2F2B 2F2B2F2B2F2B2F2B2F2B5F2E392B2F2B2F2B2F2B2F2B2F2B2F2B2F2B762B2F2B 762B2F2B762B2F2B2F2B2F2B2F2B2F2B5F2E5F2E762B762B5F2E5F2E2F2B5F2E 75205F2E762B5F2E6B202E20222C0A222E206B20642E642E642E372B53202E2E 562E6A20442E522E6820562E68202E2E642B5320432E482048204B2E2A2E2A2E 2A2E702070202A2E4820432E2C2B48204820472E2D202D20472E2D20402E402E 402E452E4B2E5E20572E612E6C205B205B20252E77205B2077203A2E6F2E412B 2C2B282043207B2E652E2A2B44202C2B4420692B692B692B28202A2B28202A2B 692B362B2A2B612B3C203C203E2B3E2B6C2E3E2B3E2B3C203C203E2B3E2B3E2B 3C204320692B692B4420462B5B202C2B5B20412B5520202E392E6B2B4D206820 7520752075207520792B792B75207520792B2D2E752075207520472068206E2B 752075207520792B5F2E392B5F2E6120392B432B392B5E2B4720652B5D2E652B 68205E2B6E2B792B5F2E5F2E5F2E762B762B762B5E2B322E522E272B382B272B 652B47204720762B5F2E2F2B762B392B392B2F2B2F2B472047202F2B2F2B2F2B 2F2B2F2B2F2B2F2B2F2B392B5F2E762B2F2B5F2E2F2B392B2F2B2F2B2F2B762B 5F2E762B2D2E5F2E5F2E762B2F2B392B2D2E5F2E2F2B5F2E5F2E5E2B6B202E20 222C0A222E206B20642E4D2E4D2E4D2E442E442E562E522E6A20472068206820 372B362E432E2A2E532E652B422E7C20642B642B7C20272B272B272B432E5320 432E48204820532E4B2E472E452E402E382B472E2A2E272B652B3B2B572E6C20 2C20462B462B77203A2E3A2E77205B207120252E5B205B20692B3C20652E6F20 692B692B2C2B692B692B6F20692B692B3C2E5B20462B6F20242E652E43203C20 3C203E2B3E2B3C203C20242E3C20652E28202C2B2C2B7120462B5B20412B692B 692B44207B2045202D2B4F206B2B782B772E602E6E2B792B792B792B2D2E792B 792B75207520792B6E2B6E2B75206E2B47204720502E502E5E2B5E2B5E2B6120 612061205E2B302E5E2B5E2B2F2B6820432E272B5D2E5D2E68204720302E2F2B 5F2E762B392B2F2B302E502E5D2E382B54207020272B682047202F2B2F2B5F2E 2F2B2F2B762B2F2B4720682047206820502E2F2B5F2E502E2F2B5F2E2F2B2F2B 5E2B2F2B392B5F2E762B5F2E762B2F2B2F2B5F2E762B5F2E762B5F2E2F2B5F2E 392B2F2B5F2E762B5F2E762B2F2B2F2B6B202E20222C0A222E206B202C2B362E 642E4D2E772B562E6820562E562E47204720442E6A204A20372B362E772B362E 372B772B5320432E2A2E2A2E2A2E622E622E432E432E652B652B772B772B772B 772B772B772B372B4A206A206A206A20572E6C20242E462B7120772071207720 7120462B762E402B402B252E7720462B6F20652E6F206F206F20652E6F206F20 6F202C2B2C2B2C2B48202C2B692B692B2820652E28206F2028203C2E412B412B 412B4B2E2D207720412B462B692B2820282043206F205B2059205920262B262B 692E5F20592E782B5420312E752075207520792B312E7520792B752075207520 75206E2B382B2B2B2B2B552E2F2B5E2B5E2B262E5E2B322E502E502E5E2B5E2B 5E2B5F2B532058204D204D2058206820502E6E2B5F2E5F2E392B5E2B302E502E 652B452E5420452E5420382B652B47204720602E602E2F2B2F2B652B68205D2E 47202F2B302E2F2B5E2B47204720302E302E2F2B2F2B2F2B5F2E2F2B2F2B5F2E 762B2F2B2F2B762B2F2B392B762B5F2E2F2B5F2E5F2E2F2B2F2B2F2B2F2B762B 5F2E5F2E6B202E20222C0A222E206B20482053202C2B642B642B2E2E442E562E 6A206A206A206A206A206A204A204A20362E772B5320642B7C20272B2A2E652B 652B6820682068206E2B262E6120612061206120262E262E6A206A20322E4920 5F2B322E402040202C20462B4B2E7120712071205B205B20402B402B402B402B 262B402B462B642E6F20652E652E652E6F206F206F20692B3C2E6F206F206F20 6F206F206F206F202C2B412B2C2B702E412B71202C2B462B2C2B34202820242E 242E28205B206F2E77205B204420462B362B5D20402B252E422B7B202B2B452E 6E2B7520752075207520792B7520752075206E2B7520752058206D2B782B602E 552E452E472E362E58205820372B472054205820452E522E6C2B602E6D2B782B 6D2B452E272B5820552E502E682058205820652B5D2E602E2B2B552E402E552E 6B2E552E4720782B782B472047205D2E6820292B302E502E5E2B322E2F2B2F2B 4720472047204720302E5E2B2F2B5F2E5F2E2F2B2F2B2F2B302E392B2F2B5F2E 5F2E5F2E762B5F2E2D2E2F2B5F2E2F2B2F2B5F2E392B5F2E6B202E20222C0A22 2E206B204820482048204820642B642B562E442E442E442E68206A2049204A20 442E372B772B53205320772B562E522E522E322E262E612061206120312E6120 312E792B792B61206120262E502E502E502E6A206A203B2B572E572E3420252E 71207120712071203C2E692B692B692B402B402B402B262B262B462B3C2E6F20 6F20652E652E3C207B2E242E652E652E6F206F206F202820692B2C2B2C2B7120 2C2B28202820632B242E3C20242E28205B20752E6F2E28205B205B205B20402B 402B402B692B44205B20402B402B262B6D204D2054206E2B792B792B75207520 6E2B6E2B792B792B75206E2B602E6D2B5420652B772E772E4D204D20772E772E 2B2B58206D2B772E772E5420432E6B2E772E6B2E6D2B5420782B782B6D2B5820 4D20672E772E4D20602E6D2B672E782B6A2E772E782B6D2B5820782B782B2F2B 392B4720472047202F2B41202F2B4120302E302E302E302E302E302E302E2F2B 2F2B2F2B762B2F2B5F2E2F2B2F2B5F2E5F2E762B762B392B5F2E5F2E5F2E2D2E 5F2E5F2E2F2B2F2B5F2E5E2B6B202E20222C0A222E20242B4820482048204820 2C2B642B642E562E442E562E362E372B372B4A20372B372B362E372B522E6A20 6A20322E262E61206120312E6120312E6120312E312E792B312E792B312E792B 6120792B792B3B2B382E40206C206C2E2A2B762E7120462B692B692B692B2C2B 2C2B7120692B242E5D203D2E4E20402B2C2B282028206F206F20642E6F202820 34206F20242E652E3B2B3C20242E632B242E632B28203420652E2820412B5520 7B2B2D2B7B2B71202820412B6F2E5B20402B2A2B44205B203A2E7720462B462B 362B402B262B7D2E782B5820302E7520792B792B75205E2B5F2E752075202F2B 58206D2B782B552E672E672E452E772E772E772E782B6B2E6D2B672E6D2B402E 4120602E6D2B782B6D2B452E4D20602E6D2B602E4D20782B6B2E54206B2E6D2B 602E4D20232E782B2B2B6D2B5820782B4D204C20352B5F2E47207D2B4720502E 522E472047204720302E502E302E502E502E5E2B2D2E2D2E7520762B2F2B2F2B 2F2B2F2B762B5F2E2F2B762B2D2E2F2B2F2B2F2B2F2B2D2E5F2E5F2E2F2B5F2E 6B202E20222C0A222E20242B402E2D204B2E4B2E642B642B642B4D2E362E372B 522E522E372B372B772B772B362E372B4A20442E6A206A205F2B502E322E792B 792B792B792B6120792B792B312E6120312E762B312E492034206C2057205720 6C206C205E20362B462B34202820462B3C2E462B7120712048203C202A2B762E 5D205B205B20692B6F2044206F20692B6F206F206F206F206F202C2B2C2B2C2B 2C2B55205520202E442B442B39202D2B45206B2E58203A2E71202A2B462B6D20 412B5B203C2043205B2077205B2B5B205B2071202820762E3D2E59206E20772E 58202D2E6E2B792B6E2B75205E2B75206E2B6E2B602E6D2B6B2E652B782B6B2E 3A2B772E672E6B2E6A2E54206D2B4D202B2B4D2E702B552E6D2B2B2B2A2E3B2B 5820782B6D2B582068204D20672E542058206D2B4820642E632B2B2B782B6D2B 232E4D204D204C20722E61204720292B502E502E4A207D2B302E502E502E5E2B 322E2F2B262E5E2B75202D2E6E2B2D2E75202F2B2F2B2F2B5F2E2F2B2F2B5F2E 762B2F2B762B762B5F2E2F2B2D2E762B2F2B5F2E6B202E20222C0A222E20242B 5D2B402E2D2048204820482048207C20642B53204D2E362E772B532053205320 652B362E522E522E522E562E6820522E5F2B5F2B5F2B262E262E792B792B6120 61206120792B792B792B34205E206C20572E242E3C205E20612B362B462B462B 762E7120252E252E7720772071203C2E6F202A2B3D2E4E207720462B652E652E 2820282044202D2039202D20202E442B2D2B45202D2B6E2E602E672B2B2B4F20 2B2B592E782B4D202B2B452E2C2B2A2B5520682B77205B20442077205B205B20 77207720712077207720692B462B402B5F20772E782B68205F2E75206E2B6E2B 752075202F2B6E2B58206D2B5D2B6120672E6B2E2420672E4D206B2E2B2B232E 6D2B602E772E48206C20232E6D2B232E24203420772E6B2E6D2B602E602E6B2E 4D20782B602E672E7B2B782B232E6D2B6B2E6D2B232E4D204D20702B24204C20 322E47202F2B5E2B2F2B2F2B322E2F2B5E2B5E2B5E2B5E2B5E2B752075207520 2D2E75202D2E2F2B2F2B2F2B5E2B2F2B2F2B2F2B2F2B2F2B2F2B2F2B2F2B5F2E 2F2B2F2B5F2E6E2B6B202E20222C0A222E20242B402E402E402E4B2E4B2E4B2E 4B2E7C204820482048204820432E4820432E422E652B2E2E6820562E6820772B 652B562E6A205F2B5F2B5F2B6A20322E262E262E262E61207520792B49202A2B 3B2B6C2E3C203C20612B2C20242E252E462B252E7120252E252E252E252E7720 762E7720462B2820362B362B262B5B2028202A2B6F203920462B202E692E3A2E 6E2E202E4F20692E4F202B2B2B2B4D202B2B4D202B2B6B2B4D206B2B782B4D20 602E7720442B772077205B20202E55205B205B20682B442B4520772077207720 462B402B7B20592E672E5D2E752075206E2B6E2B6E2B75206E2B6E2B58206D2B 382B3B2B672E6B2E722E6B2E6D2B772E602E7C20772E672E672E442E702B552E 6D2B752E2420632B672E672E6D2B602E6B2E6D2B672E2B2B4B2E6D2B782B4D20 452E772E672E6D2B54204D204D203A2B722E61206E2B302E302E2F2B2F2B2F2B 2F2B5F2E5F2E5F2E2F2B5F2E5F2E792B792B792B792B7520792B2D2E5E2B5E2B 322E5E2B5E2B5E2B5E2B5E2B5E2B5E2B6E2B5E2B302E6E2B2F2B5E2B6B202E20 222C0A222E20242B4B2E2A2E48202A2E2A2E482048207C204820482048204820 4820432E2E2E772B422E6820562E522E562E6820772B522E562E522E47205F2B 47205F2B472047204720522E6A206A205020362B3C206C20362B5E20792E3C20 2120762E6F2E7120252E7720252E252E252E682B252E252E5B2028202A2B362B 402B462B2A2B2A2B742E2A2B4320362B362B44204420692B5B205B20202E7720 692E3A2E7B202D2B6D202D2B6D20692E45206E2E452039206A2E6F2E7720262B 692E5B20402B5B20412B772055202D2B4420552044204420262B4D206B2E302E 6E2B75206E2B7520752075202F2B6E2B622E5420502E24202E2E432E702B632B 5820232E632B3B2B4D2E232E34203B2B3B2B7C20552E702E722E3B2B452E232E 70204D2E4920452E232E6A20702B702E70206A20492070207C20642B61206A20 442E24202420212E5E2B6E2B2F2B2F2B2F2B2F2B5F2E5E2B5E2B6E2B5E2B6E2B 6E2B75205F2E5F2E5F2E5F2E75206E2B2F2B502E502E502E41205F2B502E502E 322E322E5E2B5E2B6E2B6E2B6E2B6E2B6B202E20222C0A222E20242B272B7C20 4820642B7C20642B642B432E432E5320532053205320772B362E772B68206820 522E522E522E4720522E5F2B5F2B5F2B47205F2B4720522E522E682068206820 562E34202120252E792E5E2021205E20612B242E2120762E252E712071207120 7120252E252E6F2E252E6F2E402B702E2A2B4420402B5B2044204320742E2A2B 3C2B4420692B762E362B362B692B462B402B5B205B207B20772039202B206D20 682B3220692E692E3920682B3A2E77207120422B3920402B402B772055203A2E 77203920402B5920412B462B7B204D20682075206E2B75206E2B5F2E75207520 752047204720472061202420702B6A203B2B492070204820632B242E632B4D2E 3B2B3B2B4920642E70204D2E702B4C202E2E2E2E4920702B702B4C2049202420 242024203B2B702B702B702B4C202420722E722E242024202420212E5E2B5E2B 5E2B2F2B2F2B2F2B2F2B302E322E5E2B5E2B262E262E6E2B75206E2B6E2B302E 6E2B302E302E502E302E502E502E4720322E502E522E4720502E5E2B6E2B5F2E 6E2B6E2B6B202E20222C0A222E20242B7C207C20422E642B7C207C207C207C20 5320772B362E362E4A20522E522E652B422E47204720502E6A206A20792B6120 6120262E262E6A2047204720472047206820682034203B2B5020252E612B2C20 5E205E20362B2120762E402B252E252E252E252E252E252E252E252E682B252E 252E692B2A2B44205B20402B2A2B742E742E2920272E29203D2E3D2E50205020 5020612B502050205020612B2C202C202A2B612B402B402B2B2059207B207720 6F2E77205B205920772044203D2E402B5B20412B77205B204420202E77207720 4D2054207520792B312E75202D2E7520312E312E2D2E7520302E302E6A204C20 6A20562E6A2034204B2E70207C20702E48204B2E4820642E642B4B2E382B7C20 632B4920442E6A203B2B4C204C204C2049203B2B702B4C20442E6A204C204C20 49204C204C207320212E212E3A2B312E5E2B6E2B302E302E6E2B302E522E522E 68206820652B6820522E5F2B4720302E302E302E502E302E302E502E47205F2B 522E522E772B532E382B272B772B6E2B5E2B5E2B5E2B502E6B202E20222C0A22 2E206B20642B422E422E422E2E2E362E562E372B372B4A204A204A204A206A20 522E472068205F2B302E6E2B792B262E262E6120262E792B792B322E6A206A20 6E2B6A20472068206820702B6C2E2120792E242E2C20792E4E205D203D2E762E 252E252E252E252E252E4E20402B402B782E252E462B762E362B762E4E204E20 50202A2B272E3B203B20472B3B20472B472B6C2E2C20472B57206C2E6C2E3A20 3A205720572E3A20572057202C202C203D2E682B3A2E7720762E262B7720362B 742E4420362B402B4420442077207B205B2B2B2B4D2068205F2E7520312E792B 312E75202D2E792B312E6E2B302E502E472047206820422E362E2E2E4B2E452E 232E402E402E402E70204B2E4B2E702070202A2E432E562E772B6820502E6A20 262E262E522E522E6A20442E422E5D2E562E442E262E6120792B302E302E6E2B 792B5E2B5E2B6E2B5E2B502E522E6820652B272B382B382B452E7020652B652B 6820502E302E6E2B502E502E47205F2B6820522E532E432E70205420452E622E 432E522E502E502E5E2B5E2B6B202E20222C0A222E20242B422E422E422E422E 772B562E442E6A20442E492049206A206A20522E5F2B5F2B792B6A206E2B6120 61206120612061206120612061206120792B262E49206E2B6A206A2047203B2B 572E6C206C2E2C206C2E2C204E205D2029204E204E204E20252E62205D205D20 252E252E422B262B402B462B762E2A2B4E2E4E2E662B4E2E3A20352066203A20 3A203A204E2E572E6620612E3E2E6620572E242B382E2C202A2B612B6C20242B 6620572E2E2B782E422B262B402B262B3A2E44204320742E732E77204420462B 5B2B77202D2B6B2B602E75202D2E61202D2E312E2D2E312E792B312E7520792B 5D2E622E622E2A2E7C205F2B522E522E772B7C207020402E4B2E4B2E4B2E432E 2A2E2A2E48202A2E2A2E772B6820522E502E5F2B6E2B47206820522E5F2B422E 272B272B68206A206A205F2B5F2B522E4720502E302E75205F2E322E502E4720 272B272B2A2E70205420702070202A2E422E522E502E6E2B5E2B322E302E502E 472068206820772B472E5D2B232E552E452E382B472E652B6820502E5E2B502E 6B202E20222C0A222E206B20422E772B772B6820522E562E522E522E522E4A20 322E4A205F2B322E262E262E792B6120312E6120312E312E6120792B312E6120 612061203120612061206120792B792B6A206E2B702B572E5720572E572E5720 21205D203D2E252E252E762E762E5D204E2062206220782E422B782E252E262B 262B6C2E4B202E2B712B712B472B4E2E4E2E472B742E2920742E792E2C206C20 66203A20572040206C20422B762E5D20402B2A2B2C2050202620792E3D2E4E20 422B262B262B77202A2B742E44203A2E5B20402B4420262B2F2E4D20622E312E 792B312E7520792B2D2E792B2D2E792B792B792B4D20772E772E772E6B2E262E 322E322E262E322E372B772B432E2A2E432E362E362E7C20642B5320422E522E 4A20502E262E502E502E5F2B522E422E422E5D2E2A2E652B562E502E5F2B6820 472068204720502E502E5E2B5E2B5E2B522E432E532E382B452E382B7020432E 432E2A2E432E422E522E522E522E522E5F2B522E47205320652B7C20452E552E 2D2B6A2E452E272B652B68205F2B502E2F2B322E6B202E20222C0A222E20242B 362E522E522E522E47205F2B5F2B5F2B322E502E322E5F2B502E262E61206120 312E31203120482E3120312E312E3120312E312E312E312E312E312E6120792B 612061206120792B3B2B382E5720572E572E572E5720272E5D205D20252E5D20 362B5D204E20252E252E422B422B782E3D2B5D20272E662B5E2E272E632E512E 272E3C2B792E632E29203D2B5D20272E792E792E6C2E262050205E205E20692E 5D205D20782E762E29205D20272E2E2B26203D2B462E462E462E592044202A2B 3D2E5B2B462E7720262B39202B2B582068206E2B5E2B6E2B75207520312E792B 312E5F2E5F2E6120782B6D2B6D2B6D2B2B2B49206120502E522E5F2B522E372B 652B70204B2E7C20442E772B432E53205320772B522E4A20522E5F2B5F2B6820 622E2A2E2A2E2A2E7C202E2E442E442E6820682047205F2B47204720502E502E 502E4A20772B432E622E2A2E452E5D2B48207C204820482048205320652B652B 272B432E652B772B432E652B2A2E452E6A2E58206A2E452E5D2E47204720302E 4720302E302E6E2B6B202E20222C0A222E206B20372B4A206A206A205F2B502E 262E262E6120262E6120502E6E2B61206120612061203120312E482E3A2B312E 312E3120312E3120312E302E562E302E6E2B7520792B6120212E61204920702B 572E6620242B35203A20662B2C2050205D206220252E4E205D2062206220782E 622029202920632E3C2B712B2A20512E3D2B3D2B4E202920742E632E29207E2B 2920612B472B2C206C2E792E292029202120782E292029205D205D2029202920 3C2B712B2E2B2A203D2B462E462E422B5920202E5920412B5920402E702E562E 562E4720502E302E47204720302E6E2B792B752075206E2B7520262E782B6D2B 6D2B6D2B6B2E61206120522E622E652B472E7020452E232E452E7020362E362E 652B2A2E452E382B472E272B2A2E272B432E432E2A2E2D205D2B232E54202A2E 422E522E522E772B5D2E432E622E272B772B5F2B432E272B622E402E402E452E 232E5D2B5D2B5D2B402E382B4820432E472E7020452E552E552E5420382B382B 54207B2B2D2B7B2B5D2B4820652B522E4720302E47202F2B302E6E2B6B202E20 222C0A222E206B20372B522E6A20322E262E6120262E6120322E322E322E502E 6A20262E792B792B312E312E3120312E3120482E482E3120482E312E702E692E 5F206F2E502E6E2B792B792B612061206120702B6C2057203A20402035203A20 3A203A203C2B292029205D2029205D202920272E3C2B3C2B3D2B3D2B2920512E 512E3D2B6220622062203D2B3D2E2920292062204E202920362B4E2029205D20 252E252E782E762E782E4E20252E402B5D205D20272E712B2E2B2E2B3C2B4620 342E782E46207B207D2E6D2070206A20312E61205F2E5F2E792B75207520302E 6E2B75206E2B75206E2B6E2B6E2B502E782B6D2B6D2B6D2B6B2E702B4C20302E 652B5420782B772E6D2B6D2B6D2B672E6B2E2A2E432E4D20782B672E782B672E 782B782B542070205820392E6D2B6D2B6D2B6D2B782B5820682068206B2E782B 782B782B6B2E5820772E58204D20782B672E672E2B2B7B2B782B672E782B672E 232E2A2E552E782B6D2B6D2B6D2B6D2B782B602E5420552E232E5D2B2A2E652B 522E502E5F2B302E302E4720302E6E2B6B202E20222C0A222E206B20522E4A20 4A20322E502E262E502E502E502E5F2B5F2B68206E2B262E6120792B31206120 312031203120482E482E312E34202B2051203D203D20722B7B20562E792B7520 262E262E6E2B4920702B6C206C2E3A20572E4E2E4E2E682E2E2B7A2B632E632E 512E512E5020632E512E3D2B622062205D203D2B3D2B622046207C2B7C2B2B20 7C2B622062206220782E422B422B342E422B682B342E342E342E422B342E682B 682B252E252E4E203D2E292029207E2B782E7120442E492028205B20462B442E 792B312E792B762B792B762B6120762B5F2E752075205F2E7520752075207520 6E2B6A20782B6D2B6D2B6D2B602E382E2420262E5D2E672E6D2B6D2B6D2B6D2B 6D2B6D2B6D2B602E422E782B6D2B6D2B6D2B6D2B6D2B6D2B232E552E772E6D2B 6D2B6D2B6D2B6D2B6D2B6D2B5420522E2B2B6D2B6D2B6D2B4D206D2B6D2B5820 782B6D2B6D2B6D2B4D207B2B772E6D2B6D2B6D2B552E452E672E6D2B6D2B6D2B 6D2B6D2B6D2B6D2B602E5420452E7020432E68204720302E502E4720302E4720 47206E2B6B202E20222C0A222E206B20372B772B522E522E502E6A20262E502E 4720682047204720322E792B61206120312E31203120312E482E312E562E3920 5F203D203D203D203D203D203D205F2071206120792B61206120612061203B2B 5E20572E572E662035203520662B512E512E632E3D2B3D2B632E512E3D2B4620 622062203D2B3D2B622062206220782E7C2B422B782E782E6220782E422B342E 342E6F2E342E682B6F2E3920682B6F2E6F2E682B682B252E4E20762E4E204E20 5D20462E4D20622E6820302E792B792B792B792B312E792B762B792B762B5F2E 762B312E312E75207520752075207520792B792B75206820782B6D2B6D2B6D2B 602E382E722E212E602E6D2B6D2B6D2B602E6B2E6D2B6D2B6D2B782B372B2B2B 672E672E6D2B6D2B6D2B6D2B382B2B2B6D2B6D2B6D2B602E2B2B6D2B6D2B6D2B 2B2B49206B2E6D2B6D2B6D2B6D2B6D2B6D2B552E4D206D2B6D2B6D2B2B2B4B2E 772E6D2B6D2B6D2B2A2E54206D2B6D2B6D2B2B2B58206D2B6D2B6D2B2B2B7C20 432E772B6820302E502E502E4720302E2F2B47206E2B302E6B202E20222C0A22 2E206B20442E522E6A206A20322E6E2B322E5F2B47205F2B5F2B502E262E792B 612031206120312031206120792B782E51203D203D203D203D203D203D203D20 3D203D203D203920342061204C20212E61205E2B4920702B5E20382E572E6C20 3E2B7E2B3D2B512E512E632E2A20632E512E512E512E3D2B3D2B6220782E6220 4E20782E422B422B782E4E20782E262B422B682B682B6F2E682B6F2E682B3920 6F2E252E682B6F2E54207120252E762E762E4E204E20282E782B622E5D2E6820 47207520792B312E312E792B762B792B2D2E312E312E2D2E312E6E2B6E2B7520 752075202D2E792B7520302E782B6D2B6D2B6D2B602E382E242061204D206D2B 6D2B6D2B48202E2E6D2B6D2B6D2B782B4C2049205F2B422E772E6D2B6D2B772E 642B4D206D2B6D2B6D2B3C2E54206D2B6D2B6D2B4D20702B602E6D2B6D2B6D2B 6D2B6D2B6D2B5D2B4D206D2B6D2B6D2B602E3420772E6D2B6D2B6D2B702E5420 6D2B6D2B6D2B5D2B702E6D2B6D2B6D2B2B2B702B49204920302E6E2B6E2B502E 47206E2B47206E2B47206E2B6B202E20222C0A222E206B20322E49206A20322E 322E262E322E502E262E262E262E262E6E2B262E792B792B312E6120792B252E 3B2E3D203D203D203D203D203D203D203D203D203D203D203D2036205F20462B 612061206120262E6E2B5E2B322E262E6120612034205D2046203D2B512E7A2B 2A20512E3D2B512E5D205D2062202B20782E4E206220262B422B422B422B262B 262B252E252E252E682B682B6F2E6F2E6F2E6F2E6F2E6F2E682B6F2E6F2E7120 252E252E252E342E6720772E782B5D2E472047206E2B7520792B5F2E792B7520 312E2D2E312E2D2E2D2E312E75207520312E792B792B7520762B792B75202D2E 782B6D2B6D2B6D2B602E722E722E212E782B6D2B6D2B6D2B4820702E6D2B6D2B 6D2B6D2B702B242061206A2E6D2B6D2B6D2B4D20242E782B6D2B6D2B772E702E 232E6D2B6D2B6D2B672E2420442B6D2B6D2B6D2B6D2B6D2B782B3C2E2B2B6D2B 6D2B6D2B602E632B672E6D2B6D2B6D2B702E5D2B6D2B6D2B6D2B6B2E632B5820 602E58204B2E722E702B502E302E6E2B302E502E302E6E2B47206E2B47204720 6B202E20222C0A222E206B20492049204920322E322E792B262E262E61206120 262E612061206120312E312E792B702E3B2E3D203D203D203D203D203D203D20 3D203D203D203D203D203D203D203D203D2051206F2E49206120262E322E5E2B 322E5F2B502E522E2E2E782E622062203D2B512E512E512E62203D2B62206220 6220422B6220782E262B422B422B422B262B422B262B782E262B682B6F2E682B 6F2E252E6F2E6F2E6F2E6F2E6F2E6F2E682B252E252E252E682B2B2B6D2B6D2B 772E5D2E472075207520792B5F2E792B5F2E7520792B2D2E792B312E2D2E2D2E 75206E2B312E2D2E7520752075202D2E75207520782B6D2B6D2B6D2B602E382E 722E612058202B2B6B2E602E642B602E6D2B6D2B6D2B6D2B702B722E4920782B 6D2B6D2B6D2B402E3B2B6A2E2B2B6B2E602E71202B2B6D2B6D2B6D2B672E702B 442B6D2B6D2B6D2B772E4820702B722E2B2B6D2B6D2B6D2B602E4920672E6D2B 6D2B6D2B702E642B6D2B6D2B6D2B6D2B4D2048206A20702B722E382E722E5E2B 302E4720302E302E472047206E2B6E2B6E2B6E2B6B202E20222C0A222E206B20 49206120262E4C20262E262E612061204920612061206120312E312E6120312E 312E422E69203D203D203D203D203D203D203D203D203D203D203D203D203D20 3D203D203D20722B452B702E5E2B5E2B6E2B502E262E502E442E422E462B6220 4620622046203D2B512E512E46206220622062206220422B782E262B422B422B 342E422B422B422B252E252E262B252E682B682B682B6F2E6F2E6F2E6F2E6F2E 6F2E6F2E682B7020252E682B4F206D2B6D2B6D2B772E432E612075205F2E312E 312E312E312E6120312E312E2D2E7520312E7520752075207520792B5F2E5F2E 312E792B2D2E7520782B6D2B6D2B6D2B602E382E24204C20502E68202A2E602E 672E6D2B6D2B6D2B6D2B6D2B702B24202A2E6D2B6D2B6D2B772E3B2B702B3B2B 642B752E2B2B772E6D2B6D2B6D2B6D2B772E6C2058206D2B6D2B6D2B392E382E 382E702B2B2B6D2B6D2B6D2B602E3B2B672E6D2B6D2B6D2B702E24202B2B6D2B 6D2B6D2B6D2B6D2B2B2B562E242024207320312E47204720302E4720502E4720 4720302E47205F2B6B202E20222C0A222E206B20492061204920612049206A20 4920792B492049204920792B792B792B312E6120312E34207A20732B3D203D20 3D203D203D203D203D203D203D203D203D203D203D203D20722B372E632E242E 262E61206120262E262E262E6A20522E7C20422B7C2B7C2B46203D2B5D203D2B 4620462062206220782E422B6220262B342E422B262B422B422B342E682B342E 6F2E422B682B682B6F2E6F2E3A2E6F2E6F2E6F2E54206F2E54206F2E682B6B2E 25206D2B6D2B6D2B772E432E612075207520752075207520312E2D2E7520792B 312E75202D2E2D2E752075202D2E75207520752075205F2E2D2E792B782B6D2B 6D2B6D2B602E382E24204920432E4D20772E6D2B6D2B782B6D2B6D2B6D2B6D2B 702B24206B2E6D2B6D2B6D2B602E722E2420642B392E772E6D2B6D2B672E6D2B 6D2B6D2B772E722E442B6D2B6D2B6D2B4D20722E722E702B4D206D2B6D2B6D2B 602E3B2B772E6D2B6D2B6D2B702E722E6A206B2E772E6D2B6D2B6D2B6D2B672E 432E322E322E502E502E47206A205F2B5F2B522E6820522E6820522E6B202E20 222C0A222E206B20322E492049204920322E6A206A206A20502E6A206A206A20 6A20792B6A20302E6A2034205B2E27202C2E3D203D203D203D203D203D203D20 3D203D203D203D203D20312B4620272E272E632B262E49206120612061204920 262E2E2E462B342E7C2B7C2B7C2B62203D2B62207C2B62207C2B422B782E422B 422B262B342E342E682B682B342E682B682B342E6F2E682B39203A2E3A2E3A2E 3A2E3A2E6F2E6F2E3920682B552E39206E2E772E6D2B6D2B6D2B6D2B772E622E 6120792B792B6E2B6E2B6E2B6E2B792B312E312E312E792B792B75202D2E792B 792B792B2D2E792B792B7520792B2D2E782B6D2B6D2B6D2B602E722E702B262E 6B2E6D2B6D2B6D2B2B2B4B2E6D2B6D2B6D2B6D2B702B2420672E6D2B6D2B6D2B 702E382E722E2B2B6D2B6D2B6D2B6B2E6A2E6D2B6D2B6D2B772E722E6A2E6D2B 6D2B6D2B4D20382E722E4C204D206D2B6D2B6D2B602E3B2B672E6D2B6D2B6D2B 4D2E722E73206A207C202B2B6D2B6D2B6D2B6D2B2B2B6120502E502E502E302E 4720522E652B652B362E652B5320362E6B202E20222C0A222E206B206A204A20 502E322E6A206A20442E6A20442E5F2B6A206A20502E6A206A2047203420702E 5B2E27202720712E312B3D203D203D203D203D203D203D203D203D20712E632E 272E2A20792E492061204C204920262E6120322E6A20522E422E342E7C2B7C2B 622062203D2B62206220622062206220782E422B422B262B682B342E682B682B 682B682B682B6F2E6F2E6F2E6F2E682B682B39203A2E5420682B3A2E39205820 6B2E4F20672E772E6D2B6D2B6D2B6D2B772E54206E2B792B792B792B302E6E2B 792B502E6E2B792B792B792B792B6E2B6E2B752075206E2B6E2B6E2B75206E2B 6E2B792B782B6D2B6D2B6D2B6B2E382E702B322E4D206D2B6D2B6D2B70202E2E 6D2B6D2B6D2B6D2B702B2A2E6D2B6D2B6D2B4D20722E722E3B2B782B6D2B6D2B 6D2B642B5D2B6D2B6D2B6D2B772E382E6A2E6D2B6D2B6D2B4D20382E722E4920 4D206D2B6D2B6D2B602E3B2B672E6D2B6D2B6D2B34204D2E2B2B4D202B2B7020 552E6D2B6D2B6D2B782B732061205F2B47205F2B522E4A20372B652B432E622E 2A2E432E6B202E20222C0A222E206B206A20322E322E322E322E322E6A20442E 522E442E442E442E442E442E5F2B6A205F2B702E5B2E2720272027202720312B 3D203D203D203D203D203D20512037203C2B632E272E632E612B3420322E502E 4920262E262E61206A205F2B702E342E7C2B7C2B622062205D2062205D206220 782E6220782E5D20782E422B422B422B5920682B682B342E342E682B342E422B 682B6F2E6F2E6F2E6F2E6F2E39203920692E392E6020782B6E20672E6020772E 772E6D2B6D2B602E5F2B5F2B47205F2B502E6820682068206E2B7520792B792B 792B6E2B6E2B6E2B6E2B6A206E2B6E2B6E2B6A206E2B6E2B782B6D2B6D2B6D2B 6B2E702B3B2B442E782B6D2B6D2B6D2B642B34206D2B6D2B6D2B6D2B702B2B2B 6D2B6D2B6D2B5420382E722E4C20782B6D2B6D2B772E49204B2E6D2B6D2B6D2B 672E382E58206D2B6D2B6D2B4D20382E722E61204D206D2B6D2B6D2B602E3B2B 672E6D2B6D2B6D2B3420272B6D2B6D2B6D2B552E562E672E6D2B6D2B782B702B 24205E2B502E47205F2B5F2B522E432E5D2E432E652B372B6B202E20222C0A22 2E206B204A206A20322E4A206A204A206A204A20442E522E522E442E5F2B442E 442E442E442E3C2E5B2E27202720272027202C2E312B3D203D203D203D20712E 632E3C2B3C2B632E632E632E612B4D2E772B522E502E322E6A20262E6A20562E 642B7B202B20742074207C2B62207C2B7C2B7C2B7C2B62207C2B342E342E7C2B 462E2B202B207B20342E342E342E422B342E682B342E342E342E2B2039203920 602E6E20592E60206D2B772E6020392E672E772E672E772E6D2B582047202E2E 652B2A2E7C207C202E2E442E262E792B792B792B262E262E6A206E2B6E2B6E2B 792B262E6E2B6E2B6E2B6A20782B6D2B6D2B6D2B6D2B6D2B6D2B5820782B6D2B 6D2B6D2B542071206D2B6D2B6D2B6D2B3B2B6D2B6D2B6D2B6D2B442B232E232E 7C20782B6D2B6D2B6D2B3C2E232E6D2B6D2B6D2B672E382E6A2E6D2B6D2B6D2B 4D20382E722E262E4D206D2B6D2B6D2B6B2E562E772E6D2B6D2B6D2B34202E2E 6D2B6D2B6D2B58202A2E772E6D2B6D2B4D20382E722E6120502E472047206820 68206820682068206820522E6B202E20222C0A222E206B20442E4A20522E4A20 442E6A20442E6A206A204A20442E562E442E442E6A20442E442E702E5B2E2720 27202720712E2C2E312B312B722B722B4620792E3C2B512E632E2A202A20272E 5020642B772B4A206A206A20322E6A206A20442E2E2E2B207C2B7C2B74206220 512E62207C2B6220622062207C2B7C2B782E62207C2B46202B20342E682B262B 62207C2B422B342E682B422B782E342E6D206B2E592E7B2074207D2E6020592E 6D204C2E6E2025205F20392E392E382B652B48202A2E70202A2E2A2E7C20772B 422E47206A20322E6E2B6E2B6A20262E6A20262E6A20792B262E302E47204720 782B6D2B6D2B6D2B6D2B6D2B6D2B552E2B2B6D2B6D2B6D2B672E672E6D2B6D2B 6D2B6D2B49206D2B6D2B6D2B6D2B6D2B6D2B6D2B54204D206D2B6D2B6D2B672E 772E6D2B6D2B6D2B672E382E6A2E6D2B6D2B772E4D20382E242061206B2E6D2B 6D2B6D2B772E672E6D2B6D2B6D2B6D2B34202420782B6D2B6D2B772E672E6D2B 6D2B6D2B6A2E382E722E4C20502E302E5F2B472047204720502E4720502E522E 6B202E20222C0A222E206B20442E442E442E6A20562E522E442E442E4720522E 522E522E522E562E522E522E522E702E5B2E2720272027202C2E2C2E312B312B 312B3720712B272E632E512E512E512E632E2A20612B522E5F2B442E6A206A20 6A206A206A206A20702E342E7C2B62207C2B2920632E3D2B62203D2B62204620 62204620252E62207C2B62207C2B2B20252E782E782E62202B20342E682B782E 252E7C2B2B20282E67207C2B74203B2E282E2B2062207420282E6E204C2E5120 4D20382B6820432E432E70202A2E382B452E7020652B4720502E502E5F2B4720 502E502E5F2B6A205F2B4720442E442E562E422E782B6D2B6D2B6D2B6D2B6D2B 6D2B452E7C20772E6D2B6D2B6D2B602E6D2B6D2B6D2B6D2B3B2B6D2B6D2B6D2B 6D2B6D2B6D2B6D2B622E552E6D2B6D2B6D2B772E6B2E6D2B6D2B6D2B672E382E 6A2E6D2B6D2B6D2B4D20382E722E6120382B772E6D2B6D2B6D2B2B2B772E6D2B 6D2B6D2B4D2E382E7020782B6D2B6D2B6D2B6D2B6D2B2B2B7320722E722E6120 502E302E5F2B522E5F2B522E502E522E5F2B522E6B202E20222C0A222E206B20 522E442E442E562E442E5F2B5F2B522E5F2B562E682047205F2B522E522E522E 5F2B4D2E5B2E27202C2E2C2E2C2E2C2E2C2E2C2E312B3720272E632E272E512E 512E632E512E50202A2B6A205F2B522E522E5F2B522E562E47205F2B562E342E 7C2B622062203C2B712B3D2B62203D2B62207C2B7C2B62205D20622062204620 7C2B342E252E252E782E62207C2B422B6F2E252E422B342E2B205F207B202B20 742074203B2E62207C2B74203B2E5F204C2E51204F2070206820772B772B432E 48202A2E272B422E68204720472068206820562E4720502E5F2B472068206820 652B5D2E5D2E272B5820602E542071207C207C207C207320382E442E58205820 642B702B48202A2E71207C2024207C2070202A2E7C207C207C207C207320722E 2E2E58205820442E702B48202A2E48202E2E382E632B5420452E432E442E382E 242061204720622E602E58207C20702B7C202A2E712048202420722E7320772B 70206A2E58206A2E7C207320722E382E2420262E502E502E502E5F2B5F2B5F2B 522E5F2B5F2B4A206B202E20222C0A222E206B20442E442E442E5F2B522E562E 5F2B442E5F2B6A206A206A206A206A205F2B442E5F2B442E46202C2E2C2E2C2E 2C2E2C2E2C2E2C2E2C2E3720632E632E632E7A2B512E512E7A2B512E2820442E 522E5F2B6A206A20522E522E522E522E702E342E7C2B7C2B3D2B472B712B3D2B 3D2B2920622062207C2B6220362B6220782E62204620342E252E252E782E782E 62202B20342E6F2E422B342E7C2B5F206D207B2074203B2E5F20252E7C2B4C2E 6E2E6D203B2E51205F20622E6820362E372B362E4A20372B372B522E6A204720 522E472068205D2E6820682068206820682068205D2E5D2E5D2E5D2E652B5F2B 7320722E382E382E382E382E382E24203A2B722E382E382E382E722E722E382E 382E722E73202420382E382E382E382E382E722E73204C20722E722E382E382E 722E722E382E382E722E212E4C20722E382E382E722E6120302E502E262E2420 722E382E382E722E722E382E722E722E7320262E4C202420722E382E382E382E 382E722E212E502E502E502E502E522E47205F2B5F2B5F2B4720442E6B202E20 222C0A222E206B20562E522E442E562E522E562E4720562E6A20442E442E6A20 322E6A206A205F2B6A205F2B34207C2B712E2C2E2C2E2C2E2C2E2C2E312B3720 2A20632E632E7A2B512E7A2B7E2B2120562E522E562E68206820562E68202E2E 68204720702E422B2B2062205D202E2B3C2B62205D205020782E7C2B7420782E 362B4E20422B342E7C2B782E5D20252E252E62206220342E39206F2E252E342E 62205F2067206D206D203B2E282E422B2B203B2E5F207D2E3B2E36205F204B2E 7C20772B5320362E4A204A204D2E6A205F2B522E47206820652B68205D2E6820 682068205D2E6820682047205F2B502E502E6E2B612073202420242024202420 24206120792B482E242024202420482E3A2B7320732073206120212E73202420 73207320732073206120262E4C202420242073204C203A2B7320732073206120 792B732073207320212E262E502E5F2B262E4C20732024207320212E3A2B7320 732073206120502E6E2B49207320242024202420732061205E2B502E47204720 47205F2B522E5F2B522E5F2B5F2B4A206B202E20222C0A222E206B20562E562E 562E562E522E442E4720342047206A20522E6A206A206A20322E6A20322E6A20 6A203420782E712E2C2E2C2E2C2E2C2E2C2E2720632E632E632E7A2B512E7E2B 2A2B442E5F2B6A20522E442E5F2B522E68206820562E6820702E252E74207C2B 5D20472B3C2B46205020272E6220342E2B20422B5D204E20342E342E342E422B 762E4E20262B5D2062202B20342E252E342E342E782E5F2067206D204C2E3B2E 6E20692E2B204C2E4F205F205F206E207D2E4B2E7C2053205320362E442E4A20 4A206A206A20472047205D2E622E622E5D2E5D2E682047207520792B792B792B 792B322E322E6E2B7520792B312E2D2E312E2D2E792B792B6E2B6E2B792B312E 792B792B792B792B7520792B792B302E792B6E2B6E2B6E2B6E2B6E2B6A20502E 502E5E2B61206E2B502E6E2B322E6A206A206A20302E262E262E262E502E502E 302E502E47206E2B322E792B6A20302E502E6E2B6A20262E6E2B5F2B502E5F2B 6E2B262E262E262E262E502E502E502E5F2B5F2B502E5F2B522E4720522E5F2B 4720442E6B202E20222C0A222E206B20442E442E6A20442E562E682068206820 562E522E562E522E6A206A206A206A206A205F2B6A204A203420252E712E2C2E 2C2E2C2E2C2E3720632E632E632E512E292034206A206A205F2B442E4A205F2B 522E522E562E422E6820562E702E252E2B20422B62203C2B29207C2B5020272E 4E20342E7B20422B4E20252E422B342E342E782E5D204E20402B5D206220342E 3920252E252E342E7C2B6E2E67206D206D203B2E592E392E6D20692E282E5F20 4F2E6E204F20702048202A2E432E4D2E372B442E362E562E47206A2047205D2E 622E5D2E302E6E2B312E792B7520302E792B6E2B6E2B262E792B792B792B7520 6E2B75206E2B6E2B6E2B6E2B302E6E2B792B6E2B6E2B6E2B6E2B302E302E302E 302E502E4720502E502E502E6E2B502E302E302E502E502E502E502E5F2B5F2B 502E502E502E502E5F2B502E5F2B302E502E502E5F2B302E502E502E4720502E 502E502E47205F2B502E502E5F2B502E302E302E502E502E302E472047204720 472047204720472047205F2B5F2B562E5F2B68206820772B6B202E20222C0A22 2E206B20442E442E442E5F2B562E562E562E562E6820562E6820562E6A206A20 522E522E522E522E522E6A205F2B442E462B4C2E2C2E2C2E2C2E2720632E632E 632E3D2E3C2E4D2E442E562E522E6820772B6820562E6820772B432E5D2E522E 702E252E7C2B7C2B422B502029207C2B2120272E262B2B207B20422B252E262B 422B2B20342E422B762E252E252E262B782E2B203920252E6F2E422B7C2B7D2E 6720692E4C2E7D2E5F20392E6D203B2E4F204F205F204F2E392E232E70202A2E 432E642E5320362E2E2E772B522E6A20502E502E682068206E2B6A20792B6E2B 792B792B792B262E6E2B49207B2E7B2E7B2E7B2E742B7B2E742B7B2E742B7B2E 742B7B2E7B2E742B7B2E3B203C207B2E3C207B2E242E7B2E242E7B2E652E7B2E 242E652E652E652E652E652E652E652E652E632B632B652E632B632B632B632B 632B632B632B4A204A20632B4120632B442E6A20442E6A204A206A20522E502E 6A205F2B5F2B5F2B502E502E502E5F2B5F2B47205F2B502E502E5F2B47204720 522E522E522E522E652B422E6B202E20222C0A222E206B206A206A206A20262E 6A206A206A206A206A20442E6A205F2B6A20442E6A205F2B442E4A20322E562E 442E522E2E2E7C202B20312B2C2E3720632E2920762E7C20422E422E53202E2E 642B642B7C20642B5320642B642B7C202E2E422E702E262B2B2062202B202920 29202B203D2E742E6220342E7B20342E402B262B342E342E2B20342E762E402B 422B782E422B7B20682B6F2E6F2E342E2B203B2E67206D2067207D2E5F206E20 692E6E2E6E205F205F20282E4D20552E402E4B2E4820642B772B53207C207C20 422E562E342047206820422E5F2B792B792B792B6E2B792B262E6A20322E4120 23203E203E203E203E203E203E203E203E203E203E203E203E203E20282B282B 3E20282B282B282B282B282B282B322B322B322B322B322B2B2E322B2B2E2B2E 2B2E6F2B6F2B6F2B542E542E542E542E79207B2E79207B2E7B2E7B2E7B2E7B2E 652E652E652E652E652E652E632B632B632B632B4A20442E522E522E522E4720 5F2B472047205F2B47204720522E502E522E522E522E6820652B652B432E272B 242B2E20222C0A222E206B206A206A206A206A206A20342049206A206A203420 442E442E6A20442E442E6A206A20442E6A206A206A206A20442E442E3420262B 712E37207E2B702E642B422E2E2E2E2E642B642B642B642B48207C204820432E 48207C20642B422E2E2E422B2B20342E2B205D205D202B205D205020782E342E 2B20682B252E6F2E59202B202B20422B402B252E682B422B422B2B2039206F2E 6F2E342E7B207D2E67206D207D2E6E2E5F204D207D2E5F20592E4F20282E282E 4D20232E452E2D202D204B2E48207C207C20272B7020422E2E2E422E7C205D2E 562E302E6E2B262E322E262E502E6A206A206F20322B3E206D2E6D2E282B3E20 3E203E203E203E203E203E206D2E282B3E203E20282B282B282B282B282B322B 322B282B322B322B322B322B2B2E322B2B2E2B2E2B2E6F2B2B2E6F2B6F2B542E 542E742B7920792079207B2E79207B2E43207B2E7B2E652E7B2E652E632B652E 6F20632B4A20632B4A2034204A204A20522E47204720522E522E522E522E522E 522E522E422E5D2E2A2E272B272B272B5D2E7C206B202E20222C0A222E206B20 34206E2B3420262E4920492034206A206A206A20442E442E362E772B772B442E 442E442E442E442E442E6A206A204A20442E442E7120422B3C2E562E362E2E2E 422E422E642B642B5320642B7C2048207C20482048207C202E2E562E702E342E 2B20422B2B205D204E2074204E202920422B2B207B20342E252E422B682B2B20 342E342E252E252E422B422B342E6D2039206F2E682B39207B206E2E692E7D2E 67206E2E6720592E67205F20282E592E5F20282E4D20552E752E402E402E2D20 4B2E4B2E2A2E2A2E70207120272B70202A2E422E562E5F2B5F2B5F2B502E6A20 6A20522E6C2B2C2B322B4A2E6B2B6B2B2F2E322B322B282B3E20322B322B4220 2F2E582E322B6D2E282B282B6D2E6D2E322B782078202B2E322B322B322B2B2E 322B2B2E2B2E2B2E2B2E2B2E6F2B6F2B6F2B542E542E542E542E542E7B2E7920 7B2E7B2E7B2E7B2E652E652E652E652E652E652E632B2820632B4A20632B4A20 442E442E5F2B47205F2B5F2B47206820682068206820652B5D2E432E5D2E422E 652B422E422E7C206B202E20222C0A222E206B20262E6A206A206A206A204920 49206A2034206A20442E6A20562E2E2E2E2E442E442E562E562E442E442E442E 442E562E562E442E562E2E2E562E562E362E772B422E422E422E642B2E2E642B 642B7C20642B642B642B2E2E442E442E4D2E342E342E7C2B342E5D204E202B20 422B4E20422B2B207B202B20252E6F2E682B39202B20682B252E77206F2E342E 2B2067206D205D2B3A2E39207B20282E6720692E6E2E5F206E2E282E67205F20 5F20592E5F205A2E782B232E452E5D2B452E752E5D2B2D2070205D2B70205D2B 5D2B5D2B7C20422E652B772B4720522E522E372B372B362E4820412B322B4A2E 772E232B6B2B64206B2B642078206B2B672B7C2E6B2B352E672B6B2B2F2E582E 6B2B392E6420672B6B2B582E322B322B322B322B2B2E322B52202B2E2B2E6F2B 2B2E6F2B6F2B542E542E742B79207920742B79207B2E7B2E7B2E7B2E652E7B2E 652E652E652E652E632B632B632B4A206F204A20442E6A20522E47204720522E 522E522E6820652B652B652B652B772B6820652B652B652B652B432E6B202E20 222C0A222E206B206A206A206A206A2049206A206A20442E442E442E522E2E2E 362E642B422E642B642B362E362E2E2E562E562E562E562E562E562E562E442E 522E562E2E2E2E2E772B2E2E642B422E2E2E2E2E422E2E2E2E2E642B642E4D2E 562E442E3420342E342E342E342E5D2062202B20342E252E422B342E6D20342E 252E6F2E682B2B202B20682B252E6F2E682B342E342E6D20602E3A2E39207B20 6D206E2E4F206E2E6E2E6E2E5F20592E5F205F204F20592E282E592E392E232E 5D2B752E752E232E452E402E402E5420752E232E5D2B702048202A2E4820772B 362E362E372B372B642E472E402E55206D2E4A2E772E672B672B6420772E7820 6B2B672B672E2F2E6B2B232B772E672B6D2B7820772E782032202F2E672B2B2E 322B322B322B322B2B2E2B2E2B2E2B2E2B2E2B2E6F2B6F2B6F2B542E542E542E 542E792079207B2E56207B2E7B2E652E7B2E652E652E652E652E632B652E6F20 4A20632B34204A204A20442E5F2B522E5F2B5F2B682068206820682068206820 6820522E772B652B772B652B422E7C20242B2E20222C0A222E206B206A203420 302E34206A2049203420562E772B2E2E772B422E642B642B7C20642B7C207C20 642B642B642B2E2E642B642B642B2E2E2E2E562E562E522E442E442E442E442E 442E422E2E2E562E562E562E562E562E4D2E4D2E362E562E702E422B342E7C2B 422B5D2062202B20342E252E342E342E7420342E252E422B682B7B207B203920 252E6F2E682B342E2B206D2067203920392039206D205F204F2067205F206E2E 5F204D206E2E282E6E20392E4F206E206E206A2E5D2B752E752E752E232E402E 3A2E5D2B232E54202D202D202D204B2E4B2E4820432E432E642B48204B2E5D2B 232E5B2B322B4A2E772E64204A2E78206B2B322B6B2B2F2E672E64206B2B3220 772E2F2E592E7820772E582E44202F2E672B322B322B322B322B322B2B2E322B 2B2E2B2E2B2E6F2B6F2B2B2E742B6F2B542E7920742B79207B2E7B2E7B2E7B2E 7920652E7B2E652E7B2E652E652E652E4120652E34204120632B442E442E522E 5F2B68206820522E6820422E68206820422E6820772B522E522E522E522E6820 522E772B6B202E20222C0A222E206B20562E562E4720522E442E442E522E562E 2E2E422E422E2E2E7C20482048202A2E4B2E71202A2E48202C2B642B642B642B 642B642B422E7C20652B2E2E362E772B562E562E772B2E2E562E562E562E562E 362E642E642B642B642B642B702E422B7420342E2B204E20782E7B20782E422B 422B342E7B202B20252E6F2E682B7B202B207B206F2E6F2E682B682B2B206D20 67203A2E552039206D204F204F206B2E6E2E5F205F206E206720282E282E392E 282E592E6E206B2E5D2B5D2B2D203A2E752E5D2B402E5D2B752E5520232E752E 2D20402E4B2E4B2E4B2E2D204B2E402E402E752E752E2D20322B4A2E672E582E 3E2078206B2B282B6B2B672B6B2B232B772E7820672E32206B2B7820772E6420 672B2F2E672B2B2E322B322B322B322B2B2E322B2B2E2B2E2B2E2B2E6F2B6F2B 542E542E542E542E542E7920792079207B2E7B2E7B2E7B2E652E652E652E652E 652E6F20652E632B632B34204A20442E6A20442E47206820522E682068206820 6820522E68206820682068206820522E522E522E772B772B6B202E20222C0A22 2E206B20562E562E562E562E562E4D2E4D2E362E362E642E642B642B642B7C20 4B2E4B2E4B2E2D204B2E2A2E642B642B3C2E2E2E642B3C2E362E2E2E7C20432E 432E2A2E2A2E2A2E70202A2E642B2E2E2E2E422E652B7C202C2B48204820642B 7120252E7B202B202B20252E7C2B2B20342E422B59202B207B20342E252E682B 342E39202B20342E6F2E7720682B39202B206D20692E3A2E682B39207B204F20 4F206E2E5F205F20592E392E7D2E282E282E392E5F205A2E5F20602E2D202D20 2D202D205D2B2D202D202D205520552055205520752E752E5D2B402E5D2B452E 232E232E232E55205D2B5B2B322B422064204A2E3E207C2E64203E207C2E672B 6420352E672E352E7820672B78206D2E2F2E672B582E352E2F2E352E322B322B 322B322B2B2E2B2E2B2E52202B2E6F2B2B2E6F2B6F2B542E542E742B7920542E 7B2E79207B2E7B2E7B2E7B2E7B2E652E652E652E652E632B632B6F20632B632B 4A20442E442E442E5F2B4720522E522E522E682068206820422E422E652B772B 652B6820772B682068207C206B202E20222C0A222E206B202E2E562E2E2E562E 362E4D2E362E4D2E642B4D2E642E642B2E2E642B642B48204B2E4B2E4B2E2D20 7120482071202C2B3C2E642B562E6820772B7C202A2E48204B2E402E5D2B7020 2A2E48202A2E7C204B2E48204B2E4B2E4B2E2D207120262B2B20342E2B204E20 422B2B20342E782E342E342E7B207B20252E6F2E39202B207B2039206F2E682B 682B59207B206D2067203A2E6F2E592032204F204F206E2E6E2E5F20282E4D20 5F205F20282E392E4F20592E6E20442B2D202D20412B412B48202D202D202D20 2D20752E752E5D2B55205520752E752E752E7B2B7B2B232E232E752E452E5B2B 6D2E3E203E203E203E203E203E203E203E203E203E2042207C2E282B3E20282B 3E20282B282B322B282B322B322B322B322B322B322B322B322B322B2B2E2B2E 2B2E6F2B2B2E6F2B6F2B542E542E542E742B79207920792056207B2E7B2E7B2E 652E7B2E652E652E652E652E6F204120632B3420632B4A20442E442E5F2B522E 522E522E68206820422E772B682068206820652B522E372B652B372B772B422E 6B202E20222C0A222E206B202E2E562E562E562E642E642E642E4D2E642B4D2E 642E642E642E4D2E642E642B2C2B4B2E402E402E402E5D2B5D2B402E48203C2E 562E562E522E362E772B53204820402E752E5D2B5D2B2D20402E2D2070202D20 2D20412B4B2E2D202D20422B2B202B20342E4E20342E7B20342E252E342E7B20 7B202B20252E682B682B7B207B207B2077206F2E682B682B7B206D2067206F2E 6F2E682B6D204F204F206E2E6E2E5F20592E6E206E2E5F20282E60205F206E20 672E542048204B2E4820412B4B2E2D20402E2D20412B2D20412B412B2D202D20 5520752E752E752E7B2B5520232E232E2D2B7820322B3E203E203E203E203E20 3E203E203E203E203E203E203E203E203E20282B3E20282B282B282B282B282B 282B322B322B322B322B2B2E2B2E2B2E2B2E2B2E2B2E6F2B6F2B6F2B6F2B542E 542E7920542E79207B2E7B2E7B2E7B2E652E7B2E652E652E7B2E4120652E652E 632B632B632B7D2B632B4A206A20442E522E68206820442E562E522E522E6820 562E372B522E652B6820772B6820372B772B422E6B202E20222C0A222E20242B 562E362E2E2E362E362E642E642E4D2E642E642E642E642B642E4D2E4D2E362E 642B48204B2E752E752E7B2B7B2B232E752E48204D2E442E6A20442E4D2E642E 532048204B2E5D2B3A2E5D2B752E3A2E2D20752E48202D202D2048202D206F2E 7B202B20342E782E342E7B202B20422B342E342E7B202B20252E682B682B2B20 7B2039203A2E6F2E682B59202B206D20602E6F2E682B39207B205F202B2B6720 6E2E5F20592E392E6E2E5F20282E6E205F206E20392E5D2B7C202C2B48204820 48204B2E2D202D202D202D202D202D202D202D203A2E3A2E752E232E232E5520 7B2B7B2B7B2B55204A2E42206D2E42206D2E42206D2E6D2E6D2E6D2E6D2E6D2E 6D2E6D2E6D2E2B2E6D2E2B2E2B2E6D2E6F2B542E542E6F2B542E542E542E6F2B 742B542E742B742B742B742B7B2E742B7B2E7B2E7B2E7B2E7B2E7B2E7B2E652E 652E652E652E652E652E652E6F20652E4120632B41206F20442E442E442E442E 442E522E4720522E522E6820522E522E562E372B522E522E772B522E772B652B 652B652B652B422E6B202E20222C0A222E206B20562E442E362E442E442E442E 4D2E442E4D2E4D2E642E642B642E642E642B642B642E2C2B4820402E5D2B232E 6A2E552E232E2D20642B4D2E4D2E442E442E4D2E362E642B48204B2E402E2D20 752E392055207B2B752E2D203A2E412B2D206F2E7B202B202B20422B2B202B20 342E422B342E2B202B203920252E682B682B59207B20342E6F2E3A2E682B5920 7B20202E67206F2E6F2E682B2B204F204F2067206E2E5F20592E392E5F20282E 282E6E206E2E5A2E4D2039207C20642B48202C2B48204820482048202D20412B 2D202D202D203A2E2D205520752E552039207B2B7B2B7B2B7B2B7B2B55205520 55205520552055207B2B78207B2B7B2B7B2B5520752E412B532E48206C2B4820 472E2D202D202D20472E48206C2B5320362E7D2B4A204A207D2B4A20502E4A20 502E4A204A20502E502E502E4720522E4A204A207D2B372B7D2B47207D2B502E 4720522E522E522E522E522E522E772B682068206820522E68206820522E442E 522E562E522E372B372B522E6820522E68206820652B652B652B7C206B202E20 222C0A222E206B20442E562E442E372B4D2E4D2E4D2E4D2E4D2E4D2E4D2E5320 642E642E642E642E642B7C20482048204B2E3A2E752E7B2B232E752E4B2E642B 4D2E442E442E562E2E2E2E2E7C20272B71204B2E2D205D2B552055207B2B7B2B 5520752E3A2E682B342E2B202B20342E342E7B20342E252E342E2B202B202B20 6F2E682B682B342E2B2039206F2E3A2E682B59207B206D206B2E6F2E6F2E5520 7B204F205F2045205F206E2E592E392E5F206E2E592E60206E2E592E4F2E552E 642B642B642B7C20642B2C2B4820532E412B412B2D20412B2D202D20752E3A2E 55205520552055207B2B2D2B78202D2B2D2B2D2B5520552055207B2B7B2B7B2B 2D2B2D2B55202D202D202D20412B48202D202D205D2B232E752E4B2E48204820 432E652B522E772B4720472047206820522E4720522E47205F2B4A20522E4720 4A205F2B5F2B522E5F2B5F2B5F2B5F2B502E522E522E47204720472047204720 68206820562E562E522E562E522E522E4720522E562E522E522E522E522E372B 522E6820372B372B652B432E272B432E6B202E20222C0A222E206B204920442E 442E4D2E4A206F207D2B642E4D2E4D2E7D2B642E642E642E5320642E642B642B 642B482071202A2E4B2E2D205D2B3A2E5D2B4B2E642B562E442E562E522E562E 2E2E2E2E7C2048204820412B2D20552055207B2B7B2B55205520682B422B342E 7B20342E2B207B202B20262B342E7B202B207B20252E682B682B59202B203920 6F2E3A2E682B682B7B20202E45206F2E682B682B7B205F204F20692E6E2E5F20 592E392E5F205F206020672E5F206E205F206D20642B2E2E2E2E3C2E422E2E2E 642B642B482048202D20412B2D202D203A2E3A2E5520552039207B2B202E2D2B 2D2B2D2B2D2B2D2B2D2B2D2B7B2B7B2B7B2B55207B2B5520552055205520752E 752E5D2B55205520452E5D2B2D204B2E48207C20432E5320522E772B772B6820 522E4720522E502E522E502E47205F2B4A2047205F2B47205F2B5F2B522E5F2B 5F2B522E5F2B5F2B522E47205F2B472047205F2B472047204720682047206820 6820562E6820522E442E372B372B372B372B372B522E522E522E522E6820652B 432E432E6B202E20222C0A222E206B204A20442E442E372B362E362E642E642E 642E642E4D2E4D2E4D2E4D2E642E642E642E642E642E642B642B2C2B642B4820 48204B2E4B2E4B2E71207C207C202E2E2E2E562E6820562E2E2E642B2C2B2C2B 2D202D202D20752E752E55203A2E422B422B342E7B202B20342E2B20342E252E 342E342E7B207B20682B682B682B342E2B207B20682B3A2E682B39207B206D20 602E6F2E3A2E392039206E2E4F206E2E6E2E6E2E592E772E4F205A2E772E6020 6E2E36204F207B20642B642B642B642B642B7C207C202C2B6C2B2C2B48204B2E 48204B2E2D203A2E3A2E5520552055207B2B2D2B2D2B2D2B2D2B2D2B2D2B2D2B 7B2B2D2B55207B2B5520552055205520752E552055205520232E752E3A2E2D20 2D2048204820642B5320652B5320772B772B372B522E522E522E522E522E522E 522E5F2B5F2B522E5F2B522E5F2B5F2B5F2B4720522E5F2B5F2B5F2B4720522E 47205F2B5F2B47205F2B5F2B562E5F2B522E5F2B47206820522E562E372B372B 522E522E522E522E522E522E522E6820522E772B652B2E2E6B202E20222C0A22 2E206B20442E442E442E442E562E362E642B642B642B5320642E642E4D2E4D2E 642B642B642B642B642E2E2E2E2E2E2E642B3C2E7C20482048202C2B642B2C2B 7C207C20702E422E422E2E2E7C20642B48204820412B412B2D20412B2D202D20 7720262B782E342E2B20342E2B202B20342E262B342E7B207B207B206F2E682B 342E342E2B207B203A2E3A2E682B342E7B206D2067206F2E772059207B206E2E 2B2B692E6E2E5F20592E25206720282E2520392E6E2E6E20282E3920642B642B 642B2E2E642B772B422E53205320642B5320642B2C2B642B412B48202D203A2E 3A2E552055207B2B2D2B2D2B2D2B2D2B2D2B2D2B2D2B7B2B7B2B55207B2B5520 55205520232E7B2B2D2B7B2B7B2B752E5D2B2D202D2048202A2E48204820432E 432E5320652B772B772B372B372B522E522E522E522E4720522E522E5F2B5F2B 522E5F2B522E6A205F2B522E522E522E4720522E522E522E5F2B562E4720522E 4720522E522E5F2B442E4720522E6820522E372B372B522E372B522E6820772B 522E772B522E522E6820422E6B202E20222C0A222E206B20442E442E442E442E 442E4D2E442E362E4D2E642B642B5320642B642B362E3C2E2E2E642B2E2E642B 642B642B4D2E642E642E3C2E642E642B3C2E642B3C2E642B7C20462B7C20462B 642B48204820412B2D202D20412B412B412B2D20412B782E262B422B2B20262B 342E2B20342E252E422B2B207B207B20252E6F2E422B682B2B207B203A2E682B 682B59202B20202E452077203A2E682B7B20692E4F2067206E2E5F20592E6020 7D2E5F206E20592E5F205A2E4F203920642E4D2E642E2E2E362E362E362E562E 772B642E642E642E642E642B4820412B2D202D202D2055207B2B5520202E2D2B 2D2B2D2B2D2B7B2B7B2B552055205520752E5520232E232E7B2B7B2B55207B2B 5520752E3A2E402E5D2B402E402E2D204B2E4B2E482048207C20652B642B422E 53205320772B522E522E772B432E272B652B772B522E6A204A20522E522E6A20 522E442E442E562E562E522E562E522E442E442E442E442E5F2B442E442E442E 522E562E772B6820772B372B522E562E522E562E772B682068206820772B2E2E 242B2E20222C0A222E202E206B206B206B206B206B206B206B206B206B206B20 6B206B206B20242B6B206B20242B6B206B206B206B206B206B206B206B206B20 6B206B206B20242B6B206B20242B6B206B206B206B206B20242B242B6B20242B 242B242B6B20242B242B242B242B242B242B242B4020242B242B242B242B242B 242B4020242B242B242B242B242B242B242B242B242B242B242B242B4020242B 242B242B4020402040204020242B402040204020242B40204020402040204020 402040206B206B206B206B206B206B206B206B206B206B206B206B206B20242B 6B206B20242B242B242B242B4020242B242B402066204020612E242B242B242B 242B242B242B242B242B242B242B4020242B242B242B242B242B242B242B242B 242B242B242B242B242B6B20242B6B206B206B206B206B206B206B206B206B20 6B20242B6B206B206B206B206B206B206B206B206B206B206B206B206B206B20 6B206B206B206B206B206B206B206B206B206B206B206B206B206B206B20242B 6B206B206B206B206B206B206B206B20242B6B202E202E20222C0A222E202E20 2E202E202E202E202E202E202E202E202E202E202E202E202E202E202E202E20 2E202E202E202E202E202E202E202E202E202E202E202E202E202E202E202E20 2E202E202E202E202E202E202E202E202E202E202E202E202E202E202E202E20 2E202E202E202E202E202E202E202E202E202E202E202E202E202E202E202E20 2E202E202E202E202E202E202E202E202E202E202E202E202E202E202E202E20 2E202E202E202E202E202E202E202E202E202E202E202E202E202E202E202E20 2E202E202E202E202E202E202E202E202E202E202E202E202E202E202E202E20 2E202E202E202E202E202E202E202E202E202E202E202E202E202E202E202E20 2E202E202E202E202E202E202E202E202E202E202E202E202E202E202E202E20 2E202E202E202E202E202E202E202E202E202E202E202E202E202E202E202E20 2E202E202E202E202E202E202E202E202E202E202E202E202E202E202E202E20 2E202E202E202E202E202E202E202E202E202E202E202E202E202E202E202E20 2E202E202E202E202E202E20227D3B0A } end object TrayIcon: TTrayIcon Icon.Data = { 9E09000000000100010018180000010020008809000016000000280000001800 0000300000000100200000000000000900006400000064000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00000000000000000000000000001E9CC1021F9ABD0200000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000001E94B629138DB28F069ECDB700B2E7D40AA0CC9F2193B4280000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000001E9D C206127795760BBDF2D20EC3F8FF0FB9EDFF10B4E8FF0CB7EAFF04B8EEE31383 A37B1F9CC0050000000000000000000000000000000000000000000000000000 00000000000000000000000000000000000000000000000000001D92B2370788 AEAF17CDFFFD13B7E7FF0AB1E4FF0BB3E5FF0DADDAFF0BAEDEFF14ABDBFF0FBA EDFE0493BFC01E95B63600000000000000000000000000000000000000000000 0000000000000000000000000000000000001F9BBF0B147D9C840BC2F9DC11BE F3FF13B4E4FF10B3E3FF04AFE1FF00AAE2FF05A5D7FF06A5D5FF0CA8D6FF0FA5 D2FF13ABD7FF09AEE1EA118CAF8A1F9BBF0B0000000000000000000000000000 00000000000000000000000000001E90B2460893C1B70FC8FFFF11B3E5FF13B4 E2FF0AB1E1FF23B7E8FF4ECDF3FF75DDF8FF56D7F7FF46D2F4FF1AB2D5FF07A7 CDFF13A2D0FF12A0CCFF16A7D3FF0596C4C81D96BA4600000000000000000000 0000000000002099BC131285A69104C4FDE60CB9ECFF0DB3E3FF0BB3E0FF04A5 DEFF1EACE4FF11A3DDFF139CDAFF1795D6FF2E94D4FF338BD2FF377ECDFF2F88 C8FF0B97C0FF0F9AC5FF139CC7FF149DC5FF0BA7D7F00F93BA991F9ABD120000 00001E728A2A04A1D0C207C1F9FF0AB2E4FF08B4E2FF00A6DFFF149FDCFF69D2 F9FF7EE1F9FFBFEAF8FF86DDF0FF38C2E9FF00A4DEFF009ED8FF00B0E0FF3DCF F8FF4AD3FEFF1A9BC4FF0A8FB8FF1099C2FF119AC2FF13A3D0FF049FCDD21D74 8D2C10657C9405C0F8FF07B1E1FF03ABE0FF0094DBFF48B8EAF26FE0FDFF5BD3 F6FF59D1F6FF4ACDF5FF93E2FCFFF3FEFFFFF2FFFFFF9FE9FEFF58D3FAFF48CD F4FF41CCF7FF3CD4FFFF2FB8DFF31091B6FF0F96C1FF119AC2FF109FCCFF0A79 99B104A8D6E002ACE3FF0093DAFF1192D9F66DE0FCF45DD6F9FF64D5F7FF62D3 F7FF6FD7F7FF6CD6F7FF5AD0F4FF49CEF4FF4ECFF4FF52CFF5FF58CFF6FF4ECE F6FF4ACEF4FF3ECAF5FF30CCFAFF31D0FFF51899C1F60B92BAFF0D97C2FF0C9C C5ED0095D1E6007FD8FF4AC7F0E259DBFBFF58D2F6FF5DD3F5FF65D5F7FF73D8 F7FF6BD5F7FF7FDFF8FF73D6F8FF6BD4F7FF6BD5F7FF62D2F7FF5DD2F5FF51CE F6FF48CDF4FF40C9F5FF35C6F4FF27C4F3FF1FCDFFFF15BAEDE60089B5FF0295 C2EE0076CDE345DBFBFB46CEF7FF4DCEF6FF52CFF6FF63D5F8FF68D6F6FF72D8 F7FF72D9F8FF6DD6F8FF70DBFBFF74E0FFFF71D7F8FF66D5F7FF61D3F7FF57D2 F6FF4BCEF4FF43CBF5FF3DCBF4FF1FC4F8FF01B0E5FF61C9E9FFE4FFFFFD0080 B5EA2DC9F0A63CCBF5FF43CAF5FF52CEF7FF57D1F6FF5ED3F5FF62D5F6FF65D4 F0FF54C4E5FF4BB5D6FF4DA5C5FF59A9C1FF66DCFFFF6FD8F8FF57D1F5FF55CF F6FF52D0F6FF42CDF7FF20C1F1FF2BB5DEFFB3E8F9FFBCEDFEFFA7E5FCFF90E2 FDCD38C8F4442EC5F4FF3FCCF4FF4BCEF6FF53CDF2FF51C9EDFF3FBEDCFF2FB1 E5FF4AA8DCFF6291B4FF5E86ABFF3D4754FF68D7F6FF65D8FAFF61D4F5FF53D1 F7FF42CFF9FF22B5E6FF74CEE9FFCAF2FFFFA5E5FBFF8EDEF9FF87DDF8FF58CF F576CAFFFF0558FDFF572DBFF2F73AC4EBFF34B9DBFF1CA6D0FF44B2EEFF59B7 EAFF42A4ECFF3A8CD3FF7AB3CAFF7ADAF5FF68D9FDFF5DD3F5FF59D3F9FF3AC6 F2FF40BBE0FFBFECFBFFADE9FEFF8CDEF9FF7FDCF8FF70D6F5FB51FCFF704DFC FF050000000000000000B4FFFF1926BADFB828A5E1FF60BCF5FF5DB1E7FF4799 E6FF56ACE9FFB0F3F7FF76D6EFFF59D6FCFF5ED5F7FF56D3FBFF2FBAE2FF88D5 EDFFB8EEFFFF8FDFFAFF7FDBF8FF70D7F7FF43CBF5C478FFFF1D000000000000 0000000000000000000097877F596DB6EDEF66BBF5FF508EC4FF447BBAFF85D7 F2FF91F1F5FF51CEF4FF52D0F7FF64D8FAFF39C6EDFF54BFE2FFBAEDFFFF95E2 FBFF7DDBF7FF6CD7F7FF53CDF5F454FDFF5BC7FFFF0300000000000000000000 00002619A5029D96BA89918680FC81A3BBFF4B86CBFF5699C0FF8DF1F9FE44CE F4FF47CAF5FF51D2F8FF4BD1F9FF3ABBE0FF8DD7F1FFA0E8FEFF7BDAF8FF6DD5 F6FF5AD1F7FF35C4F2B0B8FFFF15000000000000000000000000000000000000 00004335A7052C1E82CCA4A68FFB9C8777FF84CCEAFF9EFFFF99A4FFFF0BC5FF FF3929C6F4DE31BFEBFF5CC2E2FFAAE9FFFF85DDFAFF6DD5F6FF5BD2F5FF3CC7 F3EB6AFFFF48FFFFFF0100000000000000000000000000000000000000000000 000000000000624BEE456F65A3DEC6C1C7ECFFFFFF3200000000000000000000 0000FFFFFF0D91FFFF9A7DDDFCFF68D4F6FF59D1F5FF3ECAF5FF54FDFF9AF9FF FF0E000000000000000000000000000000000000000000000000000000000000 000000000000000000006149FC31F0EAFF040000000000000000000000000000 00000000000000000000FFFFFF206BFFFF7766FFFF78DEFFFF21000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000 } Hint = 'tomboy-ng' OnClick = TrayIconClick Left = 424 Top = 40 end end tomboy-ng_0.39-1/source/Tomboy_NG.lpi0000644000175000017500000012640014551457644017305 0ustar dbannondbannon <Scaled Value="True"/> <ResourceType Value="res"/> <UseXPManifest Value="True"/> <XPManifest> <DpiAware Value="True"/> <TextName Value="DRB"/> <TextDesc Value=""/> </XPManifest> <Icon Value="0"/> </General> <i18n> <EnableI18N Value="True"/> <OutDir Value="../po"/> <ExcludedIdentifiers Count="9"> <Item1 Value="LabelToken"/> <Item2 Value="Index out of bounds"/> <Item3 Value="Node is not a container"/> <Item4 Value="Error while parsing text"/> <Item5 Value="Root node must be an array or object"/> <Item6 Value="Button1"/> <Item7 Value="label1"/> <Item8 Value="LabelFindInfo"/> <Item9 Value="PanelBackLinks"/> </ExcludedIdentifiers> <ExcludedOriginals Count="75"> <Item1 Value="LabelToken"/> <Item2 Value="Index out of bounds"/> <Item3 Value="Node is not a container"/> <Item4 Value="Error while parsing text"/> <Item5 Value="Root node must be an array or object"/> <Item6 Value="Form Caption"/> <Item7 Value="LabelAdvice1"/> <Item8 Value="LabelAdvice2"/> <Item9 Value="Advice"/> <Item10 Value="EditSearch"/> <Item11 Value="EditBoxForm"/> <Item12 Value="LabelSearchInfo"/> <Item13 Value="FormColours"/> <Item14 Value="FormRecover"/> <Item15 Value="LabelFileSyncInfo1"/> <Item16 Value="LabelFileSyncInfo2"/> <Item17 Value="PanelSearch"/> <Item18 Value="Form Caption"/> <Item19 Value="TimeEdit1"/> <Item20 Value="Label1"/> <Item21 Value="LabelExistingAdvice"/> <Item22 Value="LabelExistingAdvice2"/> <Item23 Value="LabelNoteErrors"/> <Item24 Value="Label2"/> <Item25 Value="Label7"/> <Item26 Value="Panel3"/> <Item27 Value="0.0.0.0"/> <Item28 Value="EditProfileName"/> <Item29 Value="LabelServerID"/> <Item30 Value="Panel1"/> <Item31 Value="Panel2"/> <Item32 Value="LabelNoDismiss1"/> <Item33 Value="LabelNoDismiss2"/> <Item34 Value="NoteBookPick"/> <Item35 Value="Label3"/> <Item36 Value="LabelContext"/> <Item37 Value="LabelDic"/> <Item38 Value="LabelDicPrompt"/> <Item39 Value="LabelDicStatus"/> <Item40 Value="LabelError"/> <Item41 Value="LabelLibrary"/> <Item42 Value="LabelLibraryStatus"/> <Item43 Value="LabelNotesPath"/> <Item44 Value="LabelSettingPath"/> <Item45 Value="LabelStatus"/> <Item46 Value="LabelSuspect"/> <Item47 Value="LabelWaitForSync"/> <Item48 Value="Label15"/> <Item49 Value="tsett.label10.caption"/> <Item50 Value="tsett.label11.caption"/> <Item51 Value="x"/> <Item52 Value="X"/> <Item53 Value="FormMarkdown"/> <Item54 Value="FormRollBack"/> <Item55 Value="LabelOpn"/> <Item56 Value="LabelOpnTitle"/> <Item57 Value="Labelttl"/> <Item58 Value="LabelttlTitle"/> <Item59 Value="LabelRemote"/> <Item60 Value="LabelLocal"/> <Item61 Value="LabelBadNoteAdvice"/> <Item62 Value="LabelFileSyncinfo1"/> <Item63 Value="LabelFileSyncinfo2"/> <Item64 Value="LabelSyncInfo2"/> <Item65 Value="LabelSyncInfo1"/> <Item66 Value="EditUserName"/> <Item67 Value="ComboSyncType"/> <Item68 Value="LabelProgress"/> <Item69 Value="MenuItem4"/> <Item70 Value="MenuItem5"/> <Item71 Value="MenuItem6"/> <Item72 Value="FormKMemo2pdf"/> <Item73 Value="label1"/> <Item74 Value="LabelFindInfo"/> <Item75 Value="PanelBackLinks"/> </ExcludedOriginals> </i18n> <BuildModes Count="23"> <Item1 Name="Default" Default="True"/> <Item2 Name="Debug"> <CompilerOptions> <Version Value="11"/> <Target> <Filename Value="tomboy-ng"/> </Target> <SearchPaths> <IncludeFiles Value="$(ProjOutDir)"/> <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> </SearchPaths> <Parsing> <SyntaxOptions> <IncludeAssertionCode Value="True"/> </SyntaxOptions> </Parsing> <CodeGeneration> <Checks> <IOChecks Value="True"/> <RangeChecks Value="True"/> <OverflowChecks Value="True"/> <StackChecks Value="True"/> </Checks> <VerifyObjMethodCallValidity Value="True"/> <Optimizations> <OptimizationLevel Value="0"/> </Optimizations> </CodeGeneration> <Linking> <Debugging> <DebugInfoType Value="dsDwarf2Set"/> <UseHeaptrc Value="True"/> <TrashVariables Value="True"/> </Debugging> <Options> <Win32> <GraphicApplication Value="True"/> </Win32> </Options> </Linking> <Other> <CompilerMessages> <IgnoredMessages idx6058="True" idx5092="True" idx5024="True" idx4056="True" idx4055="True"/> </CompilerMessages> <CustomOptions Value="-dTOMBOY_NG"/> </Other> </CompilerOptions> </Item2> <Item3 Name="ReleaseLin64"> <MacroValues Count="1"> <Macro2 Name="LCLWidgetType" Value="gtk2"/> </MacroValues> <CompilerOptions> <Version Value="11"/> <Target> <Filename Value="tomboy-ng-64"/> </Target> <SearchPaths> <IncludeFiles Value="$(ProjOutDir)"/> <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> </SearchPaths> <CodeGeneration> <SmartLinkUnit Value="True"/> <Optimizations> <OptimizationLevel Value="3"/> </Optimizations> </CodeGeneration> <Linking> <Debugging> <GenerateDebugInfo Value="False"/> <DebugInfoType Value="dsDwarf3"/> <UseLineInfoUnit Value="False"/> </Debugging> <LinkSmart Value="True"/> <Options> <Win32> <GraphicApplication Value="True"/> </Win32> </Options> </Linking> <Other> <Verbosity> <ShowHints Value="False"/> </Verbosity> <CompilerMessages> <IgnoredMessages idx6058="True"/> </CompilerMessages> <CustomOptions Value="-dDisableLCLGIF -dDisableLCLJPEG -dDisableLCLPNM -dDisableLCLTIFF -dTOMBOY_NG -vwilq"/> </Other> </CompilerOptions> </Item3> <Item4 Name="ReleaseQT5"> <MacroValues Count="1"> <Macro4 Name="LCLWidgetType" Value="qt5"/> </MacroValues> <CompilerOptions> <Version Value="11"/> <Target> <Filename Value="tomboy-ng-qt5"/> </Target> <SearchPaths> <IncludeFiles Value="$(ProjOutDir)"/> <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> </SearchPaths> <CodeGeneration> <SmartLinkUnit Value="True"/> <TargetOS Value="linux"/> <Optimizations> <OptimizationLevel Value="3"/> </Optimizations> </CodeGeneration> <Linking> <Debugging> <GenerateDebugInfo Value="False"/> <DebugInfoType Value="dsDwarf3"/> <UseLineInfoUnit Value="False"/> </Debugging> <LinkSmart Value="True"/> <Options> <Win32> <GraphicApplication Value="True"/> </Win32> </Options> </Linking> <Other> <Verbosity> <ShowHints Value="False"/> </Verbosity> <CompilerMessages> <IgnoredMessages idx6058="True"/> </CompilerMessages> <CustomOptions Value="-dDisableLCLGIF -dDisableLCLJPEG -dDisableLCLPNM -dDisableLCLTIFF -dTOMBOY_NG"/> </Other> </CompilerOptions> </Item4> <Item5 Name="ReleaseQt6"> <MacroValues Count="1"> <Macro7 Name="LCLWidgetType" Value="qt6"/> </MacroValues> <CompilerOptions> <Version Value="11"/> <Target> <Filename Value="tomboy-ng-qt6"/> </Target> <SearchPaths> <IncludeFiles Value="$(ProjOutDir)"/> <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> </SearchPaths> <CodeGeneration> <Optimizations> <OptimizationLevel Value="0"/> </Optimizations> </CodeGeneration> <Linking> <Debugging> <GenerateDebugInfo Value="False"/> <DebugInfoType Value="dsDwarf2Set"/> </Debugging> <Options> <Win32> <GraphicApplication Value="True"/> </Win32> </Options> </Linking> <Other> <CompilerMessages> <IgnoredMessages idx6058="True" idx5092="True" idx5024="True" idx4056="True" idx4055="True"/> </CompilerMessages> <CustomOptions Value="-dTOMBOY_NG"/> </Other> </CompilerOptions> </Item5> <Item6 Name="ReleaseLin32"> <MacroValues Count="1"> <Macro2 Name="LCLWidgetType" Value="gtk2"/> </MacroValues> <CompilerOptions> <Version Value="11"/> <Target> <Filename Value="tomboy-ng-32"/> </Target> <SearchPaths> <IncludeFiles Value="$(ProjOutDir)"/> <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> </SearchPaths> <CodeGeneration> <SmartLinkUnit Value="True"/> <TargetProcessor Value="80386"/> <TargetCPU Value="i386"/> <TargetOS Value="linux"/> <Optimizations> <OptimizationLevel Value="3"/> </Optimizations> </CodeGeneration> <Linking> <Debugging> <GenerateDebugInfo Value="False"/> </Debugging> <LinkSmart Value="True"/> <Options> <Win32> <GraphicApplication Value="True"/> </Win32> </Options> </Linking> <Other> <Verbosity> <ShowTriedFiles Value="True"/> </Verbosity> <CompilerMessages> <IgnoredMessages idx6058="True"/> </CompilerMessages> <CustomOptions Value="-dTOMBOY_NG"/> </Other> </CompilerOptions> </Item6> <Item7 Name="ReleaseLin32Qt5"> <MacroValues Count="1"> <Macro4 Name="LCLWidgetType" Value="qt5"/> </MacroValues> <CompilerOptions> <Version Value="11"/> <Target> <Filename Value="tomboy-ng-32-qt5"/> </Target> <SearchPaths> <IncludeFiles Value="$(ProjOutDir)"/> <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> </SearchPaths> <CodeGeneration> <SmartLinkUnit Value="True"/> <TargetProcessor Value="80386"/> <TargetCPU Value="i386"/> <TargetOS Value="linux"/> <Optimizations> <OptimizationLevel Value="3"/> </Optimizations> </CodeGeneration> <Linking> <Debugging> <GenerateDebugInfo Value="False"/> </Debugging> <LinkSmart Value="True"/> <Options> <Win32> <GraphicApplication Value="True"/> </Win32> </Options> </Linking> <Other> <Verbosity> <ShowTriedFiles Value="True"/> </Verbosity> <CompilerMessages> <IgnoredMessages idx6058="True"/> </CompilerMessages> <CustomOptions Value="-dTOMBOY_NG"/> </Other> </CompilerOptions> </Item7> <Item8 Name="ReleaseWin64"> <MacroValues Count="1"> <Macro1 Name="LCLWidgetType" Value="win32"/> </MacroValues> <CompilerOptions> <Version Value="11"/> <Target> <Filename Value="tomboy-ng-64"/> </Target> <SearchPaths> <IncludeFiles Value="$(ProjOutDir)"/> <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> </SearchPaths> <CodeGeneration> <SmartLinkUnit Value="True"/> <TargetCPU Value="x86_64"/> <TargetOS Value="win64"/> <Optimizations> <OptimizationLevel Value="3"/> </Optimizations> </CodeGeneration> <Linking> <Debugging> <GenerateDebugInfo Value="False"/> </Debugging> <Options> <Win32> <GraphicApplication Value="True"/> </Win32> </Options> </Linking> <Other> <Verbosity> <ShowHints Value="False"/> </Verbosity> <CompilerMessages> <IgnoredMessages idx6058="True"/> </CompilerMessages> <CustomOptions Value="-dTOMBOY_NG"/> <CompilerPath Value="ppcrossx64"/> </Other> </CompilerOptions> </Item8> <Item9 Name="ReleaseWin32"> <MacroValues Count="1"> <Macro1 Name="LCLWidgetType" Value="win32"/> </MacroValues> <CompilerOptions> <Version Value="11"/> <Target> <Filename Value="tomboy-ng-32"/> </Target> <SearchPaths> <IncludeFiles Value="$(ProjOutDir)"/> <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> </SearchPaths> <CodeGeneration> <SmartLinkUnit Value="True"/> <TargetCPU Value="i386"/> <TargetOS Value="win32"/> <Optimizations> <OptimizationLevel Value="3"/> </Optimizations> </CodeGeneration> <Linking> <Debugging> <GenerateDebugInfo Value="False"/> <UseLineInfoUnit Value="False"/> </Debugging> <Options> <Win32> <GraphicApplication Value="True"/> </Win32> </Options> </Linking> <Other> <Verbosity> <ShowHints Value="False"/> </Verbosity> <CompilerMessages> <IgnoredMessages idx6058="True"/> </CompilerMessages> <CustomOptions Value="-dTOMBOY_NG"/> <CompilerPath Value="fpc"/> </Other> </CompilerOptions> </Item9> <Item10 Name="ReleaseRasPi"> <MacroValues Count="1"> <Macro4 Name="LCLWidgetType" Value="qt5"/> </MacroValues> <CompilerOptions> <Version Value="11"/> <Target> <Filename Value="tomboy-ng-armhf"/> </Target> <SearchPaths> <IncludeFiles Value="$(ProjOutDir)"/> <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> </SearchPaths> <CodeGeneration> <TargetCPU Value="arm"/> <Optimizations> <OptimizationLevel Value="0"/> </Optimizations> </CodeGeneration> <Linking> <Debugging> <GenerateDebugInfo Value="False"/> <DebugInfoType Value="dsDwarf2Set"/> <UseLineInfoUnit Value="False"/> </Debugging> <Options> <Win32> <GraphicApplication Value="True"/> </Win32> </Options> </Linking> <Other> <CompilerMessages> <IgnoredMessages idx6058="True" idx5024="True"/> </CompilerMessages> <CustomOptions Value="-dTOMBOY_NG"/> </Other> </CompilerOptions> </Item10> <Item11 Name="ReleaseRasPi64"> <MacroValues Count="1"> <Macro2 Name="LCLWidgetType" Value="gtk2"/> </MacroValues> <CompilerOptions> <Version Value="11"/> <Target> <Filename Value="tomboy-ng-arm64"/> </Target> <SearchPaths> <IncludeFiles Value="$(ProjOutDir)"/> <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> </SearchPaths> <CodeGeneration> <TargetCPU Value="aarch64"/> <Optimizations> <OptimizationLevel Value="0"/> </Optimizations> </CodeGeneration> <Linking> <Debugging> <GenerateDebugInfo Value="False"/> <DebugInfoType Value="dsDwarf2Set"/> <UseLineInfoUnit Value="False"/> </Debugging> <Options> <Win32> <GraphicApplication Value="True"/> </Win32> </Options> </Linking> <Other> <CompilerMessages> <IgnoredMessages idx6058="True" idx5024="True"/> </CompilerMessages> <CustomOptions Value="-dTOMBOY_NG"/> </Other> </CompilerOptions> </Item11> <Item12 Name="CocoaRelease"> <MacroValues Count="1"> <Macro5 Name="LCLWidgetType" Value="cocoa"/> </MacroValues> <CompilerOptions> <Version Value="11"/> <Target> <Filename Value="tomboy-ng-x86_64"/> </Target> <SearchPaths> <IncludeFiles Value="$(ProjOutDir)"/> <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> </SearchPaths> <CodeGeneration> <SmartLinkUnit Value="True"/> <TargetCPU Value="x86_64"/> <TargetOS Value="darwin"/> <Optimizations> <OptimizationLevel Value="3"/> </Optimizations> </CodeGeneration> <Linking> <Debugging> <GenerateDebugInfo Value="False"/> <DebugInfoType Value="dsDwarf2Set"/> </Debugging> <LinkSmart Value="True"/> <Options> <Win32> <GraphicApplication Value="True"/> </Win32> </Options> </Linking> <Other> <Verbosity> <ShowHints Value="False"/> </Verbosity> <CompilerMessages> <IgnoredMessages idx6058="True"/> </CompilerMessages> <CustomOptions Value="-dTOMBOY_NG"/> <CompilerPath Value="/usr/local/bin/fpc"/> </Other> </CompilerOptions> </Item12> <Item13 Name="CocoaDebug"> <MacroValues Count="1"> <Macro5 Name="LCLWidgetType" Value="cocoa"/> </MacroValues> <CompilerOptions> <Version Value="11"/> <Target> <Filename Value="tomboy-ng"/> </Target> <SearchPaths> <IncludeFiles Value="$(ProjOutDir)"/> <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> </SearchPaths> <CodeGeneration> <SmartLinkUnit Value="True"/> <TargetCPU Value="x86_64"/> </CodeGeneration> <Linking> <Debugging> <DebugInfoType Value="dsDwarf3"/> <UseHeaptrc Value="True"/> </Debugging> <Options> <Win32> <GraphicApplication Value="True"/> </Win32> </Options> </Linking> <Other> <CustomOptions Value="-dTOMBOY_NG"/> <CompilerPath Value="fpc"/> </Other> </CompilerOptions> </Item13> <Item14 Name="CarbonRelease"> <MacroValues Count="1"> <Macro6 Name="LCLWidgetType" Value="carbon"/> </MacroValues> <CompilerOptions> <Version Value="11"/> <Target> <Filename Value="tomboy-ng"/> </Target> <SearchPaths> <IncludeFiles Value="$(ProjOutDir)"/> <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> </SearchPaths> <CodeGeneration> <TargetCPU Value="i386"/> <Optimizations> <OptimizationLevel Value="3"/> </Optimizations> </CodeGeneration> <Linking> <Debugging> <GenerateDebugInfo Value="False"/> <DebugInfoType Value="dsDwarf2Set"/> <UseLineInfoUnit Value="False"/> <UseExternalDbgSyms Value="True"/> </Debugging> <Options> <Win32> <GraphicApplication Value="True"/> </Win32> </Options> </Linking> <Other> <CompilerMessages> <IgnoredMessages idx5024="True"/> </CompilerMessages> <CustomOptions Value="-dTOMBOY_NG"/> </Other> </CompilerOptions> </Item14> <Item15 Name="CocoaArmRelease"> <MacroValues Count="1"> <Macro5 Name="LCLWidgetType" Value="cocoa"/> </MacroValues> <CompilerOptions> <Version Value="11"/> <Target> <Filename Value="tomboy-ng-aarch64"/> </Target> <SearchPaths> <IncludeFiles Value="$(ProjOutDir)"/> <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> </SearchPaths> <CodeGeneration> <SmartLinkUnit Value="True"/> <TargetCPU Value="aarch64"/> <TargetOS Value="darwin"/> <Optimizations> <OptimizationLevel Value="3"/> </Optimizations> </CodeGeneration> <Linking> <Debugging> <GenerateDebugInfo Value="False"/> <DebugInfoType Value="dsDwarf2Set"/> </Debugging> <LinkSmart Value="True"/> <Options> <Win32> <GraphicApplication Value="True"/> </Win32> </Options> </Linking> <Other> <Verbosity> <ShowHints Value="False"/> </Verbosity> <CompilerMessages> <IgnoredMessages idx6058="True"/> </CompilerMessages> <CustomOptions Value="-dTOMBOY_NG"/> <CompilerPath Value="/usr/local/bin/fpc"/> </Other> </CompilerOptions> </Item15> <Item16 Name="QT5Debug"> <MacroValues Count="1"> <Macro4 Name="LCLWidgetType" Value="qt5"/> </MacroValues> <CompilerOptions> <Version Value="11"/> <Target> <Filename Value="tomboy-ng-qt5"/> </Target> <SearchPaths> <IncludeFiles Value="$(ProjOutDir)"/> <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> </SearchPaths> <CodeGeneration> <SmartLinkUnit Value="True"/> </CodeGeneration> <Linking> <Debugging> <DebugInfoType Value="dsDwarf3"/> <UseHeaptrc Value="True"/> </Debugging> <LinkSmart Value="True"/> <Options> <Win32> <GraphicApplication Value="True"/> </Win32> </Options> </Linking> <Other> <Verbosity> <ShowHints Value="False"/> </Verbosity> <CompilerMessages> <IgnoredMessages idx6058="True"/> </CompilerMessages> <CustomOptions Value="-dDisableLCLGIF -dDisableLCLJPEG -dDisableLCLPNM -dDisableLCLTIFF -dTOMBOY_NG"/> </Other> </CompilerOptions> </Item16> <Item17 Name="DebugQt6"> <MacroValues Count="1"> <Macro7 Name="LCLWidgetType" Value="qt6"/> </MacroValues> <CompilerOptions> <Version Value="11"/> <Target> <Filename Value="tomboy-ng"/> </Target> <SearchPaths> <IncludeFiles Value="$(ProjOutDir)"/> <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> </SearchPaths> <Parsing> <SyntaxOptions> <IncludeAssertionCode Value="True"/> </SyntaxOptions> </Parsing> <CodeGeneration> <Checks> <IOChecks Value="True"/> <RangeChecks Value="True"/> <OverflowChecks Value="True"/> <StackChecks Value="True"/> </Checks> <VerifyObjMethodCallValidity Value="True"/> <Optimizations> <OptimizationLevel Value="0"/> </Optimizations> </CodeGeneration> <Linking> <Debugging> <DebugInfoType Value="dsDwarf2Set"/> <UseHeaptrc Value="True"/> <TrashVariables Value="True"/> </Debugging> <Options> <Win32> <GraphicApplication Value="True"/> </Win32> </Options> </Linking> <Other> <CompilerMessages> <IgnoredMessages idx6058="True" idx5092="True" idx5024="True" idx4056="True" idx4055="True"/> </CompilerMessages> <CustomOptions Value="-dTOMBOY_NG"/> </Other> </CompilerOptions> </Item17> <Item18 Name="LeakCheckWin64"> <MacroValues Count="1"> <Macro1 Name="LCLWidgetType" Value="win32"/> </MacroValues> <CompilerOptions> <Version Value="11"/> <Target> <Filename Value="tomboy-ng64"/> </Target> <SearchPaths> <IncludeFiles Value="$(ProjOutDir)"/> <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> </SearchPaths> <CodeGeneration> <SmartLinkUnit Value="True"/> <TargetCPU Value="x86_64"/> <TargetOS Value="win64"/> <Optimizations> <OptimizationLevel Value="3"/> </Optimizations> </CodeGeneration> <Linking> <Debugging> <GenerateDebugInfo Value="False"/> <UseHeaptrc Value="True"/> </Debugging> <Options> <Win32> <GraphicApplication Value="True"/> </Win32> </Options> </Linking> <Other> <Verbosity> <ShowHints Value="False"/> </Verbosity> <CustomOptions Value="-dTOMBOY_NG"/> <CompilerPath Value="/usr/bin/ppcrossx64"/> </Other> </CompilerOptions> </Item18> <Item19 Name="LeakCheckWin32"> <MacroValues Count="1"> <Macro1 Name="LCLWidgetType" Value="win32"/> </MacroValues> <CompilerOptions> <Version Value="11"/> <Target> <Filename Value="tomboy-ng32"/> </Target> <SearchPaths> <IncludeFiles Value="$(ProjOutDir)"/> <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> </SearchPaths> <CodeGeneration> <SmartLinkUnit Value="True"/> <TargetCPU Value="i386"/> </CodeGeneration> <Linking> <Debugging> <GenerateDebugInfo Value="False"/> <UseLineInfoUnit Value="False"/> <UseHeaptrc Value="True"/> </Debugging> <Options> <Win32> <GraphicApplication Value="True"/> </Win32> </Options> </Linking> <Other> <Verbosity> <ShowHints Value="False"/> </Verbosity> <CustomOptions Value="-dTOMBOY_NG"/> <CompilerPath Value="/usr/bin/fpc"/> </Other> </CompilerOptions> </Item19> <Item20 Name="LeakCheckLin32"> <CompilerOptions> <Version Value="11"/> <Target> <Filename Value="tomboy-ng32"/> </Target> <SearchPaths> <IncludeFiles Value="$(ProjOutDir)"/> <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> </SearchPaths> <CodeGeneration> <SmartLinkUnit Value="True"/> <TargetProcessor Value="80386"/> <TargetCPU Value="i386"/> <TargetOS Value="linux"/> <Optimizations> <OptimizationLevel Value="3"/> </Optimizations> </CodeGeneration> <Linking> <Debugging> <GenerateDebugInfo Value="False"/> <UseHeaptrc Value="True"/> </Debugging> <LinkSmart Value="True"/> <Options> <Win32> <GraphicApplication Value="True"/> </Win32> </Options> </Linking> <Other> <Verbosity> <ShowTriedFiles Value="True"/> </Verbosity> <CustomOptions Value="-dTOMBOY_NG"/> </Other> </CompilerOptions> </Item20> <Item21 Name="LeakCheckLin64"> <MacroValues Count="1"> <Macro2 Name="LCLWidgetType" Value="gtk2"/> </MacroValues> <CompilerOptions> <Version Value="11"/> <Target> <Filename Value="tomboy-ng"/> </Target> <SearchPaths> <IncludeFiles Value="$(ProjOutDir)"/> <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> </SearchPaths> <CodeGeneration> <SmartLinkUnit Value="True"/> <TargetCPU Value="x86_64"/> <TargetOS Value="linux"/> <Optimizations> <OptimizationLevel Value="3"/> </Optimizations> </CodeGeneration> <Linking> <Debugging> <GenerateDebugInfo Value="False"/> <UseHeaptrc Value="True"/> </Debugging> <LinkSmart Value="True"/> <Options> <Win32> <GraphicApplication Value="True"/> </Win32> </Options> </Linking> <Other> <Verbosity> <ShowTriedFiles Value="True"/> </Verbosity> <CustomOptions Value="-dTOMBOY_NG"/> </Other> </CompilerOptions> </Item21> <Item22 Name="GTK3"> <MacroValues Count="1"> <Macro3 Name="LCLWidgetType" Value="gtk3"/> </MacroValues> <CompilerOptions> <Version Value="11"/> <Target> <Filename Value="tomboy-ng"/> </Target> <SearchPaths> <IncludeFiles Value="$(ProjOutDir)"/> <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> </SearchPaths> <CodeGeneration> <SmartLinkUnit Value="True"/> </CodeGeneration> <Linking> <Debugging> <DebugInfoType Value="dsDwarf3"/> <UseHeaptrc Value="True"/> </Debugging> <LinkSmart Value="True"/> <Options> <Win32> <GraphicApplication Value="True"/> </Win32> </Options> </Linking> <Other> <Verbosity> <ShowHints Value="False"/> </Verbosity> <CompilerMessages> <IgnoredMessages idx6058="True"/> </CompilerMessages> <CustomOptions Value="-dDisableLCLGIF -dDisableLCLJPEG -dDisableLCLPNM -dDisableLCLTIFF -dTOMBOY_NG"/> </Other> </CompilerOptions> </Item22> <Item23 Name="CarbonDebug"> <MacroValues Count="1"> <Macro6 Name="LCLWidgetType" Value="carbon"/> </MacroValues> <CompilerOptions> <Version Value="11"/> <Target> <Filename Value="tomboy-ng"/> </Target> <SearchPaths> <IncludeFiles Value="$(ProjOutDir)"/> <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> </SearchPaths> <Parsing> <SyntaxOptions> <IncludeAssertionCode Value="True"/> </SyntaxOptions> </Parsing> <CodeGeneration> <Checks> <IOChecks Value="True"/> <RangeChecks Value="True"/> <OverflowChecks Value="True"/> <StackChecks Value="True"/> </Checks> <VerifyObjMethodCallValidity Value="True"/> <TargetCPU Value="i386"/> </CodeGeneration> <Linking> <Debugging> <DebugInfoType Value="dsDwarf2Set"/> <UseHeaptrc Value="True"/> <TrashVariables Value="True"/> <UseExternalDbgSyms Value="True"/> </Debugging> <Options> <Win32> <GraphicApplication Value="True"/> </Win32> </Options> </Linking> <Other> <CompilerMessages> <IgnoredMessages idx5024="True"/> </CompilerMessages> <CustomOptions Value="-dTOMBOY_NG"/> </Other> </CompilerOptions> </Item23> <SharedMatrixOptions Count="7"> <Item1 ID="036726732034" Modes="ReleaseWin32,LeakCheckWin32,ReleaseWin64,LeakCheckWin64" Type="IDEMacro" MacroName="LCLWidgetType" Value="win32"/> <Item2 ID="418982182673" Modes="LeakCheckLin64,ReleaseLin64,ReleaseLin32,ReleaseRasPi64" Type="IDEMacro" MacroName="LCLWidgetType" Value="gtk2"/> <Item3 ID="429153174386" Modes="GTK3" Type="IDEMacro" MacroName="LCLWidgetType" Value="gtk3"/> <Item4 ID="950048283013" Modes="QT5Debug,ReleaseQT5,ReleaseRasPi,ReleaseLin32Qt5" Type="IDEMacro" MacroName="LCLWidgetType" Value="qt5"/> <Item5 ID="341789512381" Modes="CocoaDebug,CocoaRelease,CocoaArmRelease" Type="IDEMacro" MacroName="LCLWidgetType" Value="cocoa"/> <Item6 ID="231441956052" Modes="CarbonRelease,CarbonDebug" Type="IDEMacro" MacroName="LCLWidgetType" Value="carbon"/> <Item7 ID="372825449782" Modes="DebugQt6,ReleaseQt6" Type="IDEMacro" MacroName="LCLWidgetType" Value="qt6"/> </SharedMatrixOptions> </BuildModes> <PublishOptions> <Version Value="2"/> <DestinationDirectory Value="$(ProjPath)/published/"/> </PublishOptions> <RunParams> <local> <CommandLineParams Value="--config-dir=/home/dbannon/.config/tomboy-ng-alt"/> </local> <FormatVersion Value="2"/> <Modes Count="1"> <Mode0 Name="default"> <local> <CommandLineParams Value="--config-dir=/home/dbannon/.config/tomboy-ng-alt"/> </local> </Mode0> </Modes> </RunParams> <RequiredPackages Count="3"> <Item1> <PackageName Value="Printer4Lazarus"/> </Item1> <Item2> <PackageName Value="KControlsLaz"/> </Item2> <Item3> <PackageName Value="LCL"/> </Item3> </RequiredPackages> <Units Count="39"> <Unit0> <Filename Value="Tomboy_NG.lpr"/> <IsPartOfProject Value="True"/> </Unit0> <Unit1> <Filename Value="searchunit.pas"/> <IsPartOfProject Value="True"/> <ComponentName Value="SearchForm"/> <HasResources Value="True"/> <ResourceBaseClass Value="Form"/> <UnitName Value="SearchUnit"/> </Unit1> <Unit2> <Filename Value="editbox.pas"/> <IsPartOfProject Value="True"/> <ComponentName Value="EditBoxForm"/> <HasResources Value="True"/> <ResourceBaseClass Value="Form"/> <UnitName Value="EditBox"/> </Unit2> <Unit3> <Filename Value="savenote.pas"/> <IsPartOfProject Value="True"/> <UnitName Value="SaveNote"/> </Unit3> <Unit4> <Filename Value="loadnote.pas"/> <IsPartOfProject Value="True"/> <UnitName Value="LoadNote"/> </Unit4> <Unit5> <Filename Value="settings.pas"/> <IsPartOfProject Value="True"/> <ComponentName Value="Sett"/> <HasResources Value="True"/> <ResourceBaseClass Value="Form"/> </Unit5> <Unit6> <Filename Value="syncgui.pas"/> <IsPartOfProject Value="True"/> <ComponentName Value="FormSync"/> <HasResources Value="True"/> <ResourceBaseClass Value="Form"/> <UnitName Value="SyncGUI"/> </Unit6> <Unit7> <Filename Value="notebook.pas"/> <IsPartOfProject Value="True"/> <ComponentName Value="NoteBookPick"/> <HasResources Value="True"/> <ResourceBaseClass Value="Form"/> <UnitName Value="Notebook"/> </Unit7> <Unit8> <Filename Value="spelling.pas"/> <IsPartOfProject Value="True"/> <ComponentName Value="FormSpell"/> <HasResources Value="True"/> <ResourceBaseClass Value="Form"/> <UnitName Value="Spelling"/> </Unit8> <Unit9> <Filename Value="mainunit.pas"/> <IsPartOfProject Value="True"/> <ComponentName Value="MainForm"/> <HasResources Value="True"/> <ResourceBaseClass Value="Form"/> <UnitName Value="Mainunit"/> </Unit9> <Unit10> <Filename Value="backupview.pas"/> <IsPartOfProject Value="True"/> <ComponentName Value="FormBackupView"/> <HasResources Value="True"/> <ResourceBaseClass Value="Form"/> <UnitName Value="BackupView"/> </Unit10> <Unit11> <Filename Value="recover.pas"/> <IsPartOfProject Value="True"/> <ComponentName Value="FormRecover"/> <HasResources Value="True"/> <ResourceBaseClass Value="Form"/> </Unit11> <Unit12> <Filename Value="index.pas"/> <IsPartOfProject Value="True"/> <ComponentName Value="FormIndex"/> <HasResources Value="True"/> <ResourceBaseClass Value="Form"/> <UnitName Value="Index"/> </Unit12> <Unit13> <Filename Value="autostart.pas"/> <IsPartOfProject Value="True"/> </Unit13> <Unit14> <Filename Value="note_lister.pas"/> <IsPartOfProject Value="True"/> <UnitName Value="Note_Lister"/> </Unit14> <Unit15> <Filename Value="syncutils.pas"/> <IsPartOfProject Value="True"/> </Unit15> <Unit16> <Filename Value="sync.pas"/> <IsPartOfProject Value="True"/> </Unit16> <Unit17> <Filename Value="hunspell.pas"/> <IsPartOfProject Value="True"/> </Unit17> <Unit18> <Filename Value="k_prn.pas"/> <IsPartOfProject Value="True"/> <UnitName Value="K_Prn"/> </Unit18> <Unit19> <Filename Value="tb_sdiff.pas"/> <IsPartOfProject Value="True"/> <ComponentName Value="FormSDiff"/> <HasResources Value="True"/> <ResourceBaseClass Value="Form"/> <UnitName Value="TB_SDiff"/> </Unit19> <Unit20> <Filename Value="trans.pas"/> <IsPartOfProject Value="True"/> </Unit20> <Unit21> <Filename Value="transfile.pas"/> <IsPartOfProject Value="True"/> </Unit21> <Unit22> <Filename Value="resourcestr.pas"/> <IsPartOfProject Value="True"/> <UnitName Value="ResourceStr"/> </Unit22> <Unit23> <Filename Value="colours.pas"/> <IsPartOfProject Value="True"/> <ComponentName Value="FormColours"/> <HasResources Value="True"/> <ResourceBaseClass Value="Form"/> </Unit23> <Unit24> <Filename Value="cli.pas"/> <IsPartOfProject Value="True"/> </Unit24> <Unit25> <Filename Value="libnotify.pas"/> <IsPartOfProject Value="True"/> </Unit25> <Unit26> <Filename Value="rollback.pas"/> <IsPartOfProject Value="True"/> <ComponentName Value="FormRollBack"/> <HasResources Value="True"/> <ResourceBaseClass Value="Form"/> <UnitName Value="RollBack"/> </Unit26> <Unit27> <Filename Value="tb_utils.pas"/> <IsPartOfProject Value="True"/> </Unit27> <Unit28> <Filename Value="commonmark.pas"/> <IsPartOfProject Value="True"/> </Unit28> <Unit29> <Filename Value="tbundo.pas"/> <IsPartOfProject Value="True"/> </Unit29> <Unit30> <Filename Value="hunspell.inc"/> <IsPartOfProject Value="True"/> </Unit30> <Unit31> <Filename Value="notenormal.pas"/> <IsPartOfProject Value="True"/> </Unit31> <Unit32> <Filename Value="transgithub.pas"/> <IsPartOfProject Value="True"/> </Unit32> <Unit33> <Filename Value="import_notes.pas"/> <IsPartOfProject Value="True"/> </Unit33> <Unit34> <Filename Value="jsontools.pas"/> <IsPartOfProject Value="True"/> <UnitName Value="JsonTools"/> </Unit34> <Unit35> <Filename Value="kmemo2pdf.pas"/> <IsPartOfProject Value="True"/> <ComponentName Value="FormKMemo2pdf"/> <HasResources Value="True"/> <ResourceBaseClass Value="Form"/> </Unit35> <Unit36> <Filename Value="tb_symbol.pas"/> <IsPartOfProject Value="True"/> <ComponentName Value="FormSymbol"/> <HasResources Value="True"/> <ResourceBaseClass Value="Form"/> </Unit36> <Unit37> <Filename Value="fpttf.pp"/> <IsPartOfProject Value="True"/> <UnitName Value="fpTTF"/> </Unit37> <Unit38> <Filename Value="uqt_colors.pas"/> <IsPartOfProject Value="True"/> <UnitName Value="uQt_Colors"/> </Unit38> </Units> </ProjectOptions> <CompilerOptions> <Version Value="11"/> <Target> <Filename Value="tomboy-ng"/> </Target> <SearchPaths> <IncludeFiles Value="$(ProjOutDir)"/> <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> </SearchPaths> <CodeGeneration> <SmartLinkUnit Value="True"/> <Optimizations> <OptimizationLevel Value="0"/> </Optimizations> </CodeGeneration> <Linking> <Debugging> <GenerateDebugInfo Value="False"/> <DebugInfoType Value="dsDwarf2Set"/> </Debugging> <Options> <Win32> <GraphicApplication Value="True"/> </Win32> </Options> </Linking> <Other> <CompilerMessages> <IgnoredMessages idx6058="True"/> </CompilerMessages> <CustomOptions Value="-dTOMBOY_NG"/> <CompilerPath Value="fpc"/> </Other> </CompilerOptions> </CONFIG> ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������tomboy-ng_0.39-1/source/notebook.lfm����������������������������������������������������������������0000644�0001750�0001750�00000013175�14551457644�017266� 0����������������������������������������������������������������������������������������������������ustar �dbannon�������������������������dbannon����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������object NoteBookPick: TNoteBookPick Left = 861 Height = 436 Top = 322 Width = 604 Anchors = [] Caption = 'Notebooks' ClientHeight = 436 ClientWidth = 604 OnShow = FormShow LCLVersion = '3.0.0.3' object Panel1: TPanel AnchorSideLeft.Control = Owner AnchorSideTop.Control = Owner AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom Left = 0 Height = 72 Top = 0 Width = 604 Anchors = [akTop, akLeft, akRight] ClientHeight = 72 ClientWidth = 604 TabOrder = 0 object Label1: TLabel AnchorSideLeft.Control = Panel1 Left = 9 Height = 21 Top = 51 Width = 55 Anchors = [akLeft] BorderSpacing.Left = 8 Caption = 'Label1' Font.Style = [fsBold] ParentColor = False ParentFont = False end object Label3: TLabel AnchorSideLeft.Control = Panel1 Left = 9 Height = 21 Top = 19 Width = 53 Anchors = [akLeft] BorderSpacing.Left = 8 Caption = 'Label3' ParentColor = False end end object ButtonOK: TButton AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = Owner AnchorSideBottom.Side = asrBottom Left = 448 Height = 61 Top = 375 Width = 156 Anchors = [akLeft, akRight, akBottom] Caption = 'OK' TabOrder = 1 OnClick = ButtonOKClick end object Button1: TButton AnchorSideRight.Control = ButtonOK AnchorSideBottom.Control = Owner AnchorSideBottom.Side = asrBottom Left = 312 Height = 61 Top = 375 Width = 136 Anchors = [akLeft, akRight, akBottom] Caption = 'Cancel' ModalResult = 2 TabOrder = 2 end object Label2: TLabel AnchorSideLeft.Control = Owner AnchorSideTop.Control = PageControl1 AnchorSideTop.Side = asrBottom AnchorSideBottom.Control = Owner AnchorSideBottom.Side = asrBottom Left = 7 Height = 21 Top = 388 Width = 53 BorderSpacing.Left = 7 BorderSpacing.Top = 13 Caption = 'Label2' ParentColor = False end object PageControl1: TPageControl AnchorSideLeft.Control = Owner AnchorSideTop.Control = Panel1 AnchorSideTop.Side = asrBottom AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = ButtonOK Left = 0 Height = 303 Top = 72 Width = 604 ActivePage = TabChangeName Anchors = [akTop, akLeft, akRight, akBottom] TabIndex = 2 TabOrder = 3 object TabExisting: TTabSheet Caption = 'Existing Note Books' ClientHeight = 264 ClientWidth = 598 object CheckListBox1: TCheckListBox AnchorSideLeft.Control = TabExisting AnchorSideTop.Control = TabExisting AnchorSideRight.Control = TabExisting AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = TabExisting AnchorSideBottom.Side = asrBottom Left = 0 Height = 264 Top = 0 Width = 598 Anchors = [akTop, akLeft, akRight, akBottom] ItemHeight = 0 TabOrder = 0 TopIndex = -1 OnItemClick = CheckListBox1ItemClick end end object TabNewNoteBook: TTabSheet Caption = 'New Note Book' ClientHeight = 264 ClientWidth = 598 OnShow = TabNewNoteBookShow object EditNewNotebook: TEdit Left = 24 Height = 29 Top = 56 Width = 248 TabOrder = 0 OnKeyDown = EditNewNotebookKeyDown end object Label4: TLabel Left = 26 Height = 21 Top = 32 Width = 222 Caption = 'Name of the New Notebook' ParentColor = False end object Label5: TLabel Left = 29 Height = 21 Top = 104 Width = 513 Caption = 'Press OK and we will make the Notebook AND add this note to it.' ParentColor = False end end object TabChangeName: TTabSheet Caption = 'Change Notebook Name' ClientHeight = 264 ClientWidth = 598 object Label6: TLabel Left = 15 Height = 21 Top = 17 Width = 113 Caption = 'Existing Name' ParentColor = False end object Label7: TLabel Left = 17 Height = 21 Top = 41 Width = 53 Caption = 'Label7' ParentColor = False end object Label8: TLabel Left = 16 Height = 21 Top = 77 Width = 87 Caption = 'New Name' ParentColor = False end object EditNewNotebookName: TEdit Left = 17 Height = 29 Top = 96 Width = 271 TabOrder = 0 OnEditingDone = EditNewNotebookNameEditingDone end object Label9: TLabel Left = 18 Height = 21 Top = 153 Width = 542 Caption = 'If you sync and are not absolutely sure it is up to date, Cancel now !' Font.Style = [fsBold] ParentColor = False ParentFont = False end end object TabSetNotes: TTabSheet Caption = 'Set Notes' ClientHeight = 264 ClientWidth = 598 object CheckListAddNotes: TCheckListBox AnchorSideLeft.Control = TabSetNotes AnchorSideTop.Control = TabSetNotes AnchorSideRight.Control = TabSetNotes AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = TabSetNotes AnchorSideBottom.Side = asrBottom Left = 0 Height = 264 Top = 0 Width = 598 Anchors = [akTop, akLeft, akRight, akBottom] ItemHeight = 0 TabOrder = 0 TopIndex = -1 end end end end ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������tomboy-ng_0.39-1/source/recover.lfm�����������������������������������������������������������������0000644�0001750�0001750�00000022102�14551457644�017101� 0����������������������������������������������������������������������������������������������������ustar �dbannon�������������������������dbannon����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������object FormRecover: TFormRecover Left = 228 Height = 561 Top = 227 Width = 758 Caption = 'FormRecover' ClientHeight = 561 ClientWidth = 758 OnCreate = FormCreate OnDestroy = FormDestroy OnShow = FormShow LCLVersion = '3.0.0.3' object Label1: TLabel Left = 8 Height = 21 Top = 360 Width = 53 Caption = 'Label1' end object ListBoxSnapshots: TListBox AnchorSideLeft.Control = Owner AnchorSideTop.Control = PanelSnapshots AnchorSideTop.Side = asrBottom AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = Owner AnchorSideBottom.Side = asrBottom Left = 2 Height = 287 Hint = 'These are the currently known snapshots. ' Top = 274 Width = 278 Anchors = [akTop, akLeft, akBottom] BorderSpacing.Left = 2 BorderSpacing.Top = 2 ItemHeight = 0 ParentShowHint = False ScrollWidth = 276 ShowHint = True TabOrder = 0 TopIndex = -1 OnClick = ListBoxSnapshotsClick OnDblClick = ListBoxSnapshotsDblClick end object PageControl1: TPageControl AnchorSideLeft.Control = Owner AnchorSideTop.Control = Panel1 AnchorSideTop.Side = asrBottom AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom Left = 0 Height = 204 Top = 44 Width = 758 ActivePage = TabSheetBadNotes Anchors = [akTop, akLeft, akRight] TabIndex = 1 TabOrder = 1 object TabSheetIntro: TTabSheet Caption = 'Introduction' ClientHeight = 165 ClientWidth = 752 OnShow = TabSheetIntroShow object Label6: TLabel Left = 8 Height = 21 Top = 8 Width = 439 Caption = 'This tool might help you recover lost or damaged notes.' end object Label7: TLabel Left = 8 Height = 21 Top = 64 Width = 453 Caption = 'Before you start, take a Snapshot of your notes directory.' end object Label10: TLabel Left = 8 Height = 21 Top = 36 Width = 338 Caption = 'Please close any notes you may have open.' end object ButtonMakeSafetySnap: TButton AnchorSideTop.Control = ButtonSnapHelp AnchorSideRight.Control = ButtonSnapHelp AnchorSideBottom.Control = TabSheetIntro AnchorSideBottom.Side = asrBottom Left = 421 Height = 33 Hint = 'Take a snapshot of your notes and config. Overwritten each time.' Top = 132 Width = 201 Anchors = [akTop, akRight, akBottom] AutoSize = True BorderSpacing.Right = 2 Caption = 'Take a manual Snapshot' ParentShowHint = False ShowHint = True TabOrder = 0 OnClick = ButtonMakeSafetySnapClick end object ButtonSnapHelp: TButton AnchorSideTop.Control = TabSheetIntro AnchorSideRight.Control = TabSheetIntro AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = TabSheetIntro AnchorSideBottom.Side = asrBottom Left = 624 Height = 33 Top = 132 Width = 126 Anchors = [akRight, akBottom] AutoSize = True BorderSpacing.Top = 2 BorderSpacing.Right = 2 Caption = 'Snapshot Help' TabOrder = 1 OnClick = ButtonSnapHelpClick end end object TabSheetBadNotes: TTabSheet Caption = 'Bad Notes' ClientHeight = 165 ClientWidth = 752 OnShow = TabSheetBadNotesShow object Label5: TLabel Left = 8 Height = 21 Top = 8 Width = 293 Caption = 'Looking for notes with damaged XML' end object ButtonDeleteBadNotes: TButton AnchorSideRight.Control = TabSheetBadNotes AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = TabSheetBadNotes AnchorSideBottom.Side = asrBottom Left = 598 Height = 29 Top = 136 Width = 152 Anchors = [akTop, akRight, akBottom] AutoSize = True BorderSpacing.Right = 2 Caption = 'Delete Bad Notes' TabOrder = 0 OnClick = ButtonDeleteBadNotesClick end object LabelNoteErrors: TLabel Left = 8 Height = 21 Top = 36 Width = 132 Caption = 'LabelNoteErrors' end object LabelExistingAdvice: TLabel Left = 10 Height = 21 Top = 64 Width = 157 Caption = 'LabelExistingAdvice' end object LabelExistingAdvice2: TLabel Left = 11 Height = 21 Top = 92 Width = 167 Caption = 'LabelExistingAdvice2' end end object TabSheetRecoverNotes: TTabSheet Caption = 'Recover Notes' ClientHeight = 165 ClientWidth = 752 OnShow = TabSheetRecoverNotesShow object Label9: TLabel Left = 10 Height = 21 Top = 8 Width = 410 Caption = 'From here you can view snapshot notes, one by one.' end object Label14: TLabel Left = 10 Height = 21 Top = 36 Width = 364 Caption = 'Click an available snapshot to see its contents.' end object Label16: TLabel Left = 11 Height = 21 Top = 64 Width = 434 Caption = 'You may chose to view, copy and paste into a new note.' end end object TabSheetMergeSnapshot: TTabSheet Caption = 'Merge Snapshot' ClientHeight = 165 ClientWidth = 752 Enabled = False OnShow = TabSheetMergeSnapshotShow TabVisible = False object Label3: TLabel Left = 9 Height = 21 Top = 8 Width = 611 Caption = 'Restore any notes in the snapshot that are not in the existing notes directory.' end end object TabSheetRecoverSnapshot: TTabSheet Caption = 'Recover Snapshot' ClientHeight = 165 ClientWidth = 752 OnShow = TabSheetRecoverSnapshotShow object Label4: TLabel Left = 8 Height = 21 Top = 8 Width = 470 Caption = 'Remove all existing notes and use the ones in the Snapshot.' end object ButtonRecoverSnap: TButton AnchorSideTop.Control = TabSheetRecoverSnapshot AnchorSideRight.Control = TabSheetRecoverSnapshot AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = TabSheetRecoverSnapshot AnchorSideBottom.Side = asrBottom Left = 603 Height = 33 Top = 132 Width = 147 Anchors = [akRight, akBottom] BorderSpacing.Top = 2 BorderSpacing.Right = 2 Caption = 'Recover' TabOrder = 0 OnClick = ButtonRecoverSnapClick end object Label12: TLabel Left = 8 Height = 21 Top = 36 Width = 550 Caption = 'Don''t even consider this unless you have a backup Snapshot, Intro Tab.' end object Label15: TLabel Left = 8 Height = 21 Top = 64 Width = 320 Caption = 'Click an available snapshot, click Recover' end end end object Panel1: TPanel AnchorSideLeft.Control = Owner AnchorSideTop.Control = Owner AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom Left = 0 Height = 44 Top = 0 Width = 758 Anchors = [akTop, akLeft, akRight] ClientHeight = 44 ClientWidth = 758 TabOrder = 2 object Label2: TLabel Left = 40 Height = 22 Top = 8 Width = 369 Caption = 'Please be careful, this is a dangerous place!' Font.Height = -19 ParentFont = False end end object StringGridNotes: TStringGrid AnchorSideLeft.Control = ListBoxSnapshots AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = PanelNoteList AnchorSideTop.Side = asrBottom AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = Owner AnchorSideBottom.Side = asrBottom Left = 282 Height = 287 Top = 274 Width = 476 Anchors = [akTop, akLeft, akRight, akBottom] BorderSpacing.Left = 2 BorderSpacing.Top = 2 Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goColSizing, goSmoothScroll] TabOrder = 3 OnDblClick = StringGridNotesDblClick end object PanelSnapshots: TPanel AnchorSideLeft.Control = Owner AnchorSideTop.Control = PageControl1 AnchorSideTop.Side = asrBottom AnchorSideRight.Control = ListBoxSnapshots AnchorSideRight.Side = asrBottom Left = 0 Height = 24 Top = 248 Width = 280 Anchors = [akTop, akLeft, akRight] Caption = 'Available Snapshots' TabOrder = 4 end object PanelNoteList: TPanel AnchorSideLeft.Control = StringGridNotes AnchorSideTop.Control = PageControl1 AnchorSideTop.Side = asrBottom AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = PanelSnapshots AnchorSideBottom.Side = asrBottom Left = 282 Height = 24 Top = 248 Width = 476 Anchors = [akTop, akLeft, akRight, akBottom] TabOrder = 5 end end ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������tomboy-ng_0.39-1/source/spelling.lfm����������������������������������������������������������������0000644�0001750�0001750�00000004632�14551457644�017261� 0����������������������������������������������������������������������������������������������������ustar �dbannon�������������������������dbannon����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������object FormSpell: TFormSpell Left = 386 Height = 227 Top = 328 Width = 491 Caption = 'Spell' ClientHeight = 227 ClientWidth = 491 OnHide = FormHide OnShow = FormShow LCLVersion = '2.2.0.2' object ListBox1: TListBox AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom Left = 300 Height = 136 Top = 40 Width = 181 Anchors = [akRight] BorderSpacing.Right = 10 ItemHeight = 0 OnClick = ListBox1Click OnDblClick = ListBox1DblClick ScrollWidth = 150 TabOrder = 0 TopIndex = -1 end object LabelPrompt: TLabel AnchorSideRight.Control = ListBox1 AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = ListBox1 Left = 315 Height = 21 Top = 17 Width = 166 Anchors = [akRight, akBottom] BorderSpacing.Bottom = 2 Caption = 'Click a word to use it.' end object Label4: TLabel Left = 19 Height = 21 Top = 16 Width = 115 Caption = 'Suspect word -' end object LabelSuspect: TLabel Left = 19 Height = 21 Top = 48 Width = 110 Caption = 'LabelSuspect' Font.Style = [fsBold] ParentFont = False end object ButtonUseAndNextWord: TButton Left = 16 Height = 49 Top = 112 Width = 173 Caption = 'Use and Next Word' OnClick = ButtonUseAndNextWordClick TabOrder = 1 end object LabelStatus: TLabel Left = 19 Height = 21 Top = 199 Width = 93 Caption = 'LabelStatus' end object LabelContext: TLabel Left = 19 Height = 21 Top = 80 Width = 107 Caption = 'LabelContext' end object ButtonSkip: TButton Left = 16 Height = 25 Hint = 'Skip just this instance' Top = 160 Width = 88 Caption = 'Skip' OnClick = ButtonSkipClick ParentShowHint = False ShowHint = True TabOrder = 2 end object ButtonIgnore: TButton Left = 104 Height = 25 Hint = 'Ignore all instances for the run' Top = 160 Width = 85 Caption = 'Ignore' OnClick = ButtonIgnoreClick ParentShowHint = False ShowHint = True TabOrder = 3 end object BitBtn1: TBitBtn AnchorSideLeft.Control = ListBox1 AnchorSideRight.Control = ListBox1 AnchorSideRight.Side = asrBottom Left = 300 Height = 30 Top = 184 Width = 181 Anchors = [akTop, akLeft, akRight] DefaultCaption = True Kind = bkClose ModalResult = 11 TabOrder = 4 end end ������������������������������������������������������������������������������������������������������tomboy-ng_0.39-1/source/recover.lrj�����������������������������������������������������������������0000644�0001750�0001750�00000015702�14551457644�017122� 0����������������������������������������������������������������������������������������������������ustar �dbannon�������������������������dbannon����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������{"version":1,"strings":[ {"hash":150275554,"name":"tformrecover.caption","sourcebytes":[70,111,114,109,82,101,99,111,118,101,114],"value":"FormRecover"}, {"hash":86477809,"name":"tformrecover.label1.caption","sourcebytes":[76,97,98,101,108,49],"value":"Label1"}, {"hash":115464352,"name":"tformrecover.listboxsnapshots.hint","sourcebytes":[84,104,101,115,101,32,97,114,101,32,116,104,101,32,99,117,114,114,101,110,116,108,121,32,107,110,111,119,110,32,115,110,97,112,115,104,111,116,115,46,32],"value":"These are the currently known snapshots. "}, {"hash":247404302,"name":"tformrecover.tabsheetintro.caption","sourcebytes":[73,110,116,114,111,100,117,99,116,105,111,110],"value":"Introduction"}, {"hash":77890286,"name":"tformrecover.label6.caption","sourcebytes":[84,104,105,115,32,116,111,111,108,32,109,105,103,104,116,32,104,101,108,112,32,121,111,117,32,114,101,99,111,118,101,114,32,108,111,115,116,32,111,114,32,100,97,109,97,103,101,100,32,110,111,116,101,115,46],"value":"This tool might help you recover lost or damaged notes."}, {"hash":82347246,"name":"tformrecover.label7.caption","sourcebytes":[66,101,102,111,114,101,32,121,111,117,32,115,116,97,114,116,44,32,116,97,107,101,32,97,32,83,110,97,112,115,104,111,116,32,111,102,32,121,111,117,114,32,110,111,116,101,115,32,100,105,114,101,99,116,111,114,121,46],"value":"Before you start, take a Snapshot of your notes directory."}, {"hash":256349950,"name":"tformrecover.label10.caption","sourcebytes":[80,108,101,97,115,101,32,99,108,111,115,101,32,97,110,121,32,110,111,116,101,115,32,121,111,117,32,109,97,121,32,104,97,118,101,32,111,112,101,110,46],"value":"Please close any notes you may have open."}, {"hash":26163774,"name":"tformrecover.buttonmakesafetysnap.hint","sourcebytes":[84,97,107,101,32,97,32,105,110,105,116,105,97,108,32,115,110,97,112,115,104,111,116,32,111,102,32,121,111,117,114,32,110,111,116,101,115,32,97,110,100,32,99,111,110,102,105,103,46,32,79,118,101,114,119,114,105,116,116,101,110,32,101,97,99,104,32,116,105,109,101,46],"value":"Take a initial snapshot of your notes and config. Overwritten each time."}, {"hash":106340756,"name":"tformrecover.buttonmakesafetysnap.caption","sourcebytes":[84,97,107,101,32,97,32,109,97,110,117,97,108,32,83,110,97,112,115,104,111,116],"value":"Take a manual Snapshot"}, {"hash":204248048,"name":"tformrecover.buttonsnaphelp.caption","sourcebytes":[83,110,97,112,115,104,111,116,32,72,101,108,112],"value":"Snapshot Help"}, {"hash":106242739,"name":"tformrecover.tabsheetbadnotes.caption","sourcebytes":[66,97,100,32,78,111,116,101,115],"value":"Bad Notes"}, {"hash":264440540,"name":"tformrecover.label5.caption","sourcebytes":[76,111,111,107,105,110,103,32,102,111,114,32,110,111,116,101,115,32,119,105,116,104,32,100,97,109,97,103,101,100,32,88,77,76],"value":"Looking for notes with damaged XML"}, {"hash":184061587,"name":"tformrecover.buttondeletebadnotes.caption","sourcebytes":[68,101,108,101,116,101,32,66,97,100,32,78,111,116,101,115],"value":"Delete Bad Notes"}, {"hash":17347139,"name":"tformrecover.labelnoteerrors.caption","sourcebytes":[76,97,98,101,108,78,111,116,101,69,114,114,111,114,115],"value":"LabelNoteErrors"}, {"hash":101302085,"name":"tformrecover.labelexistingadvice.caption","sourcebytes":[76,97,98,101,108,69,120,105,115,116,105,110,103,65,100,118,105,99,101],"value":"LabelExistingAdvice"}, {"hash":10220770,"name":"tformrecover.labelexistingadvice2.caption","sourcebytes":[76,97,98,101,108,69,120,105,115,116,105,110,103,65,100,118,105,99,101,50],"value":"LabelExistingAdvice2"}, {"hash":219088467,"name":"tformrecover.tabsheetrecovernotes.caption","sourcebytes":[82,101,99,111,118,101,114,32,78,111,116,101,115],"value":"Recover Notes"}, {"hash":8653518,"name":"tformrecover.label9.caption","sourcebytes":[70,114,111,109,32,104,101,114,101,32,121,111,117,32,99,97,110,32,118,105,101,119,32,115,110,97,112,115,104,111,116,32,110,111,116,101,115,44,32,111,110,101,32,98,121,32,111,110,101,46],"value":"From here you can view snapshot notes, one by one."}, {"hash":262948446,"name":"tformrecover.label14.caption","sourcebytes":[67,108,105,99,107,32,97,110,32,97,118,97,105,108,97,98,108,101,32,115,110,97,112,115,104,111,116,32,116,111,32,115,101,101,32,105,116,115,32,99,111,110,116,101,110,116,115,46],"value":"Click an available snapshot to see its contents."}, {"hash":89899246,"name":"tformrecover.label16.caption","sourcebytes":[89,111,117,32,109,97,121,32,99,104,111,115,101,32,116,111,32,118,105,101,119,44,32,99,111,112,121,32,97,110,100,32,112,97,115,116,101,32,105,110,116,111,32,97,32,110,101,119,32,110,111,116,101,46],"value":"You may chose to view, copy and paste into a new note."}, {"hash":134934484,"name":"tformrecover.tabsheetmergesnapshot.caption","sourcebytes":[77,101,114,103,101,32,83,110,97,112,115,104,111,116],"value":"Merge Snapshot"}, {"hash":248739630,"name":"tformrecover.label3.caption","sourcebytes":[82,101,115,116,111,114,101,32,97,110,121,32,110,111,116,101,115,32,105,110,32,116,104,101,32,115,110,97,112,115,104,111,116,32,116,104,97,116,32,97,114,101,32,110,111,116,32,105,110,32,116,104,101,32,101,120,105,115,116,105,110,103,32,110,111,116,101,115,32,100,105,114,101,99,116,111,114,121,46],"value":"Restore any notes in the snapshot that are not in the existing notes directory."}, {"hash":38687012,"name":"tformrecover.tabsheetrecoversnapshot.caption","sourcebytes":[82,101,99,111,118,101,114,32,83,110,97,112,115,104,111,116],"value":"Recover Snapshot"}, {"hash":238976622,"name":"tformrecover.label4.caption","sourcebytes":[82,101,109,111,118,101,32,97,108,108,32,101,120,105,115,116,105,110,103,32,110,111,116,101,115,32,97,110,100,32,117,115,101,32,116,104,101,32,111,110,101,115,32,105,110,32,116,104,101,32,83,110,97,112,115,104,111,116,46],"value":"Remove all existing notes and use the ones in the Snapshot."}, {"hash":146435218,"name":"tformrecover.buttonrecoversnap.caption","sourcebytes":[82,101,99,111,118,101,114],"value":"Recover"}, {"hash":35664446,"name":"tformrecover.label12.caption","sourcebytes":[68,111,110,39,116,32,101,118,101,110,32,99,111,110,115,105,100,101,114,32,116,104,105,115,32,117,110,108,101,115,115,32,121,111,117,32,104,97,118,101,32,97,32,98,97,99,107,117,112,32,83,110,97,112,115,104,111,116,44,32,73,110,116,114,111,32,84,97,98,46],"value":"Don't even consider this unless you have a backup Snapshot, Intro Tab."}, {"hash":190528946,"name":"tformrecover.label15.caption","sourcebytes":[67,108,105,99,107,32,97,110,32,97,118,97,105,108,97,98,108,101,32,115,110,97,112,115,104,111,116,44,32,99,108,105,99,107,32,82,101,99,111,118,101,114],"value":"Click an available snapshot, click Recover"}, {"hash":215257073,"name":"tformrecover.label2.caption","sourcebytes":[80,108,101,97,115,101,32,98,101,32,99,97,114,101,102,117,108,44,32,116,104,105,115,32,105,115,32,97,32,100,97,110,103,101,114,111,117,115,32,112,108,97,99,101,33],"value":"Please be careful, this is a dangerous place!"}, {"hash":160877251,"name":"tformrecover.panelsnapshots.caption","sourcebytes":[65,118,97,105,108,97,98,108,101,32,83,110,97,112,115,104,111,116,115],"value":"Available Snapshots"} ]} ��������������������������������������������������������������tomboy-ng_0.39-1/source/syncgui.lfm�����������������������������������������������������������������0000644�0001750�0001750�00000011776�14551457644�017134� 0����������������������������������������������������������������������������������������������������ustar �dbannon�������������������������dbannon����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������object FormSync: TFormSync Left = 825 Height = 418 Top = 260 Width = 699 Caption = 'Sync' ClientHeight = 418 ClientWidth = 699 LCLVersion = '3.99.0.0' OnClose = FormClose OnCreate = FormCreate OnHide = FormHide OnShow = FormShow object Panel1: TPanel AnchorSideLeft.Control = Owner AnchorSideTop.Control = Owner AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom Left = 0 Height = 91 Top = 0 Width = 699 Anchors = [akTop, akLeft, akRight] ClientHeight = 91 ClientWidth = 699 TabOrder = 0 object Label1: TLabel Left = 35 Height = 19 Top = 24 Width = 59 Caption = 'Label1' Font.Height = -16 Font.Name = 'Sans' Font.Style = [fsBold] ParentFont = False end object Label2: TLabel Left = 35 Height = 21 Top = 56 Width = 53 Caption = 'Label2' end object LabelProgress: TLabel AnchorSideTop.Control = Label1 AnchorSideRight.Control = Panel1 AnchorSideRight.Side = asrBottom Left = 572 Height = 21 Top = 24 Width = 114 Anchors = [akTop, akRight] BorderSpacing.Right = 12 Caption = 'LabelProgress' end end object Panel2: TPanel AnchorSideLeft.Control = Owner AnchorSideTop.Control = Panel1 AnchorSideTop.Side = asrBottom AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom AnchorSideBottom.Side = asrBottom Left = 0 Height = 37 Top = 91 Width = 699 Anchors = [akTop, akLeft, akRight] ClientHeight = 37 ClientWidth = 699 TabOrder = 1 object ButtonCancel: TButton AnchorSideLeft.Control = Panel2 AnchorSideTop.Control = Panel2 AnchorSideBottom.Control = Panel2 AnchorSideBottom.Side = asrBottom Left = 1 Height = 35 Top = 1 Width = 150 Anchors = [akTop, akLeft, akBottom] Caption = 'Cancel' TabOrder = 0 OnClick = ButtonCancelClick end object ButtonClose: TButton AnchorSideLeft.Control = ButtonCancel AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = Panel2 AnchorSideBottom.Control = Panel2 AnchorSideBottom.Side = asrBottom Left = 151 Height = 35 Top = 1 Width = 150 Anchors = [akTop, akLeft, akBottom] Caption = 'Close' TabOrder = 1 OnClick = ButtonCloseClick end object ButtonSave: TButton AnchorSideLeft.Control = ButtonClose AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = Panel2 AnchorSideBottom.Control = Panel2 AnchorSideBottom.Side = asrBottom Left = 301 Height = 35 Top = 1 Width = 150 Anchors = [akTop, akLeft, akBottom] Caption = 'Save and Sync' TabOrder = 2 OnClick = ButtonSaveClick end end object Panel3: TPanel AnchorSideLeft.Control = Owner AnchorSideTop.Control = Panel2 AnchorSideTop.Side = asrBottom AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = Owner AnchorSideBottom.Side = asrBottom Left = 0 Height = 290 Top = 128 Width = 699 Anchors = [akTop, akLeft, akRight, akBottom] Caption = 'Panel3' ClientHeight = 290 ClientWidth = 699 TabOrder = 2 object Memo1: TMemo AnchorSideLeft.Control = Splitter3 AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = Panel3 AnchorSideRight.Control = Panel3 AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = Panel3 AnchorSideBottom.Side = asrBottom Left = 394 Height = 288 Top = 1 Width = 304 Align = alRight Anchors = [akTop, akLeft, akRight, akBottom] Lines.Strings = ( 'Memo1' ) TabOrder = 0 end object Splitter3: TSplitter AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = Panel3 AnchorSideRight.Control = Memo1 AnchorSideBottom.Control = Panel3 AnchorSideBottom.Side = asrBottom Left = 384 Height = 236 Top = 48 Width = 10 Align = alNone Anchors = [] end object ListViewReport: TListView AnchorSideLeft.Control = Panel3 AnchorSideTop.Control = Panel3 AnchorSideRight.Control = Splitter3 AnchorSideBottom.Control = Panel3 AnchorSideBottom.Side = asrBottom Left = 2 Height = 286 Top = 2 Width = 381 Anchors = [akTop, akLeft, akRight, akBottom] BorderSpacing.Left = 1 BorderSpacing.Top = 1 BorderSpacing.Right = 1 BorderSpacing.Bottom = 1 Columns = < item AutoSize = True Caption = 'Action' Width = 58 end item AutoSize = True Caption = 'Title' Width = 44 end item Caption = 'Note ID' Width = 379 end> ReadOnly = True ScrollBars = ssAutoBoth TabOrder = 2 ViewStyle = vsReport end end end ��tomboy-ng_0.39-1/source/backlinks.lfm���������������������������������������������������������������0000644�0001750�0001750�00000002674�14551457644�017411� 0����������������������������������������������������������������������������������������������������ustar �dbannon�������������������������dbannon����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������object FormBackLinks: TFormBackLinks Left = 472 Height = 279 Top = 411 Width = 354 Caption = 'Linked to this note' ClientHeight = 279 ClientWidth = 354 OnShow = FormShow LCLVersion = '3.0.0.3' object ListBox1: TListBox AnchorSideLeft.Control = Owner AnchorSideTop.Control = Owner AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = Label1 Left = 5 Height = 213 Top = 5 Width = 344 Anchors = [akTop, akLeft, akRight, akBottom] BorderSpacing.Left = 5 BorderSpacing.Top = 5 BorderSpacing.Right = 5 BorderSpacing.Bottom = 5 ItemHeight = 0 TabOrder = 0 TopIndex = -1 OnClick = ListBox1Click end object BitBtn1: TBitBtn AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = Owner AnchorSideBottom.Side = asrBottom Left = 196 Height = 30 Top = 244 Width = 153 Anchors = [akRight, akBottom] BorderSpacing.Right = 5 BorderSpacing.Bottom = 5 Cancel = True DefaultCaption = True Kind = bkCancel ModalResult = 2 TabOrder = 1 end object Label1: TLabel AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = BitBtn1 Left = 152 Height = 21 Top = 223 Width = 197 Anchors = [akRight, akBottom] BorderSpacing.Right = 5 Caption = 'No other notes link here.' end end ��������������������������������������������������������������������tomboy-ng_0.39-1/source/kmemo2pdf.lfm���������������������������������������������������������������0000644�0001750�0001750�00000002733�14551457644�017330� 0����������������������������������������������������������������������������������������������������ustar �dbannon�������������������������dbannon����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������object FormKMemo2pdf: TFormKMemo2pdf Left = 80 Height = 461 Top = 570 Width = 571 ActiveControl = Memo1 Caption = 'PDF Issues' ClientHeight = 461 ClientWidth = 571 OnCreate = FormCreate OnShow = FormShow LCLVersion = '2.2.0.2' object BitBtn1: TBitBtn AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = Owner AnchorSideBottom.Side = asrBottom Left = 491 Height = 30 Top = 426 Width = 75 Anchors = [akRight, akBottom] BorderSpacing.Right = 5 BorderSpacing.Bottom = 5 DefaultCaption = True Kind = bkClose ModalResult = 11 TabOrder = 0 end object BitBtnProceed: TBitBtn AnchorSideTop.Control = BitBtn1 AnchorSideRight.Control = BitBtn1 Left = 375 Height = 30 Top = 426 Width = 113 Anchors = [akTop, akRight] BorderSpacing.Right = 3 DefaultCaption = True Kind = bkRetry ModalResult = 4 OnClick = BitBtnProceedClick TabOrder = 1 end object Memo1: TMemo AnchorSideLeft.Control = Owner AnchorSideTop.Control = Owner AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = BitBtn1 Left = 2 Height = 422 Top = 2 Width = 567 Anchors = [akTop, akLeft, akRight, akBottom] BorderSpacing.Left = 2 BorderSpacing.Top = 2 BorderSpacing.Right = 2 BorderSpacing.Bottom = 2 Lines.Strings = ( 'Memo1' ) TabOrder = 2 end end �������������������������������������tomboy-ng_0.39-1/source/editbox.lfm�����������������������������������������������������������������0000644�0001750�0001750�00000230555�14551457644�017107� 0����������������������������������������������������������������������������������������������������ustar �dbannon�������������������������dbannon����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������object EditBoxForm: TEditBoxForm Left = 871 Height = 505 Top = 343 Width = 784 Caption = 'EditBoxForm' ClientHeight = 505 ClientWidth = 784 Constraints.MinHeight = 200 Constraints.MinWidth = 200 OnActivate = FormActivate OnClose = FormClose OnCloseQuery = FormCloseQuery OnCreate = FormCreate OnDestroy = FormDestroy OnShow = FormShow LCLVersion = '3.0.0.3' object PanelReadOnly: TPanel AnchorSideLeft.Control = Owner AnchorSideTop.Control = KMemo1 AnchorSideTop.Side = asrBottom AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = PanelFind Left = 0 Height = 60 Top = 406 Width = 784 Anchors = [akLeft, akRight, akBottom] ClientHeight = 60 ClientWidth = 784 Color = clYellow ParentBackground = False ParentColor = False ParentFont = False TabOrder = 1 object Label2: TLabel Left = 8 Height = 23 Top = 16 Width = 98 Caption = 'Read Only' Font.Height = -20 Font.Style = [fsBold] ParentFont = False end object Label3: TLabel Left = 120 Height = 21 Top = 8 Width = 379 Caption = 'This note has been changed by the Sync Process' end object Label4: TLabel Left = 120 Height = 21 Top = 32 Width = 382 Caption = 'Please close it (and re-open if it was a download)' end end object PanelFind: TPanel AnchorSideLeft.Control = Owner AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = Owner AnchorSideBottom.Side = asrBottom Left = 0 Height = 39 Top = 466 Width = 784 Anchors = [akLeft, akRight, akBottom] BevelInner = bvLowered ClientHeight = 39 ClientWidth = 784 TabOrder = 2 OnEnter = PanelFindEnter object EditFind: TEdit Left = 8 Height = 29 Top = 5 Width = 136 ParentShowHint = False ShowHint = True TabOrder = 0 Text = 'EditFind' OnChange = EditFindChange OnEnter = EditFindEnter OnExit = EditFindExit OnKeyDown = EditFindKeyDown end object LabelFindInfo: TLabel AnchorSideLeft.Control = LabelFindCount AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = EditFind AnchorSideBottom.Control = EditFind AnchorSideBottom.Side = asrCenter Left = 222 Height = 21 Top = 8 Width = 108 Anchors = [akLeft, akBottom] BorderSpacing.Left = 5 Caption = 'LabelFindInfo' end object LabelFindCount: TLabel AnchorSideLeft.Control = SpeedRight AnchorSideLeft.Side = asrBottom AnchorSideBottom.Control = PanelFind AnchorSideBottom.Side = asrBottom Left = 206 Height = 28 Top = 9 Width = 11 Anchors = [akTop, akLeft, akBottom] BorderSpacing.Left = 6 Caption = 'X' end object SpeedLeft: TSpeedButton AnchorSideLeft.Control = EditFind AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = EditFind AnchorSideBottom.Control = EditFind AnchorSideBottom.Side = asrBottom Left = 144 Height = 29 Top = 5 Width = 28 Anchors = [akTop, akLeft, akBottom] Glyph.Data = { 36090000424D3609000000000000360000002800000018000000180000000100 2000000000000009000064000000640000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00000F7B29FF0000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000000000000000000000107B 2AFF0E7B29FF0000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000117D2BFF0F7C 2AFF0E7B28FF0000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00000000000000000000000000000000000000000000127E2DFF107D2BFF0F7C 2AFF0D7B28FF0000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00000000000000000000000000000000000014802EFF127F2DFF117E2CFF0F7D 2AFF0E7C29FF0C7B27FF0B7B27FF0A7A25FF0A7925FF0A7925FF0A7925FF0A79 25FF0B7926FF0C7926FF00000000000000000000000000000000000000000000 0000000000000000000000000000158130FF14812EFF13802DFF117F2CFF107E 2BFF0E7D29FF0D7C28FF0C7B27FF0B7B26FF0B7A26FF0B7A26FF0B7926FF0B79 26FF0C7927FF0D7A27FF00000000000000000000000000000000000000000000 00000000000000000000178231FF158230FF15822FFF13812EFF12802DFF1080 2CFF0F7F2AFF0E7E29FF0D7D28FF0C7C28FF0C7B27FF0C7B27FF0C7A27FF0C7A 27FF0D7A28FF0E7A28FF00000000000000000000000000000000000000000000 000000000000178332FF178331FF168331FF15832FFF14822FFF13822EFF1181 2CFF10802CFF0F7F2AFF0E7E29FF0E7D29FF0D7D28FF0D7C28FF0E7C28FF0E7B 28FF0F7B29FF0F7B29FF00000000000000000000000000000000000000000000 00000000000000000000178432FF168431FF168431FF148430FF14832FFF1382 2EFF12812DFF10802CFF10802BFF0F7F2AFF0F7E2AFF0F7D2AFF0F7D2AFF0F7C 2AFF107C2AFF107C2BFF00000000000000000000000000000000000000000000 0000000000000000000000000000178532FF168531FF158531FF14842FFF1483 2FFF13832EFF12822DFF11812CFF11802CFF117F2CFF107F2BFF117E2CFF117E 2CFF127D2CFF127D2CFF00000000000000000000000000000000000000000000 000000000000000000000000000000000000178532FF168531FF158530FF1584 30FF14832FFF13832EFF13822EFF13812EFF12802DFF13802DFF137F2DFF137F 2DFF137E2DFF147E2EFF00000000000000000000000000000000000000000000 00000000000000000000000000000000000000000000178632FF168531FF1685 31FF158430FF0000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000178632FF1785 32FF168531FF0000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000001885 32FF178532FF0000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000188432FF0000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000 } OnClick = SpeedLeftClick ShowHint = True ParentShowHint = False end object SpeedRight: TSpeedButton AnchorSideLeft.Control = SpeedLeft AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = EditFind AnchorSideBottom.Control = EditFind AnchorSideBottom.Side = asrBottom Left = 172 Height = 29 Top = 5 Width = 28 Anchors = [akTop, akLeft, akBottom] Glyph.Data = { 36090000424D3609000000000000360000002800000018000000180000000100 2000000000000009000064000000640000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00000000000000000000000000000D7A27FF0000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00000000000000000000000000000C7926FF0B7926FF00000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00000000000000000000000000000B7926FF0A7925FF0A7825FF000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00000000000000000000000000000B7A26FF0A7925FF0A7925FF097824FF0000 0000000000000000000000000000000000000000000000000000000000000000 00000000000000000000168030FF15802FFF147F2EFF127F2DFF117E2CFF0F7E 2AFF0E7D29FF0D7C28FF0C7B27FF0B7B26FF0A7A25FF0A7925FF0A7925FF0A79 25FF000000000000000000000000000000000000000000000000000000000000 00000000000000000000168130FF15812FFF14802FFF13802DFF117F2CFF107F 2BFF0F7E2AFF0E7D29FF0D7C28FF0C7B27FF0B7B26FF0B7A26FF0A7A26FF0B79 26FF0B7926FF0000000000000000000000000000000000000000000000000000 00000000000000000000168231FF168230FF14822FFF14812EFF12812DFF1180 2CFF107F2BFF0F7E2AFF0D7E29FF0D7D28FF0C7C27FF0C7B27FF0B7B27FF0C7A 27FF0C7A27FF0D7A27FF00000000000000000000000000000000000000000000 00000000000000000000178331FF168331FF158330FF14822FFF13822EFF1281 2DFF11812CFF10802BFF0F7F2AFF0E7E2AFF0E7D29FF0D7C28FF0D7C28FF0D7B 28FF0E7B28FF0E7B29FF0F7B2AFF000000000000000000000000000000000000 00000000000000000000178432FF178431FF168431FF158430FF14832FFF1383 2EFF12822EFF12812DFF11802CFF107F2BFF0F7F2BFF0F7E2AFF0F7D2AFF0F7C 2AFF0F7C2AFF107C2AFF00000000000000000000000000000000000000000000 00000000000000000000178432FF178532FF178531FF168531FF158430FF1484 2FFF14832FFF13832EFF12822DFF12812DFF11802CFF117F2CFF117E2CFF117D 2BFF117D2BFF0000000000000000000000000000000000000000000000000000 00000000000000000000188533FF188532FF178532FF168531FF168531FF1585 30FF158430FF148430FF14832FFF13822EFF13812EFF13802DFF137F2DFF137E 2DFF000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000014832FFF15822FFF14812FFF14802FFF0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000168331FF168230FF168130FF000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000178331FF178331FF00000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000188332FF0000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000 } OnClick = SpeedRightClick ShowHint = True ParentShowHint = False end object BitBtnCloseFind: TBitBtn AnchorSideTop.Control = PanelFind AnchorSideRight.Control = PanelFind AnchorSideRight.Side = asrBottom Left = 760 Height = 22 Top = 2 Width = 22 Anchors = [akTop, akRight] Glyph.Data = { 36040000424D3604000000000000360000002800000010000000100000000100 2000000000000004000064000000640000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000500B6690500B669000000000000000000000000000000000000 0000000000000500B6690500B669000000000000000000000000000000000000 00000200B5680C00CFE90D00D0EB0500B66D0000000000000000000000000000 00000200B56B0C00CFE90D00D0EB0500B86B0000000000000000000000000000 00000200B5680C00CFE91400E6FF0D00D0EB0500B66D00000000000000000200 B56B0C00CFE91400E6FF0D00D0EB0500B86B0000000000000000000000000000 0000000000000300B7660C00CFE91400E6FF0D00D1EB0500B66D0300B6650C00 CFE91400E6FF0D00D1EB0500B66D000000000000000000000000000000000000 000000000000000000000500B66C0C00CFEA1400E6FF0C00D0EA0C00D0EA1400 E6FF0C00CFEA0500B66C00000000000000000000000000000000000000000000 00000000000000000000000000000200B56B0C00D0E81400E6FF1400E6FF0D00 D0EB0500B66D0000000000000000000000000000000000000000000000000000 00000000000000000000000000000200B56B0C00D0E81400E6FF1400E6FF0D00 D0EB0500B66D0000000000000000000000000000000000000000000000000000 000000000000000000000500B66C0C00CFEA1400E6FF0C00D0EA0C00D0EA1400 E6FF0C00CFEA0500B66C00000000000000000000000000000000000000000000 0000000000000300B6650C00CFE91400E6FF0D00D1EB0500B66D0300B7660C00 CFE91400E6FF0D00D1EB0500B66D000000000000000000000000000000000000 00000200B5680C00CFE91400E6FF0D00D0EB0500B66D00000000000000000200 B56B0C00CFE91400E6FF0D00D0EB0500B86B0000000000000000000000000000 00000200B5680C00CFE90D00D0EB0500B66D0000000000000000000000000000 00000200B56B0C00CFE90D00D0EB0500B86B0000000000000000000000000000 0000000000000500B66C0500B66C000000000000000000000000000000000000 0000000000000500B6690500B669000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000 } OnClick = BitBtnCloseFindClick TabOrder = 1 end end object Panel1: TPanel AnchorSideLeft.Control = Owner AnchorSideTop.Control = Owner AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom Left = 0 Height = 40 Top = 0 Width = 784 Anchors = [akTop, akLeft, akRight] ClientHeight = 40 ClientWidth = 784 TabOrder = 3 object SpeedButtonNotebook: TSpeedButton AnchorSideLeft.Control = SpeedButtonDelete AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = Panel1 Left = 295 Height = 38 Hint = 'Manage Notebooks' Top = 1 Width = 38 Glyph.Data = { 36090000424D3609000000000000360000002800000018000000180000000100 2000000000000009000064000000640000000000000000000000FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00AA55 0003A05C2E74A05A2BD4A15B2DD49F592C7555550003FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B273475DAF70 4559AD6D401CFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00A6593314A660 33A4A35E31FFAD6231FEAC612FFEA05A2CFFA05A2CA4A6593314FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF009B5B2E1CA05C2E599F582C5DB5754BFBB474 49FFB27247FFB27045EDAF6D42C6AE6C41AAAC693EB8AB693CCCAA663AFCA865 38FFBA7140FFCC7D48FFCB7C47FFB76D3CFFA15B2DFFA05A2DFCA05A2CCD9F5A 2CB8A15A2DAAA15A2CC6A05A2CECA05A2CFFA05A2CFFA05A2CFBB97A50F3BE7C 50FFC58053FFBE7B4EFFBA774BFEB67448FCB57347FDB87447FFBD784AFFC983 53FFCF8A5BFFD0B4A1FFD1B5A2FFD08A5BFFC88151FFB87243FFAE6839FFAA64 36FEA96334FBAD6537FEB46D3EFFBB7445FFAF693AFFA05B2CF2BB7D54E9C384 5AFFE0B395FFDAA583FFD39469FFD39369FFD49469FFD49469FFD4956DFFDAB0 94FFDCD2CCFFD2D2D2FFD2D2D2FFDCD2CBFFDAAF93FFD4976DFFD49469FFD393 69FFD39469FFD5956AFFDAA583FFE0B395FFB47144FFA25B2DE8BE8157DBC68A 63FFF3E2D6FFFFFFFFFFFCF7F4FFF5E8DFFFF4E5DBFFF6EAE2FFF3F0EEFFE8E8 E8FFDDDDDDFFD2D2D2FFD2D2D2FFDDDDDDFFE9E9E9FFF2EFEDFFF6E9E1FFF5E6 DCFFF5E8DFFFFCF7F4FFFFFFFFFFF3E1D6FFB37247FFA15B2DDBC0855CCFC78E 68FFF1E0D4FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF3F3F3FFE9E9 E9FFDDDDDDFFD2D2D2FFD1D1D1FFDDDDDDFFE8E8E8FFF4F4F4FFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFF2E0D4FFB17147FFA15A2ECEC38760C0C992 6CFEF1E0D5FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF4F4F4FFE7E7 E7FFD9D9D9FFD2D2D2FFD2D2D2FFDDDDDDFFE9E9E9FFF3F3F3FFFFFFFFFFFFFF FFFFFFFFFFFFF8F8F8FFFEFEFEFFF2E0D5FFB2734AFEA15C2EC0C68B65B4CB94 71FDF2E2D7FFE6E6E6FFA0A0A0FFBEBEBEFFCBCBCBFFCCCCCCFFB4B4B4FF8B8B 8BFFAAAAAAFFD1D1D1FFD2D2D2FFB7B7B7FFA1A1A1FFBCBCBCFFCECECEFFC8C8 C8FFB1B1B1FF868686FFD9D9D9FFF1E1D7FFB1744CFDA55F33B3CA9069A8CC96 72FBF1E4DBFFF3F3F3FFCBCBCBFFAFAFAFFFA4A4A4FFA4A4A4FFAFAFAFFFC7C7 C7FFDCDCDCFFD2D2D2FFD1D1D1FFCDCDCDFFB7B7B7FFA8A8A8FFA2A2A2FFA7A7 A7FFBABABAFFE5E5E5FFFFFFFFFFF0E3DAFFB1744BFBA66335A7CC926D9BCD97 73FBF3E8E1FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF4F4F4FFE7E7 E7FFD9D9D9FFD2D2D2FFD2D2D2FFDDDDDDFFE9E9E9FFF4F4F4FFFFFFFFFFFFFF FFFFFFFFFFFFF8F8F8FFFEFEFEFFF3E8E1FFB17349FBAB683C9ACF98728FCE98 73FCF4EEEAFFE6E6E6FFA0A0A0FFBEBEBEFFCBCBCBFFCCCCCCFFB4B4B4FF8B8B 8BFFAAAAAAFFD2D2D2FFD1D1D1FFB7B7B7FFA1A1A1FFBCBCBCFFCECECEFFC8C8 C8FFB1B1B1FF868686FFD9D9D9FFF4EEEAFFB17148FCAC6A3F8ED29A7583D099 73FEF5F4F3FFF3F3F3FFCBCBCBFFAFAFAFFFA4A4A4FFA4A4A4FFAFAFAFFFC7C7 C7FFDBDBDBFFD2D2D2FFD1D1D1FFCDCDCDFFB7B7B7FFA8A8A8FFA2A2A2FFA7A7 A7FFBABABAFFE5E5E5FFFFFFFFFFF5F4F2FFB27146FEB16E4382D59D7978D39C 77FFF4F3F2FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF3F3F3FFE7E7 E7FFD9D9D9FFD2D2D2FFD2D2D2FFDDDDDDFFE8E8E8FFF4F4F4FFFFFFFFFFFFFF FFFFFFFFFFFFF8F8F8FFFEFEFEFFF4F1F0FFB37349FFB4744977D6A27E6BD6A0 7BFFF1EEECFFE6E6E6FFA0A0A0FFBEBEBEFFCBCBCBFFCBCBCBFFB4B4B4FF8B8B 8BFFAAAAAAFFD2D2D2FFD1D1D1FFB7B7B7FFA1A1A1FFBCBCBCFFCECECEFFC8C8 C8FFB1B1B1FF868686FFD9D9D9FFF0ECE9FFB7774DFFB4764B6AD9A4815FD8A2 7EFFF1EBE6FFF3F3F3FFCBCBCBFFAFAFAFFFA4A4A4FFA4A4A4FFAFAFAFFFC7C7 C7FFDCDCDCFFD1D1D1FFD2D2D2FFCDCDCDFFB7B7B7FFA8A8A8FFA2A2A2FFA7A7 A7FFBABABAFFE5E5E5FFFFFFFFFFEDE6E1FFBA7B52FFB87A4F5EDDA98453DCA7 83FFEFE5DFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF3F3F3FFE9E9 E9FFDDDDDDFFD9D9D9FFD9D9D9FFDDDDDDFFE8E8E8FFF4F4F4FFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFE8DED6FFBC7E55FFBB7C5452DEA88746DEAA 87FFE9D2C3FFF7F6F6FFFAFAFAFFFCFCFCFFFEFEFEFFFEFEFEFFF4F4F4FFEBEB EBFFEAE7E5FFDEBFAAFFDEBFAAFFEAE7E6FFEBEBEBFFF3F3F3FFFEFEFEFFFEFE FEFFFCFCFCFFFAFAFAFFF7F6F6FFDDC3B1FFBF825AFFBD805746E8AE8B16DEAA 89D6DEAA87FFE1B294FCE6C8B5FFEAD8CBFFECDDD4FFEADBD1FFE7D1C2FFDFBB A3FFD59F7BFDD29B76FDD09973FCD19B77FDDCB9A2FFE5D0C2FFE9DBD2FFE8DA D1FFE4D1C4FFDABAA4FFC99672FCC48860FFC2875FD6C58B5D16FFFFFF00FF80 8002DEA88755DEAA88B4DEAA87F9DEAA87FFDCA884FFDBA783FFDAA481FFD9A3 80E8D7A07C94D99F7928D29F772DD29B769ED19A75F2D09772FFCE956FFFCD94 6DFFCA916AFFC99069FAC88F68B6C68A635580800002FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFBF8004E0AE8929DCA9863BDCAB883ADCA7841DFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0080800002D39B7629D0997241CE96 7144CE926D2FD5AA8006FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 } OnClick = SpeedButtonNotebookClick ShowCaption = False ShowHint = True ParentShowHint = False end object SpeedRollBack: TSpeedButton AnchorSideLeft.Control = SpeedButtonNotebook AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = Panel1 Left = 333 Height = 38 Hint = 'Roll Back' Top = 1 Width = 38 Glyph.Data = { 36090000424D3609000000000000360000002800000018000000180000000100 2000000000000009000064000000640000000000000000000000FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00D4A90065D4AA00F9D4AA00FFD4AA00FFD4AA 00FFD4AA00FFD4AA00FFD4AA00FFD4AA00FFD4AA00FFD4AA00FFD4AA00F4D5AA 00D2D5AA008AD7A70020FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00D3A9009ED4AA00FFD4AA00FFD4AA00FFD4AA 00FFD4AA00FFD4AA00FFD4AA00FFD4AA00FFD4AA00FFD4AA00FFD4AA00FFD4AA 00FFD4AA00FFD4AA00F8D4AB0076FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00D2A50011D3A90062D5AA0066D5AA0066D5AA 0066D5AA0066D5AA0066D5AA0066D5AA0066D5AA0066D5AA0066D5AB0079D4AA 00ABD4AA00F8D4AA00FFD4AA00FFD4AA008DFFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00D1AA0021D4AA00C9D4AA00FFD4AA00FFD3AA0051FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00CFAF0010D4AA00DDD4AA00FFD4AA00D9FFFF0001FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00D4A90059D4AA00FFD4AA00FFD3AC0034FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00D1A2000BD4AA00FDD4AA00FFD3A90068FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFF0001D3AC002ECC990005FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00D4AA00EED4AA00FFD4A9007DFFFFFF00FFFF FF00FFFFFF00FFFFFF00BFBF0004D3AB00A9D4AA00FFD4AB009AFFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00D1A2000BD4AA00FDD4AA00FFD3AA0069FFFFFF00FFFF FF00FFFFFF00BFBF0004D4AA00AAD4AA00FFD4AA00FFD4AB0094FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00D3AA0057D4AA00FFD4AA00FFD4A80035FFFFFF00FFFF FF00AAAA0003D4AA00A5D4AA00FFD4AA00FFD4AA00B8DF9F0008FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00CCAA000FD4AA00DBD4AA00FFD4AA00DAFFFF0001FFFFFF00AAAA 0003D4AA00A5D4AA00FFD4AA00FFD4AA00B8DF9F0008FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00D7A70020D4AA00C8D4AA00FFD4AA00FFD4A90053FFFFFF00BFBF0004D4AA 00ABD4AA00FFD4AA00FFD3AA00D3D6AB006AD5AA0066D5AA0066D5AA0066D5AA 0066D5AA0066D5AA0066D5AA0066D5AA0066D5AA0066D5AA0066D4A90077D3AB 00A9D4AA00F7D4AA00FFD4AA00FFD5AA0090FFFFFF00FFFFFF00D5AA0066D4AA 00FFD4AA00FFD4AA00FFD4AA00FFD4AA00FFD4AA00FFD4AA00FFD4AA00FFD4AA 00FFD4AA00FFD4AA00FFD4AA00FFD4AA00FFD4AA00FFD4AA00FFD4AA00FFD4AA 00FFD4AA00FFD4AA00F9D5AB0079FFFF0001FFFFFF00FFFFFF00D5AB003DD5AA 00FCD4AA00FFD4AA00FFD4AA00FFD4AA00FFD4AA00FFD4AA00FFD4AA00FFD4AA 00FFD4AA00FFD4AA00FFD4AA00FFD4AA00FFD4AA00FFD4AA00FFD4AA00F4D5AA 00D2D5AB008BD2AD0022FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D5AA 0054D4AA00FAD4AA00FFD4AA00EED2AA0033FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00D5AA0054D4AA00FAD4AA00FFD4AA00EED2AA0033FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00D5AB0055D4AA00FBD4AA00FFD4AA00EBD2AA002DFFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00D5AB0055D4AA00FBD4AA00FFD4AA00B3FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00D3AA0051D4AA00D1D5AA005AFFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 } OnClick = SpeedRollBackClick ShowCaption = False ShowHint = True ParentShowHint = False end object SpeedButtonDelete: TSpeedButton AnchorSideLeft.Control = SpeedButtonTools AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = Panel1 Left = 257 Height = 38 Hint = 'Delete this note' Top = 1 Width = 38 Glyph.Data = { 36090000424D3609000000000000360000002800000018000000180000000100 2000000000000009000064000000640000000000000000000000FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF80 0002D6AD0019D6A80032D6A80032D6AD0019FF800002FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D5AB0049D5AA00A2D4AA 00EDD4AA00FFD4AA00FFD4AA00FFD4AA00FFD4AA00EDD5AA00A2D5AA0048FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00D4A8002FD3AA00C1D4AA00FFD4AA00FFD4AA 00FFD4AA00FFD4AA00FFD4AA00FFD4AA00FFD4AA00FFD4AA00FFD4AA00FFD5AA 00C0D3AC002EFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00D3A90056D4AA00F5D4AA00FFD4AA00FFD3AA00BBD4A9 0065D3A80029D5AA000CD5AA000CD3A80029D5AA0066D4AA00BCD4AA00FFD4AA 00FFD4AA00F5D3A90056FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00D3A90056D4AA00FED4AA00FFD4AA00DAD2AA003FFFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D3AB0040D4AA 00DBD4AA00FFD4AA00FED3A90056FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00D4A8002FD4AA00F5D4AA00FFD3AA00C1D2A50011FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D5AA 0012D4AA00C2D4AA00FFD4AA00F5D3AC002EFFFFFF00FFFFFF00FFFFFF00FFFF FF00D4AA00BED4AA00FFD5AA00DED9A60014FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00D2A50011D4AA00DAD4AA00FFD3AA00C1FFFFFF00FFFFFF00FFFFFF00D5AB 0049D4AA00FFD4AA00FFD6A9003EFFFFFF00FFFFFF00D4AA0093D5AA00DED5AB 003DFFFFFF00FFFFFF00FFFFFF00FFFFFF00D5AB003DD5AA00DED4AA0093FFFF FF00FFFFFF00D3AB0040D4AA00FFD4AA00FFD5AA0048FFFFFF00FFFFFF00D5AB 00A3D4AA00FFD3AA00BBFFFFFF00FFFFFF00FFFFFF00D5AA00DED4AA00FFD4AA 00F3D5AB003DFFFFFF00FFFFFF00D5AB003DD4AA00F3D4AA00FFD5AA00DEFFFF FF00FFFFFF00FFFFFF00D4AA00BCD4AA00FFD5AA00A2FFFFFF00AAAA0003D4AA 00EED4AA00FFD4AB0064FFFFFF00FFFFFF00FFFFFF00D5AB003DD4AA00F3D4AA 00FFD4AA00F3D5AB003DD5AB003DD4AA00F3D4AA00FFD4AA00F3D5AB003DFFFF FF00FFFFFF00FFFFFF00D5AA0066D4AA00FFD4AA00ECFF800002D8A7001AD4AA 00FFD4AA00FFD1AA0027FFFFFF00FFFFFF00FFFFFF00FFFFFF00D4A9003BD4AA 00F2D4AA00FFD5AA00F7D4AA00F5D4AA00FFD4AA00F5D4A90041FFFFFF00FFFF FF00FFFFFF00FFFFFF00D2AC0028D4AA00FFD4AA00FFD5AA0018D2AA0033D4AA 00FFD4AA00FFD5AA000CFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D4A9 003BD3AA00F5D4AA00FFD4AA00FFD4A900F8D4A90041FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00DBA4000ED4AA00FFD4AA00FFD5AC0031D3AC0034D4AA 00FFD4AA00FFD5AA000CFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D4A9 003BD3AA00F5D4AA00FFD4AA00FFD4AA00F8D4A90041FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00D5AA000CD4AA00FFD4AA00FFD2AA0033D8A7001AD4AA 00FFD4AA00FFD1AA0027FFFFFF00FFFFFF00FFFFFF00FFFFFF00D4A9003BD4AA 00F2D4AA00FFD5A900F7D4AA00F5D4AA00FFD4AA00F5D4A90041FFFFFF00FFFF FF00FFFFFF00FFFFFF00D2AC0028D4AA00FFD4AA00FFD5AA0018AAAA0003D4AA 00EED4AA00FFD4AB0064FFFFFF00FFFFFF00FFFFFF00D5AB003DD4AA00F3D4AA 00FFD4AA00F3D5AB003DD5AB003DD4AA00F3D4AA00FFD4AA00F3D5AB003DFFFF FF00FFFFFF00FFFFFF00D5AA0066D4AA00FFD4AA00EDFF800002FFFFFF00D3A9 00A4D4AA00FFD5AA00BAFFFFFF00FFFFFF00FFFFFF00D5AA00DED4AA00FFD4AA 00F3D5AB003DFFFFFF00FFFFFF00D5AB003DD4AA00F3D4AA00FFD5AA00DEFFFF FF00FFFFFF00FFFFFF00D3AA00BBD4AA00FFD5AA00A2FFFFFF00FFFFFF00D6A9 004AD4AA00FFD4AA00FFD5AB003DFFFFFF00FFFFFF00D4AA0093D5AA00DED5AB 003DFFFFFF00FFFFFF00FFFFFF00FFFFFF00D5AB003DD5AA00DED4AA0093FFFF FF00FFFFFF00D2AA003FD4AA00FFD4AA00FFD5AB0049FFFFFF00FFFFFF00FFFF FF00D4AA00C3D4AA00FFD5AA00D8D2A50011FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00D2A50011D4AA00DAD4AA00FFD4AA00C2FFFFFF00FFFFFF00FFFFFF00FFFF FF00D5AA0030D5AA00F6D4AA00FFD3AA00C1D2A50011FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D2A5 0011D3AA00C1D4AA00FFD4AA00F5D4A8002FFFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00D3AA0057D4AA00FED4AA00FFD4AA00D9D5AB003DFFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D6A9003ED4AA 00DAD4AA00FFD4AA00FED3A90056FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00D3AA0057D5AA00F6D4AA00FFD4AA00FFD5AA00BAD4AB 0064D1AA0027D1A2000BD1A2000BD1AA0027D4AB0064D3AA00BBD4AA00FFD4AA 00FFD4AA00F5D3A90056FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00D5AC0031D4AA00C3D4AA00FFD4AA00FFD4AA 00FFD4AA00FFD4AA00FFD4AA00FFD4AA00FFD4AA00FFD4AA00FFD4AA00FFD4AA 00C2D4A8002FFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D6A9004AD3A900A4D4AA 00EED4AA00FFD4AA00FFD4AA00FFD4AA00FFD4AA00EED3A900A4D5AB0049FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00AAAA 0003D8A7001AD2AA0033D2AA0033D6AD0019AAAA0003FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 } OnClick = SpeedButtonDeleteClick ShowHint = True ParentShowHint = False end object SpeedButtonTools: TSpeedButton AnchorSideLeft.Control = SpeedButtonText AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = Panel1 Left = 219 Height = 38 Hint = 'Tools - Sync, Export, Spell' Top = 1 Width = 38 Glyph.Data = { 36090000424D3609000000000000360000002800000018000000180000000100 2000000000000009000064000000640000000000000000000000FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D2AD0022D4AB0088D3A9 0062FFFFFF00FFFFFF00FFFFFF00FFFFFF00D3A90062D4AB0088D2AD0022FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00D8A7001AD5AA00B4D4AA00FDD4AA00FFD4AA 00F8D2AD0022FFFFFF00FFFFFF00D1AA0021D4AA00F8D4AA00FFD4AA00FDD5AA 00B4D8A7001AFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00D3AA0045D4AA00FFD4AB00A0D2AA0033D4AA 00F3D4AA00ABFFFFFF00FFFFFF00D4AA00ABD4AA00F3D3AC0034D4AB00A0D4AA 00FFD3AA0045FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00CCB3000AD4AA00F7D5AB008BFFFFFF00D4AB 007CD4AA00FFD3A9007AD3A9007AD4AA00FFD4AB007CFFFFFF00D5AB008BD4AA 00F7CCB3000AFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D3AA00BBD4AA00D1FFFFFF00C6AA 0009D4AA00DDD4AA00FFD4AA00FFD5AA00DEC6AA0009FFFFFF00D4AA00D1D3AA 00BBFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D8A7 001AD3AA0045CCB3000AFFFFFF00FFFFFF00D4AA0093D4AA00FED9A60014FFFF FF00DF9F0008D2AD0022D2AD0022CCB3000AFFFFFF00D9A60014D4AA00FED4AA 0093FFFFFF00FFFFFF00CCB3000AD3AA0045D8A7001AFFFFFF00FFFFFF00D3AA 00B5D4AA00FFD4AA00F7D3AA00BBD4AB0094D4AA00FDD4AA00B7BFBF0004FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00BFBF0004D4AA00B7D4AA 00FDD4AB0094D3AA00BBD4AA00F7D4AA00FFD3AA00B5FFFFFF00D2AD0022D4AA 00FDD4AB00A0D5AB008BD4AA00D1D4AA00FFD4AA00B7DF9F0008FFFFFF00FFFF FF00D5AA0036D4A90071D5AA0066D3AC002EFFFFFF00FFFFFF00DF9F0008D4AA 00B7D4AA00FFD4AA00D1D5AB008BD4AB00A0D4AA00FDD2AD0022D4AA0087D4AA 00FFD3AC0034FFFFFF00FFFFFF00CEAA0015FF800002FFFFFF00CCAA000FD5AA 00B4D4AA00FFD4AA00FFD4AA00FFD4AA00FFD5AA00A2DBA4000EFFFFFF00FF80 0002CEAA0015FFFFFF00FFFFFF00D3AC0034D4AA00FFD4AA0087D3AA0063D4AA 00F8D4AA00F3D4AB007CC6AA0009FFFFFF00FFFFFF00FFFFFF00D3A900A4D4AA 00F8D3AA006FD5AA0012D8A7001AD5AB0079D4AA00F9D4AA00B2FFFFFF00FFFF FF00FFFFFF00C6AA0009D4AB007CD4AA00F3D4AA00F8D3AA0063FFFFFF00D1AA 0021D4AA00ABD4AA00FFD4AA00DCC6AA0009FFFFFF00D5AA0030D4AA00FFD4AB 0076FFFFFF00FFFFFF00FFFFFF00FFFFFF00D4AB0070D4AA00FFD5AA0036FFFF FF00C6AA0009D4AA00DCD4AA00FFD4AA00ABD1AA0021FFFFFF00FFFFFF00FFFF FF00FFFFFF00D5AB0079D4AA00FFD0AA001BFFFFFF00D3AA0069D4AA00FFD5AA 0018FFFFFF00FFFFFF00FFFFFF00FFFFFF00D7AE0013D4AA00FFD4A90071FFFF FF00D8A7001AD4AA00FFD3A9007AFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00D3A9007AD4AA00FFD8A7001AFFFFFF00D3A90074D4AA00FFCFAF 0010FFFFFF00FFFFFF00FFFFFF00FFFFFF00D6AD0019D4AA00FFD5AA0066FFFF FF00D0AA001BD4AA00FFD5AB0079FFFFFF00FFFFFF00FFFFFF00FFFFFF00D1AA 0021D4AA00ABD4AA00FFD4AA00DCC6AA0009FFFFFF00D5AC0037D4AA00FFD5AB 006DFFFFFF00FFFFFF00FFFFFF00FFFFFF00D4A90077D4AA00FFD3AC002EFFFF FF00C6AA0009D4AA00DCD4AA00FFD4AA00ABD1AA0021FFFFFF00D3AA0063D4AA 00F8D4AA00F3D4AB007CC6AA0009FFFFFF00FFFFFF00FFFFFF00D4AA00B6D4AA 00F8D3AA0075D3A60017CFAF0010D3A9006ED4AA00F8D5AB00A3FFFFFF00FFFF FF00FFFFFF00C6AA0009D4AB007CD4AA00F3D4AA00F8D3AA0063D4AA0087D4AA 00FFD3AC0034FFFFFF00FFFFFF00CEAA0015FF800002FFFFFF00CFAF0010D4AB 00A6D4AA00FFD4AA00FFD4AA00FFD4AA00FFD3AA00B5CCAA000FFFFFFF00FF80 0002CEAA0015FFFFFF00FFFFFF00D3AC0034D4AA00FFD4AA0087D2AD0022D4AA 00FDD4AB00A0D5AB008BD4AA00D1D4AA00FFD4AA00B7DF9F0008FFFFFF00FFFF FF00D5AA0030D3AA0069D3A90074D5AC0037FFFFFF00FFFFFF00DF9F0008D4AA 00B7D4AA00FFD4AA00D1D5AB008BD4AB00A0D4AA00FDD2AD0022FFFFFF00D3AA 00B5D4AA00FFD4AA00F7D3AA00BBD4AB0094D4AA00FDD4AA00B7BFBF0004FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00BFBF0004D4AA00B7D4AA 00FDD4AB0094D3AA00BBD4AA00F7D4AA00FFD3AA00B5FFFFFF00FFFFFF00D8A7 001AD3AA0045CCB3000AFFFFFF00FFFFFF00D4AA0093D4AA00FED9A60014FFFF FF00CCB3000AD2AD0022D2AD0022DF9F0008FFFFFF00D9A60014D4AA00FED4AA 0093FFFFFF00FFFFFF00CCB3000AD3AA0045D8A7001AFFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D3AA00BBD4AA00D1FFFFFF00C6AA 0009D5AA00DED4AA00FFD4AA00FFD4AA00DDC6AA0009FFFFFF00D4AA00D1D3AA 00BBFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00CCB3000AD4AA00F7D5AB008BFFFFFF00D4AB 007CD4AA00FFD3A9007AD3A9007AD4AA00FFD4AB007CFFFFFF00D5AB008BD4AA 00F7CCB3000AFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00D3AA0045D4AA00FFD4AB00A0D3AC0034D4AA 00F3D4AA00ABFFFFFF00FFFFFF00D4AA00ABD4AA00F3D2AA0033D4AB00A0D4AA 00FFD3AA0045FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00D8A7001AD5AA00B4D4AA00FDD4AA00FFD4AA 00F8D1AA0021FFFFFF00FFFFFF00D2AD0022D4AA00F8D4AA00FFD4AA00FDD5AA 00B4D8A7001AFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D2AD0022D4AB0088D3A9 0062FFFFFF00FFFFFF00FFFFFF00FFFFFF00D3A90062D4AB0088D2AD0022FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 } OnClick = SpeedButtonToolsClick ShowHint = True ParentShowHint = False end object SpeedButtonText: TSpeedButton AnchorSideLeft.Control = SpeedButtonLink AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = Panel1 Left = 181 Height = 38 Hint = 'Font size, bold, italics etc' Top = 1 Width = 38 Glyph.Data = { 36090000424D3609000000000000360000002800000018000000180000000100 2000000000000009000064000000640000000000000000000000FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D5AA 00BAD4AA00DDD6AC0025FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00D2AA0033D4AB009AD4AA00C3D5AA00D8D3AA00C1D5AA009CD5AA 0054DF9F0008D6AD0019D5AA0066D5AA0066D4A90065D4A8002FFFFFFF00D4AA 0081D4AA00FFD3A90080FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00D4AB0058D5AA00FCD4AA00FFD4AA00F4D4AA00DDD4AA00EFD4AA00FFD4AA 00FFD4AA00EDD5AA00CCD4AA00FFD4AA00FFD4AA00FFD4AA00D1FFFFFF00D5AA 0024D4AA00FED4AA00DCFFFF0001FFFFFF00FFFFFF00FFFFFF00FFFFFF00DBB6 0007D4AA00EED4AA00F8D3AA0057AAAA0003FFFFFF00FFFFFF00D5AA0024D3A9 0074D4AA00DCD4AA00FFD4AA00FFD3AA00BBD6A90050D7A70020FFFFFF00FFFF FF00D4AA00C8D4AA00FFD3AB003AFFFFFF00FFFFFF00FFFFFF00FFFFFF00D5AA 001ED4AA00FFD4AA00B7FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00D5AA0006D3A90092D4AA00FFD3A9007AFFFFFF00FFFFFF00FFFFFF00FFFF FF00D5AA006CD4AA00FFD5AA0096FFFFFF00FFFFFF00FFFFFF00FFFFFF00AAAA 0003D4AA00E6D4AA00ECD1AA0027FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00D5AB003DD4AA00FFD3A9007AFFFFFF00FFFFFF00FFFFFF00FFFF FF00CEAA0015D4AA00FAD4AA00EDDBB60007FFFFFF00FFFFFF00FFFFFF00FFFF FF00D5AA005AD4AA00FED4AA00EFD5AA007ED6A8002CD5AA0006FFFFFF00BFBF 0004D7A80026D4A90089D4AA00FFD3A9007AFFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00D4AA00B3D4AA00FFD3AB00A9D4AB0088D4AB0088D4AB0088D4AB 0088D2AC0028D3AA005DD4AA00F2D4AA00FFD4AA00FFD5AA00FCD4AA00F3D4AA 00FFD4AA00FFD4AA00FFD4AA00FFD3A9007AFFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00D3AA0057D4AA00FFD4AA00FFD4AA00FFD4AA00FFD4AA00FFD4AA 00FFD4AA00EFD5AB0055D7AE0013D4A9006BD4AB00A6D4AA00BDD4AA00C2D3AB 00A9D3A90092D4AA00B8D4AA00FFD3A9007AFFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00C6AA0009D4AA00F1D4AA00FFD4A90089D5AB0055D5AB0055D5AB 0055D5AB0055D5AB0055D1AA0027FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00D6A9003ED4AA00FFD5AB0079FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00D3A9009ED4AA00FFD3AA0063FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00D4A90077D4AA00FFD3AA0063FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00D5AA0042D4AA00FFD4AA00BEFFFFFF00FFFFFF00FFFF FF00FFFFFF00D5AB0079D3AA00D3D4AB00A6D4A90071D4A9004DD4A9003BD3AA 0045D4A90089D4AA00F9D5AA00F0D1AE0016FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FF800002D4AA00E2D4AA00FDD3A7001DFFFFFF00FFFF FF00FFFFFF00D3A90062D4AA00E2D4AA00FFD4AA00FFD4AA00FFD4AA00FFD4AA 00FFD4AA00FFD4AA00DDD2AA0039FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00D4A90089D4AA00FFD4AB0076FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00D0AA001BD3AB004CD4A9006BD5AB0079D4AB 0070D3AB0040AAAA0003FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00D2AA002DD4AA00FFD5AA00D2FFFFFF00FFFF FF00FFFFFF00FFFFFF00D4AA00C9D3AA00CDD9A60014FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D4AA00D0D4AA00FFD3AC002EFFFF FF00FFFFFF00D5AA002AD4AA00FFD4AA00CFFFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D3A90074D4AA00FFD4A90089FFFF FF00FFFFFF00D4AB0088D4AA00FFD5AB0073FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D8A7001AD5AA00FCD4AA00E5AAAA 0003FF800002D4AA00E2D4AA00FDD0AA001BFFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D3AA00BBD4AA00FFD4A9 0041D4A90041D4AA00FFD5AA00BAFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D4AB005ED4AA00FFD5AA 00C0D3AA00C1D4AA00FFD4AB005EFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D1A2000BD4AA00F4D4AA 00FFD4AA00FFD4AA00F5D8B1000DFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D4AB00A6D4AA 00FFD4AA00FFD4AA00A5FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D3AA0045D4AA 00DDD4AA00DDD3AA0045FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 } OnClick = SpeedButtonTextClick ShowHint = True ParentShowHint = False end object SpeedButtonLink: TSpeedButton AnchorSideLeft.Control = SpeedButtonSearch AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = Panel1 Left = 143 Height = 38 Hint = 'Create new linked note (text selected) or display Backlinks.' Top = 1 Width = 38 Glyph.Data = { 36090000424D3609000000000000360000002800000018000000180000000100 2000000000000009000064000000640000000000000000000000FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D5AA005AD4AA 00CFD4AA00F2D4AA00C5D5AA0042FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D5AA0066D4AA00FFD4AA 00B3D3AA007BD4AA00C4D4AA00FDD5AA0042FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF0001D5AA00EAD4A900A1FFFF FF00FFFFFF00FF800002D4AA00C4D4AA00C5FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D5AA0018D4AA00FFD3A90056FFFF FF00FFFFFF00FFFFFF00D3AA007BD4AA00F2FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D6AA0045D4AA00F9D4AA008DFFFF FF00FFFFFF00FFFFFF00D4AA00B3D4AA00CFFFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00D6A90044D4AA00C3D4AA00FFD3AB00E9D5AA00FCD4AA 008DD3A90056D4AB00A0D4AA00FFD5AB005BFFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00CC990005D4AB0058D4A90083D5AB0061D8B1000DFFFFFF00FFFF FF00D5AA003CD4AA00BDD4AA00FFD4AA00D5D4AB005EB6B60007D3A90080D4AA 00F3D4AA00FFD5AA00EAD5AA0066FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00D5AA0012D4AA00CED4AA00FFD4AA00E8D4AA00FDD5AA00DED4A80058D4AA 00BDD4AA00FFD4AA00D5D4AB005EAAAA0003FFFFFF00FFFFFF00FFFFFF00FF80 0002D5AA0018FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00D5AA009CD4AA00EFD3AC0034FFFFFF00D3A80023D4A900DFD4AA00FAD3AA 00D3D3A90056FF800002FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00D4AA00E6D4AB0088FFFFFF00FFFFFF00FFFFFF00D4AB0064D4AA00FDDDAA 000FFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00D4AA00E6D4AB0088FFFFFF00FFFFFF00FFFFFF00D4AB0064D4AA00FDDDAA 000FFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00D5AB009DD4AA00EED6A80032FFFFFF00D2AD0022D3AA00DED3AA00FBD3AA 00D3D3A90056FF800002FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00D7AE0013D4AA00CFD4AA00FFD4AA00E7D4AA00FDD4AA00DFD6AB0058D4AA 00BDD4AA00FFD4AA00D5D4AB005EAAAA0003FFFFFF00FFFFFF00FFFFFF00FF80 0002D5AA0018FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00D5AA0006D5AA005AD5AA0084D3AA0063D8B1000DFFFFFF00FFFF FF00D5AA003CD4AA00BDD4AA00FFD4AA00D5D4AB005EB6B60007D5AB007FD4AA 00F2D4AA00FFD4AA00E9D4A90065FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00D6A90044D4AA00C3D4AA00FFD3AB00E9D5AA00FCD4AB 008ED3A90056D4A900A1D4AA00FFD5AA005AFFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D6AA0045D4AA00F9D4AA008DFFFF FF00FFFFFF00FFFFFF00D5AA00B4D4AA00CFFFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D5AA0018D4AA00FFD3A90056FFFF FF00FFFFFF00FFFFFF00D3AA007BD4AA00F2FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF0001D4AA00EBD4AA009FFFFF FF00FFFFFF00FF800002D4AA00C4D5AA00C6FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D3A90068D4AA00FFD4AA 00B1D3AA007BD4AA00C3D4AA00FED5AB0043FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D3A9005CD4AA 00D0D4AA00F3D5AA00C6D6A90044FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 } OnClick = SpeedButtonLinkClick ShowHint = True ParentShowHint = False end object SpeedButtonSearch: TSpeedButton AnchorSideLeft.Control = ButtMainTBMenu AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = Panel1 Left = 105 Height = 38 Hint = 'Search All Notes Ctrl-Shift-F' Top = 1 Width = 38 Glyph.Data = { 36090000424D3609000000000000360000002800000018000000180000000100 2000000000000009000064000000640000000000000000000000FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00D6AD0019D3A90056D6AD0019FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00D4A80035D4AA00EDD4AA00FFD4AA00ECD8A7001AFFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00D4A80035D4AA00EFD4AA00FFD4AA00FFD4AA00FFD3A90056FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D4A8 0035D4AA00EFD4AA00FFD4AA00FFD4AA00FFD4AA00EDD8A7001AFFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D6A80032D4AA 00EDD4AA00FFD4AA00FFD4AA00FFD5AA00F0D5AC0037FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D6A80032D4AA00EDD4AA 00FFD4AA00FFD4AA00FFD5AA00F0D5AC0037FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00D1A2000BD4A9006BD5AA00BAD4AA00E5D4AA 00F9D4AA00E5D5AA00BAD4AB006AD1A2000BD2AA0033D4AA00EFD4AA00FFD4AA 00FFD4AA00FFD4AA00EFD4A80035FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00D3A90056D4AA00E7D4AA00DCD5AB0085D4A9004DD3AB 003AD4A9004DD5AB0085D4AA00DCD4AA00E6D3AA00D7D4AA00FFD4AA00FFD4AA 00FFD4AA00EFD4A80035FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00D5AB0079D4AA00F8D3A9006EBFBF0004FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00CC990005D3AA006FD4AA00FDD4AA00FFD4AA00FFD4AA 00EFD4A80035FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00D3A90056D4AA00F8D4A90041FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D4A90065D4AA00FDD3AA00D7D2AA 0033FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D5AA 000CD4AA00E8D5AB006DFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D3AA006FD4AA00E6D1A2 000BFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D5AA 006CD4AA00DBBFBF0004FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00CC990005D4AA00DDD4AB 006AFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D3AA 00BBD4A90083FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D5AB0085D4AA 00B9FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D4AA 00E6D3AB004CFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D5AA004ED4AA 00E5FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D4AA 00F9D3AB003AFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D3AB003AD4AA 00F9FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D4AA 00E7D3AB004CFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D5AA004ED4AA 00E5FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D4AA 00BCD4AB0082FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D5AA0084D5AA 00BAFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D5AB 006DD4AA00DABFBF0004FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00BFBF0004D4AA00DCD4A9 006BFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D5AA 000CD4AA00E9D4A9006BFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D3A9006ED4AA00E7D1A2 000BFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00D3AA0057D4AA00F8D4A90041FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D4A90041D4AA00F8D5AB0055FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00D3A9007AD4AA00F8D4A9006BBFBF0004FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00BFBF0004D5AB006DD4AA00F8D5AB0079FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00D4AB0058D4AA00E9D4AA00DAD4AB0082D3AB004CD2AA 0039D3AB004CD4A90083D4AA00DBD4AA00E8D3A90056FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00D5AA000CD5AB006DD4AA00BCD4AA00E6D4AA 00FAD4AA00E6D4AA00BCD5AB006DD5AA000CFFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 } OnClick = SpeedButtonSearchClick ShowHint = True ParentShowHint = False end object ButtMainTBMenu: TSpeedButton AnchorSideLeft.Control = Panel1 AnchorSideTop.Control = Panel1 AnchorSideBottom.Control = SpeedButtonSearch AnchorSideBottom.Side = asrBottom Left = 1 Height = 38 Top = 1 Width = 104 Anchors = [akTop, akLeft, akBottom] Caption = 'Menu' Glyph.Data = { 36090000424D3609000000000000360000002800000018000000180000000100 2000000000000009000064000000640000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000003232 3238333333050000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00000000000000000000000000000000000000000000000000002E2E2E163636 36F93C3C3CF0393939863737371C000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00000000000000000000000000000000000000000000000000003737377D8080 80F6DEDEDEFF727272FA3A3A3ADC000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00000000000000000000000000003434348D34343440555555033D3D3DEBD9D9 D9FFFFFFFFFF777777F536363672000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00000000000000000000000000003E3E3EEB464646F53B3B3BEB595959F2FFFF FFFFEEEEEEFF3A3A3AF630303010000000000000000000000000000000000000 000000000000000000004D4D4DFF4D4D4DFF4D4D4DFF4D4D4DFF4D4D4DFF4D4D 4DFF4D4D4DFF4D4D4DFF4D4D4DFF3E3E3EFFE8E8E8FFCDCDCDFFCECECEFFFFFF FFFF9E9E9EFC3E3E3EB100000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFF474747FFEAEAEAFFFFFFFFFFFFFFFFFFFFFF FFFFACACACFC434343F5404040D0323232510000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFF454545FFEDEDEDFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFCFCFCFFF383838F9323232420000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFF000000FF000000FF000000FF0000 00FF000000FFFFFFFFFFFFFFFFFF414141FFF0F0F0FFFFFFFFFFFFFFFFFFFFFF FFFFD8D8D8FF3E3E3EF43333334B000000000000000000000000000000000000 000000000000000000004D4D4DFFFAFAFAFFFAFAFAFFFAFAFAFFFAFAFAFFFAFA FAFFFAFAFAFFFAFAFAFFFAFAFAFF3F3F3FFFF2F2F2FFFFFFFFFFFFFFFFFFD9D9 D9FF3E3E3EF53434344E00000000000000000000000000000000000000000000 000000000000000000004D4D4DFF4D4D4DFF4D4D4DFF4D4D4DFF4D4D4DFF4D4D 4DFF4D4D4DFF4D4D4DFF4D4D4DFF383838FFF5F5F5FFFFFFFFFFDBDBDBFF3E3E 3EF6353535570000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFAFAFAFFFAFAFAFFFAFAFAFFFAFAFAFFFAFA FAFFFAFAFAFFFAFAFAFFFAFAFAFF3A3A3AFFF8F8F8FFE0E0E0FF424242F53636 365A000000000000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFF000000FF000000FF000000FF0000 00FF000000FFFFFFFFFFFFFFFFFF383838FFDDDDDDFF424242FF3636365E0000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFF363636FF494949FF454545FF000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFF000000FF000000FF000000FF0000 00FFFFFFFFFFFFFFFFFFFFFFFFFF353535FFAEAEAEFF4D4D4DFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFDFDFDFFA9A9A9FFFFFFFFFF4D4D4DFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFF000000FF000000FF000000FF0000 00FF000000FF000000FFFFFFFFFFFFFFFFFFFFFFFFFF4D4D4DFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF4D4D4DFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFF000000FF000000FF000000FF0000 00FF000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF4D4D4DFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF4D4D4DFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFF4D4D4DFF4D4D4DFF4D4D4DFF4D4D4DFF4D4D 4DFF4D4D4DFF4D4D4DFF4D4D4DFF4D4D4DFF4D4D4DFF4D4D4DFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000 } OnClick = ButtMainTBMenuClick PopupMenu = PopupMainTBMenu end object SpeedClose: TSpeedButton AnchorSideTop.Control = Panel1 AnchorSideRight.Control = Panel1 AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = Panel1 AnchorSideBottom.Side = asrBottom Left = 735 Height = 38 Top = 1 Width = 48 Anchors = [akTop, akRight, akBottom] AutoSize = True Caption = 'Close' OnClick = SpeedCloseClick end object SpeedSymbol: TSpeedButton AnchorSideLeft.Control = SpeedRollBack AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = SpeedButtonSearch AnchorSideBottom.Control = SpeedButtonSearch AnchorSideBottom.Side = asrBottom Left = 371 Height = 38 Hint = 'Insert extended character or symbol' Top = 1 Width = 38 Anchors = [akTop, akLeft, akBottom] Glyph.Data = { 36090000424D3609000000000000360000002800000018000000180000000100 2000000000000009000064000000640000000000000000000000FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00AAAA0003AAAA0003FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00AAAA0003AAAA0003FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D3AA00B5D4AA00F2D3A9 007AFFFFFF00FFFFFF00FFFFFF00FFFFFF00D3A9007AD4AA00F2D3AA00B5FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D4AA0081D4AA00F1D4AA 00FFD4A90041FFFFFF00FFFFFF00D4A90041D4AA00FFD4AA00F1D4AA0081FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D5AB0067D4AA 00FFD4AB007CFFFFFF00FFFFFF00D4AB007CD4AA00FFD5AB0067FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D5AA0060D4AA 00FFD3A90080FFFFFF00FFFFFF00D3A90080D4AA00FFD5AA0060FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D5AA0060D4AA 00FFD3A90080FFFFFF00FFFFFF00D3A90080D4AA00FFD5AA0060FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D5AA0060D4AA 00FFD3A90080FFFFFF00FFFFFF00D3A90080D4AA00FFD5AA0060FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D5AA0060D4AA 00FFD3A90080FFFFFF00FFFFFF00D3A90080D4AA00FFD5AA0060FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D5AA0060D4AA 00FFD3A90080FFFFFF00FFFFFF00D3A90080D4AA00FFD5AA0060FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D5AA0060D4AA 00FFD3A90080FFFFFF00FFFFFF00D3A90080D4AA00FFD5AA0060FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D5AA0060D4AA 00FFD3A90080FFFFFF00FFFFFF00D3A90080D4AA00FFD5AA0060FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00D6AD0019D5AB0043FFFFFF00FFFFFF00D5AA0060D4AA 00FFD3A90080FFFFFF00FFFFFF00D3A90080D4AA00FFD5AA0060FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00D4AA009FD4AA00FFD5AA0030FFFFFF00D5AA0060D4AA 00FFD3A90080FFFFFF00FFFFFF00D3A90080D4AA00FFD5AA0060FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00D4AB006AD4AA00FFD4AA00F1D4AA00DDD3A900EAD4AA 00FFD4AA00EED4AA00DDD4AA00DDD4AA00EED4AA00FFD3A900EAD4AA00DDD4AA 00CFD3A9006EFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00AAAA0003D4AB008ED4AA00EFD4AA00FFD4AA00FFD4AA 00FFD4AA00FFD4AA00FFD4AA00FFD4AA00FFD4AA00FFD4AA00FFD4AA00FFD4AA 00FFD4AA00FFD5AA005AFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D5AA 0042D4AA00FFD4AB00A0FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF 0001D4AB0064D3A80029FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 } OnClick = SpeedSymbolClick ShowHint = True ParentShowHint = False end end object KMemo1: TKMemo AnchorSideLeft.Control = Owner AnchorSideTop.Control = Panel1 AnchorSideTop.Side = asrBottom AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = PanelReadOnly Left = 0 Height = 366 Top = 40 Width = 784 Anchors = [akTop, akLeft, akRight, akBottom] ContentPadding.Left = 5 ContentPadding.Top = 5 ContentPadding.Right = 5 ContentPadding.Bottom = 5 ParentFont = False ParentShowHint = False TabOrder = 0 Visible = True OnChange = KMemo1Change OnKeyDown = KMemo1KeyDown OnKeyPress = KMemo1KeyPress OnKeyUp = KMemo1KeyUp OnMouseDown = KMemo1MouseDown OnMouseUp = KMemo1MouseUp end object PanelBackLinks: TPanel AnchorSideLeft.Control = Owner AnchorSideTop.Control = Owner Left = 2 Height = 234 Top = 2 Width = 258 BorderSpacing.Left = 2 BorderSpacing.Top = 2 Caption = 'PanelBackLinks' ClientHeight = 234 ClientWidth = 258 ParentBackground = False ParentColor = False TabOrder = 4 Visible = False object ListBoxBackLinks: TListBox AnchorSideLeft.Control = PanelBackLinks AnchorSideTop.Control = PanelBackLinks AnchorSideRight.Control = PanelBackLinks AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = BitBtnBackLinks Left = 1 Height = 165 Top = 31 Width = 256 Anchors = [akTop, akLeft, akRight, akBottom] BorderSpacing.Top = 30 ItemHeight = 0 TabOrder = 0 TopIndex = -1 OnClick = ListBoxBackLinksClick end object BitBtnBackLinks: TBitBtn AnchorSideRight.Control = PanelBackLinks AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = PanelBackLinks AnchorSideBottom.Side = asrBottom Left = 152 Height = 37 Top = 196 Width = 105 Anchors = [akRight, akBottom] Cancel = True DefaultCaption = True Kind = bkCancel OnClick = BitBtnBackLinksClick TabOrder = 1 end object LabelBackLinks: TLabel AnchorSideLeft.Control = PanelBackLinks AnchorSideTop.Control = PanelBackLinks AnchorSideRight.Control = PanelBackLinks AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = BitBtnBackLinks Left = 11 Height = 21 Top = 4 Width = 241 Anchors = [akLeft, akRight] BorderSpacing.Left = 10 BorderSpacing.Top = 3 BorderSpacing.Right = 5 Caption = 'label1' end end object PopupMenuText: TPopupMenu Left = 256 Top = 264 object MenuBold: TMenuItem Caption = 'Bold' ShortCut = 16450 OnClick = MenuTextGeneralClick end object MenuItalic: TMenuItem Caption = 'Italic' ShortCut = 16457 OnClick = MenuTextGeneralClick end object MenuStrikeout: TMenuItem Caption = 'Strikeout' ShortCut = 16467 OnClick = MenuTextGeneralClick end object MenuHighLight: TMenuItem Caption = 'Highlight' ShortCut = 16456 OnClick = MenuTextGeneralClick end object MenuFixedWidth: TMenuItem Caption = 'Fixed Width' ShortCut = 16468 OnClick = MenuTextGeneralClick end object MenuUnderline: TMenuItem Caption = 'Underline' ShortCut = 16469 OnClick = MenuTextGeneralClick end object MenuItem2: TMenuItem Caption = '-' end object MenuSmall: TMenuItem Caption = 'Small Font' ShortCut = 16433 OnClick = MenuTextGeneralClick end object MenuNormal: TMenuItem Caption = 'Normal Font' ShortCut = 16434 OnClick = MenuTextGeneralClick end object MenuLarge: TMenuItem Caption = 'Large Font' ShortCut = 16435 OnClick = MenuTextGeneralClick end object MenuHuge: TMenuItem Caption = 'Huge' ShortCut = 16436 OnClick = MenuTextGeneralClick end object MenuItem3: TMenuItem Caption = '-' end object MenuItemBulletRight: TMenuItem Caption = 'Bullet +' ShortCut = 32807 OnClick = MenuTextGeneralClick end object MenuItemBulletLeft: TMenuItem Caption = 'Bullet -' ShortCut = 32805 OnClick = MenuTextGeneralClick end end object PopupMenuTools: TPopupMenu Left = 368 Top = 200 object MenuItemSync: TMenuItem Caption = 'Synchronize' Enabled = False OnClick = MenuItemSyncClick end object MenuItemSettings: TMenuItem Caption = 'Settings' OnClick = MenuItemSettingsClick end object MenuItemExport: TMenuItem Caption = 'Export' object MenuItemExportRTF: TMenuItem Caption = 'Export RTF' OnClick = MenuItemExportRTFClick end object MenuItemExportPlainText: TMenuItem Caption = 'Export Plain Text' OnClick = MenuItemExportPlainTextClick end object MenuItemExportMarkdown: TMenuItem Caption = 'Export Markdown' OnClick = MenuItemExportMarkdownClick end object MenuItemExportPDF: TMenuItem Caption = 'Export PDF' OnClick = MenuItemExportPDFClick end end object MenuItemPrint: TMenuItem Caption = 'Print' OnClick = MenuItemPrintClick end object MenuItemSpell: TMenuItem Caption = 'Spell Check' OnClick = MenuItemSpellClick end object MenuItemIndex: TMenuItem Caption = 'Index' OnClick = MenuItemIndexClick end object MenuItemEvaluate: TMenuItem Caption = 'Evaluate' ShortCut = 16453 OnClick = MenuItemEvaluateClick end object MenuStayOnTop: TMenuItem Caption = 'Stay On Top' OnClick = MenuStayOnTopClick end end object PopupMenuRightClick: TPopupMenu Left = 88 Top = 264 object MenuItemFind: TMenuItem Caption = 'Find in this Note' ShortCut = 16454 OnClick = MenuItemFindClick end object MenuFindNext: TMenuItem Caption = 'Find Next' ShortCut = 114 OnClick = MenuFindNextClick end object MenuFindPrev: TMenuItem Caption = 'Find Prev' ShortCut = 8306 OnClick = MenuFindPrevClick end object MenuItem1: TMenuItem Caption = '-' end object MenuItemCut: TMenuItem Caption = 'Cut' OnClick = MenuItemCutClick end object MenuItemCopy: TMenuItem Caption = 'Copy' OnClick = MenuItemCopyClick end object MenuItemCopyPlain: TMenuItem Caption = 'Copy Plain' OnClick = MenuItemCopyPlainClick end object MenuItemPaste: TMenuItem Caption = 'Paste' OnClick = MenuItemPasteClick end object MenuItemDelete: TMenuItem Caption = 'Delete' OnClick = MenuItemDeleteClick end object MenuItemSelectAll: TMenuItem Caption = 'Select All' OnClick = MenuItemSelectAllClick end end object TimerSave: TTimer Interval = 10000 OnTimer = TimerSaveTimer Left = 368 Top = 280 end object TimerHousekeeping: TTimer OnTimer = TimerHousekeepingTimer Left = 376 Top = 127 end object PrintDialog1: TPrintDialog Left = 496 Top = 119 end object PopupMainTBMenu: TPopupMenu Left = 486 Top = 252 end object PopupMenuSymbols: TPopupMenu Left = 408 Top = 48 object MenuItem4: TMenuItem Caption = 'MenuItem4' end object MenuItem5: TMenuItem Caption = 'MenuItem5' end object MenuItem6: TMenuItem Caption = 'MenuItem6' end end end ���������������������������������������������������������������������������������������������������������������������������������������������������tomboy-ng_0.39-1/source/editbox.pas�����������������������������������������������������������������0000644�0001750�0001750�00000531342�14551457644�017112� 0����������������������������������������������������������������������������������������������������ustar �dbannon�������������������������dbannon����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������unit EditBox; { Copyright (C) 2017-2021 David Bannon License: This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html. } { This form represents one note being read or edited. It keeps its note in a KMemo component, its there using the native (ie GTK or Windows) display system. This form uses two other units, SaveNote and LoadNote that know about the Tomboy's XML format. As an important design target, we must be fully compatible with Tomboys format. And why not ? } { HISTORY 2017/9/26 - Added Locks around call to load a file into KMemo. Speed up from 14 sec to 82mS when loading greybox note. 20170928 - Made CheckforLinks maintain one copy of the Text to search instead of a new copy for each search term when MakeAllLinks() was doing it. CheckforLinks() now takes up 200 mS instead of 600mS for 20K Greybox note file. 20170928 A whole lot of changes around OnChange event to speed up the response time around links. 20171003 - Started Testing under Windows. Added a bit of code to MakeAllLink() to allow for the fact that windows has two characters as a line ending, CR/LF, #13#10. KMemo SelectionIndex code allows one char for a Paragraph. Linux/OSX being Unix are fine, one char newline. A bit of a tidy up. 20171005 - Fixed a bug where a new note did not get its file path from Settings. 20171005 - Fixed a bug where new note is not getting its title set properly, we now read the title of the note when saving, also pop it into the Caption at the same time. 20171005 - Complete rewrite of the AlterFont() procedure, this one works all the time ! 20171007 - Bullets, good on Windows, less than so on Unix 20171008 - Added right click popup menu and Cut, Copy, Paste, Select All but cannot cut o copy to work o Linux. Will try other platforms. Hmm, flaky on all three platforms. But seens to work OK in small test !!! 20171008 - Added a line in FormShow to set the default font, KMemo1.Font.Size:= Lets see if that works..... 20171010 - on upgrade to the e4ec.. late september ver of kC, Bullet issue gone ! This code here now has simplified and better working bullets 2017/10/15 - now call MainUnit.IndexNotes after saving. This behaviour needs to be moved to a seperate thread..... 2017/11/03 restructure CheckForLinks() and MakeAllLinks() because of UTF8 issues. Abandon completely the model of copy note text to a PChar and scanning that, will now rely on UTF8Pos() searching Kmemo1.Blocks.Text. Big change, watch .... 2017/11/05 Converted GetAFileName() to use GUID, sorry about that ! I think the old method produced usable names but was not in Tomboy style. Should be OK.... 2017/11/07 Fixes to CheckForLinks() and friends so it can again, handle the same link mentioned several times in a note. And remember, UTF8Pos() does not like being told to start at zero. Oh, yes, I remember, now! 2017/11/29 Issue #4, fixed AlterFont() and AlterBlockFont() so that when doing Bold, Italics, Coloured we toggle on the basis of first character, not the first character of each block. 2017/11/30 Issue #12. An new note created by user clicking Link in another note is now auto saved. And the selected text from the first note now becomes, immediatly a link. 2017/12/02 Little fix to AlterFont to ensure a selected bit of text remains selected after a font change. 2017/12/28 Added and then removed a ToDo, does not need to get pushed. 2017/01/08 Extensive changes to the way we handle backspace around Bullets. I like what it does now but need to test on Win/Mac .... 2017/01/08 This Unit now has a public variable, Verbose that will tell tales.... 2017/01/08 Added a test so we don't mess with backspace if there is some selected text. Mac users, bless them, don't have a delete key. They use a key labeled 'delete' thats really a backspace. 2017/01/09 Hmm, fixed a bug in new code that let BS code mess around in header. 2018/01/25 Changes to support Notebooks 2018/01/27 if playing in a bullet and there is not a trailing nonbullet para marker, thats bad, so I now auto add one. Thats case y - however its still not perfect, really should add a test to see if we overran text looking for an unfound para. 2018/01/29 Noted a crazy note that ended up with an empty hyperlink in title and that messed MarkTitle() so altered its test to now find first para marker rather than first non text block 2018/02/01 Lock KMemo1 before saving. Noted a very occasional crash when first saving a new note. 2018/02/04 Added some ifdef to suppress needless warnings 2018/02/09 Export as RTF and TXT, untested on mac + windows 2018/02/17 Moved housekeeping stuff in a method and now call that method from a timer, reset by user activity. Same with Save time too. Should speed things up. 2018/02/18 Minor correction to Ctrl-Shift-F shortcut 2018/03/03 Changes housekeeping timer from 4sec to 2sec - change in object inspector 2018/03/17 Lockupdate was applied to KMemo, not KMemo.Blocks, in ImportNote(), 800ms hit ! Related to Mac's need for for a paragraph 'kick' after loading. Changed CheckForLinks() so it keeps a single copy of KMemo.Blocks.Text for its complete run, passing it to MakeAllLinks() rather than creating a new copy each iteration. Appears to deliver a usefull speedup ! Test !! But must, apparently unlock before calling some other functions. 2018/03/18 Removed the add a para on opening at last ! 2018/04/07 A UTF8 correction in MakeAllLinks() to how we count the #13 in Windows. 2018/04/11 Replaced a loom and delchar() with setting selection and calling ClearSelection im MakeLink Added a function to deal with Delete menu selection. Restored selection properly after housekeeping. 2018/04/12 Added a function to set the KMemo to readonly (for when the Sync Process has replaced or deleted the on disk copy of this note). SetReadOnly(); 2018/04/13 Added calls to start Housekeeping and Save times when editing inside bullets ! 2018/04/13 Now call NotebookPick Form dynamically and ShowModal to ensure two notes don't share. 2018/05/02 Enabled untested code to print. 2018/05/03 Now put a * ahead of note name to indicate its unsaved. 2018/05/04 Use CleanCaption() when using Caption elsewhere. 2018/05/07 Bug in MarkDirty(), now always enable SaveTimer 2018/05/07 Added a paste command into FormShow() that appears to fix strange bug where the first copy (as in Copy and paste) fails. This is a nasty fudge, perhapse related to http://bugs.freepascal.org/view.php?id=28679 Linux only ? 2018/05/12 Extensive changes - MainUnit is now just that. 2018/05/16 Disable Print menu option in Cocoa. 2018/06/13 Drop copy on selection and add Ben's Underline, strikethrough and Fixedwidth ! 2018/06/13 Reinstate copy on selection, middle button click, Linux & (in app only) Windows only 2018/06/22 DRB added LoadSingleNote and related to do just that. Needs more testing. 2018/07/05 Changed MonospaceFont to 'Monaco' on the Mac, apparently universal... 2018/07/20 Force copy on selection paste to always paste to left of a newline. 2018/07/23 If a note has no title in content but does have one in xml, caption is left blank and that crashes things that look for * in first char. Fixed 2018/07/23 Fixed a bug that crashed when deleting a note in SingleNoteMode. 2018/08/18 Added ^F4 to quit. Prevented undefined ^keys being passed into Kmemo 2018/08/20 Above edit dropped ^X, ^C, ^V before kmemo sees them, fixed, refactored a bit 2019/08/22 Add a whole lot more keys that KMemo auto supports, see AddKey(...) in keditcommon.pas 2018/10/13 Kmemo1KeyDown now deals with a Tab. 2018/10/20 Added --save-exit, only in single note mode. 2018/10/28 Support Backup management, snapshots and new sync Model. 2018/11/29 Now check if Spell is configured before calling its GUI 2018/12/02 Change to Bullet code, now support ALT+RGHT and ALT+Left, now can toggle bullet mode 2018/12/03 Use command key instead of control on the Mac 2018/12/04 Links to other notes no longer case sensitive, a potential link needs to be surrounded by white-ish space 2018/12/05 Move highlight shortcut key on the Mac to Alt-H because Apple uses Cmd-H 2018/12/06 Drop all Ctrl Char on floor for the Mac. See if we are missing anything ? 2018/12/06 Added Ctrl 1, 2, 3, 4 as small, normal, large and huge fnt. ---- This is not put on menus or doced anywhere, an experiment ------ 2018/12/29 Small improvements in time to save a file. 2019/01/15 Added Calculator, Ctrl-E for evaluate. Need to truncate floats ..... 2019/01/16 Tidy up of float display 2019/01/17 Added tan() to list of functions in Calc, go public with Ctrl1,2,3,4 2019/01/19 Can tolerate, in places, an imageblock 2019/02/01 ButtLinkClick() now provides a template name iff current note is a Notebook Member. However, its the first notebook listed, if user has allowed multiple notebooks per note, maybe not what they want. Maybe a selection list ? 2019/02/12 Fixed UTF8 bug in MakeAllLinks(), a touch faster now too ! 2019/02/23 Bug in column calc - how this that slip through ? 2019/03/13 Better local search capability and go to first term if opening result of Search 2019/04/13 Lockupdate while setting whole note text colour. 2019/04/18 Replaced TBitBtns with Speedbuttons to fix memory leak in Cocoa 2019/04/29 Restore note's previous previous position and size. 2019/05/06 Support saving pos and open on startup in note. 2019/05/14 Display strings all (?) moved to resourcestrings 2019/06/12 Removed panel behind speedbuttons, Cocoa did not like them ! 2019/06/14 Ensure top of new window is never less than 10 pixels down. 2019/07/19 Test that a note is not being deleted before we update on exit. 2019/07/20 Cleaned up MarkTitle() and extended the range its used for. 2019/07/21 MarkTitle now uses Sett.* colours. 2019/07/25 Added menu item under tools to open Settings #93 (part) 2019/09/07 User can now select a note font. 2019/09/21 CleanUTF8 removes some bad UTF8 char when importing some RTF files. 2019/09/21 AdjustFormPosition() now enforces some minium position/size. Issue #103 2019/10/11 Enabling of printing under Cocoa 2019/11/30 Now support web links. 2019/12/11 Heavily restructured Startup, Main Menu everywhere ! 2019/12/17 Links are no longer converted to lower case. 2019/12/18 LinkScanRange moved here from Settings, now 100, was 50 2019/12/22 Extensive changes to ClearNearLink() to ensure links are not smeared. 2020/01/02 Enabled Ctrl-Shift left or right arrow selecting or extending selecton by word. 2020/01/07 Use SaveTheNote() even when existing app with a clean note, UpdateNote() not used now 2020/01/12 More agressive adjustmenst to form position at opening a note Windows and Mac only 2020/01/28 Do not call SearchForm.UpdateList() when we are closing a clean note. 2020/03/11 In FormDestroy, we always save, EXCEPT if in SingleNoteMode, then only if dirty. 2020/03/27 Don't save a new, unwritten to note, also prevent 2 saves on a Ctrl-F4 2020/03/27 Set a cleared highlight to correct background colour. No longer toggle when changing font sizes, set it to what user asks. 2020/04/01 Removed line that exited KMemo1KeyDown in readonly mode, prevented cursor keys working. 2020/04/04 Fix for when SingleNoteMode is pointed to a zero length file. 2020/05/12 Added Shift Click to select to click pos, #129 2020/05/23 Do not poke SingleNoteFileName in during create, get it from Mainunit in OnCreate() 2020/06/08 Disable main menu button in readonly mode. 2020/08/06 Call a paste in ShowForm, even in SNM, assertion is better than no copying. Display external links in single note mode. 2020/08/19 Fixed bug affecting end of weblink in single note mode. 2020/10/22 Small bug where title markup can be smeared down several lines. 2020/11/18 Added StayOnTop to Tools Popup Menu 2021/01/06 Pre-load find dialog with SearchBox SearchTerm, Alt-F for find next 2021/01/22 When activating a note from the search form, jump to first match is Term is not empty 2021/01/25 Replace FindDialog with statusbar like system. Need shortcut keys defined. 2021/01/27 Previous find is now Ctrl-Alt-F, next one is Alt-F 2021/01/29 Use TB_Utils/TB_MakeFileName when exporting 2021/01/31 Fix UTF8 issue in Find, check for hits in FindIt if NumbFindHits = 0 2021/02/03 Enter Key based search model, Ctrl-Enter and Alt-Enter 2021/02/05 Complete rewrite of Find in a way that also works for Windows. 2021/02/15 Use CommonMark when exporting Markdown 2021/02/17 Fix Mac only bug, not Ctrl to ssMeta F for the EditFind 2021/06/25 Replaced TUpDown with 2 speedbuttons 2021/07/06 Save now in separate thread, a few mS for medium note, 10mS for a big one 2021/07/08 Calc now defaults LHS if same numb tokens LHS and RHS 2021/07/11 SimpleCalc can now handle appearing after a text terminating '.' 2021/07/17 Pickup Ctrl-N from EditFind. 2021/07/31 Ensure a New Note appears middle of the screen. 2021/08/07 Fixed a race condition on export MD if dirty. 2021/08/07 Commented out some code in FormShow thats is unreachable ?? Filename and Template 2021/08/27 Consolidated all Text menu events through one method 2021/08/27 Can now edit multilevel bullets 2021/10/26 User selectable date stamp format, inc Bold 2021-12-18 Ctrl-D was not saving any selected text to Undoer 2022/04/12 Stopped SpeedButtonLinkClick from asking about Notebooks, no idea why it was doing that. 2022/04/14 bug #260, TKMemoHyperlink not TKHyperlink 2022/05/05 bug #260, now clear all local links around cursor and create as necessary, may be slower ! could, perhaps, no longer sort name list and check for length in MakeLink() ? Longer wins ? 2022/08/28 CheckForLinks() no longer calls SearchForm.StartSearch(); eg 2000 notes faster to work directly off TheNoteLister.NoteList[i]^.TitleLow, 11-20mS compared to 19-41mS 2022/09/08 Esc can (if set) close current note. #271 2022/10/18 Extensive changes to Link system, faster and better behaviour #260 inc 2022/10/30 In MakeLink, capture the colour early, even if risk we don't need it. 2022/11/14 Add a Close button cos Qt5 hides to title bar buttons in Showmodal ???? 2022/12/30 Moved code that pokes search content into NoteLister down a few blocks so that we can be sure the note has been added to NoteLister first. 2023/02/12 Set the default font name from Sett in OnShow(), issue #263 2023/02/14 Fixed bug in column calculater, was ignoring negitive terms. 2023/03/11 Allow Qt to set Text and Background colour, force Gray for Inactive background (in LoadNote) cos Kmemo get it wrong 2023/04/08 Get a note's height and width before populating KMemo, saves 200mS on a big note ! 2023/04/09 Keep Find-in-note prompt there unless not found. 2023/12/30 Added ability to display Back Links (Links button with nothing selected) } {$mode objfpc}{$H+} {.$define LDEBUG} // ToDo : Lots of ugly debug output around the Link code, remove when stable interface uses Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, Menus, StdCtrls, Buttons, kmemo, LazLogger, clipbrd, lcltype, ComCtrls, // required up here for copy on selection stuff. fpexprpars, // for calc stuff ; SaveNote, // Knows how to save a Note to disk in Tomboy's XML PrintersDlgs, TBUndo; type FontLimitedAttrib = record // Used to save and restore attributes when Styles : TFontStyles; // a hyperlink is created or unlinked. BackColour : TColor; // Note we don't do underline here.... Size : Integer; end; type { TEditBoxForm } TEditBoxForm = class(TForm) BitBtnBackLinks: TBitBtn; BitBtnCloseFind: TBitBtn; ButtMainTBMenu: TSpeedButton; EditFind: TEdit; KMemo1: TKMemo; LabelBackLinks: TLabel; LabelFindCount: TLabel; LabelFindInfo: TLabel; Label2: TLabel; Label3: TLabel; Label4: TLabel; ListBoxBackLinks: TListBox; MenuBold: TMenuItem; MenuFindPrev: TMenuItem; MenuItalic: TMenuItem; MenuHighLight: TMenuItem; MenuHuge: TMenuItem; MenuItem1: TMenuItem; MenuFindNext: TMenuItem; MenuItem4: TMenuItem; MenuItem5: TMenuItem; MenuItem6: TMenuItem; MenuItemCopyPlain: TMenuItem; MenuItemExportPDF: TMenuItem; MenuItemBulletRight: TMenuItem; MenuItemBulletLeft: TMenuItem; MenuItemFindPrev: TMenuItem; MenuStayOnTop: TMenuItem; MenuItemSettings: TMenuItem; MenuItemEvaluate: TMenuItem; MenuItemIndex: TMenuItem; MenuItemExportMarkdown: TMenuItem; MenuItemSpell: TMenuItem; MenuItemExportRTF: TMenuItem; MenuItemExportPlainText: TMenuItem; MenuItemPrint: TMenuItem; MenuItemSelectAll: TMenuItem; MenuItemDelete: TMenuItem; MenuItemPaste: TMenuItem; MenuItemCopy: TMenuItem; MenuItemFind: TMenuItem; MenuItem3: TMenuItem; MenuItemCut: TMenuItem; MenuItemSync: TMenuItem; MenuItemExport: TMenuItem; MenuSmall: TMenuItem; MenuItem2: TMenuItem; MenuNormal: TMenuItem; MenuLarge: TMenuItem; MenuFixedWidth: TMenuItem; MenuUnderline: TMenuItem; MenuStrikeout: TMenuItem; Panel1: TPanel; PanelBackLinks: TPanel; PanelFind: TPanel; PanelReadOnly: TPanel; PopupMainTBMenu: TPopupMenu; PopupMenuSymbols: TPopupMenu; PopupMenuRightClick: TPopupMenu; PopupMenuTools: TPopupMenu; PopupMenuText: TPopupMenu; PrintDialog1: TPrintDialog; SpeedSymbol: TSpeedButton; SpeedClose: TSpeedButton; SpeedLeft: TSpeedButton; SpeedRight: TSpeedButton; SpeedButtonDelete: TSpeedButton; SpeedButtonLink: TSpeedButton; SpeedButtonNotebook: TSpeedButton; SpeedButtonSearch: TSpeedButton; SpeedButtonText: TSpeedButton; SpeedButtonTools: TSpeedButton; SpeedRollBack: TSpeedButton; // TaskDialogDelete: TTaskDialog; just why was this here ? Messes with Windows TimerSave: TTimer; TimerHousekeeping: TTimer; procedure BitBtnBackLinksClick(Sender: TObject); procedure BitBtnCloseFindClick(Sender: TObject); procedure ButtMainTBMenuClick(Sender: TObject); procedure EditFindChange(Sender: TObject); procedure EditFindEnter(Sender: TObject); procedure EditFindExit(Sender: TObject); procedure EditFindKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure FormActivate(Sender: TObject); procedure FormClose(Sender: TObject; var CloseAction: TCloseAction); procedure FormCloseQuery(Sender: TObject; var CanClose: boolean); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); { gets called under a number of conditions, easy one is just a re-show, or for a new note or a new note with a title from Link button or for an existing note where we get note file name or a new note from template where we have a note filename but IsTemplate also set, here we discard file name and make a new one. } procedure FormShow(Sender: TObject); procedure KMemo1Change(Sender: TObject); { Watchs for backspace affecting a bullet point, and whole lot of ctrl, shift, alt combinations. For things we let KMemo handle, just exit, for things we handle must set key to 0 after doing so. } procedure KMemo1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure KMemo1KeyPress(Sender: TObject; var Key: char); procedure KMemo1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); procedure KMemo1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure KMemo1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ListBoxBackLinksClick(Sender: TObject); procedure MenuItemExportPDFClick(Sender: TObject); procedure MenuItemCopyPlainClick(Sender: TObject); // All the Text menu items go through this event procedure MenuTextGeneralClick(Sender: TObject); procedure MenuFindPrevClick(Sender: TObject); procedure MenuFindNextClick(Sender: TObject); procedure MenuItemEvaluateClick(Sender: TObject); procedure MenuItemExportMarkdownClick(Sender: TObject); procedure MenuItemIndexClick(Sender: TObject); procedure MenuItemSettingsClick(Sender: TObject); procedure MenuStayOnTopClick(Sender: TObject); procedure MenuItemCopyClick(Sender: TObject); procedure MenuItemCutClick(Sender: TObject); procedure MenuItemDeleteClick(Sender: TObject); procedure MenuItemExportPlainTextClick(Sender: TObject); procedure MenuItemExportRTFClick(Sender: TObject); // This is a landing spot for either Find menu click or Ctrl-G procedure MenuItemFindClick(Sender: TObject); procedure MenuItemPasteClick(Sender: TObject); procedure MenuItemPrintClick(Sender: TObject); procedure MenuItemSelectAllClick(Sender: TObject); procedure MenuItemSpellClick(Sender: TObject); procedure MenuItemSyncClick(Sender: TObject); procedure PanelFindEnter(Sender: TObject); procedure SpeedSymbolClick(Sender: TObject); procedure SpeedCloseClick(Sender: TObject); procedure SpeedLeftClick(Sender: TObject); procedure SpeedRightClick(Sender: TObject); procedure SpeedRollBackClick(Sender: TObject); procedure SpeedButtonDeleteClick(Sender: TObject); // If user has some text selected, clean it up to make a Title, check if that Title // already exits (open that note) and if not, open a new note with that Title. procedure SpeedButtonLinkClick(Sender: TObject); procedure SpeedButtonNotebookClick(Sender: TObject); procedure SpeedButtonSearchClick(Sender: TObject); procedure SpeedButtonTextClick(Sender: TObject); procedure SpeedButtonToolsClick(Sender: TObject); procedure TimerSaveTimer(Sender: TObject); procedure TimerHousekeepingTimer(Sender: TObject); private {$ifdef LDEBUG}TG1, TG2, TG3, TG4 : qword;{$endif} Use_Undoer : boolean; // We allow user to disable Undo system, ONLY set during create. Undoer : TUndo_Redo; TitleHasChanged : boolean; // a record of the cursor position before last click, used by shift click to select MouseDownPos : integer; CreateDate : string; // Will be '' if new note Ready : boolean; { To save us checking the title if user is well beyond it } BlocksInTitle : integer; // Set True by the delete button so we don't try and save it. DeletingThisNote : boolean; procedure AddItemMenu(TheMenu: TPopupMenu; Item: string; mtTag: integer; OC: TNotifyEvent); procedure AdjustFormPosition(); { Alters the Font of Block as indicated } procedure AlterBlockFont(const FirstBlockNo, BlockNo: longint; const Command: integer; const NewFontSize: integer=0); { Alters the font etc of selected area as indicated } procedure AlterFont(const Command : integer; const NewFontSize: integer = 0); { If Toggle is true, sets bullets to what its currently not. Otherwise sets to TurnOn} procedure BulletControl(MoreBullet: boolean); // Gets passed a string containing a copy of one or more kmemo paragraphs, seperated by // #10. And a offset from the the start of the kmemo to the start of string. // Will mark up any web addresses it finds that are not already so marked. // Must start at start of para or space, must have at least one . and end with // space or newline char (#10). Returns 0 or length, in bytes, of the link procedure CheckForHTTP(const Buff: string; const Offset: integer); { Scans KMemo for bad utf8 characters, seems only used when importing RTF in SNM} procedure CleanUTF8(); function ColumnCalculate(out AStr: string): boolean; function ComplexCalculate(out AStr: string): boolean; procedure DumpKMemo(WhereFrom: string); function ExitError(MSG: string): boolean; procedure ExprTan(var Result: TFPExpressionResult; const Args: TExprParameterArray); { KMemo find function, starts searching one char after SelIndex, rets True if it found at least one hit, selects it. Each atomic operation takes about 2mS. Always case insensitive.} function FindInNote(Term: string; IncStartPos: integer): boolean; { KMemo find function, starts searching back one char before SelIndex, rets True if it found at least one hit, selects it. Each atomic operation takes about 2mS. Always case insensitive. } function FindInNoteBack(Term: string): boolean; { Triggers a new find, if IncStartPos is True starts search a one past cursor and works for the speed button, shift-F3, Enter etc. Only false if call is because user is typing and existing match might still be viable } procedure FindNew(IncStartPos: boolean); function FindNumbersInString(AStr: string; out AtStart, AtEnd: string): boolean; procedure InsertDate(); { Searches Buff for all occurances of Term, checks its surrounded appropriately and calls MakeLink to mark it up as a local Link. Does NOT look directly at KMemo1 } procedure MakeAllLinks(const Buff: string; const Term: ANSIString; const BlockOffset: integer); function ParagraphTextTrunc(): string; procedure PopulateSymbolMenu(AMenu: TPopupMenu); function RelativePos(const Term: ANSIString; const MText: PChar; StartAt: integer): integer; function PreviousParagraphText(const Backby: integer): string; function RestoreLimitedAttributes(const BlockNo: TKMemoBlockIndex; var FontAtt: FontLimitedAttrib): boolean; function SaveLimitedAttributes(const BlockNo: TKMemoBlockIndex; out FontAtt: FontLimitedAttrib): boolean; // This method will, at some stage, return after creating and starting // a thread that normalises the xml in the list, adds footer and saves. // The thread keeps going after the method returns doing above and then // free-ing the List. function SaveStringList(const SL: TStringList; Loc: TNoteUpdateRec): boolean; procedure SetTheColors; procedure ShowBackLinks(); function SimpleCalculate(out AStr: string): boolean; procedure ClearLinks(const StartScan : longint =0; EndScan : longint = 0); { Looks around current block looking for link blocks. If invalid, 'unlinks' them. Http or local links, we need to clear the colour and underline of any text nearby that have been 'smeared' from user editing at the end of a link. When this happens, new text appears within the link block, bad ..... } procedure ClearNearLink(const StartS, EndS: integer); function DoCalculate(CalcStr: string): string; procedure DoHousekeeping(); { Returns a UUID suitable for a file name } function GetAFilename() : ANSIString; { Returns with the title, that is the first line of note, returns False if title is empty } function GetTitle(out TheTitle: ANSIString): boolean; { Clears KMemo, sets colors, marks up title and loads the note into KMemo } procedure ImportNote(FileName : string); procedure InitiateCalc(); { Test the note to see if its Tomboy XML, RTF or Text. Ret .T. if its a new note. } function LoadSingleNote() : boolean; { Checks that the indicated text falls in all TKMemoTextBlock(s), replaces a link if new one is longer (greatly favours Web Links!). Exists early if it finds it does not need to make any changes. Make a new block, TKMemoHypeLink, use saved text and saved attributes. Expects invalid links to already have been removed. Does not mess with an existing HTTP link. Index and Len are char, not byte. } procedure MakeLink(const Index, Len: longint; const Term: string); { Makes sure the first (and only the first) line is marked as Title Title should be Blue, Underlined and FontTitle big. Note that when a new note is loaded from disk, this function is not called, the Load unit knows how to do it itself. Saves 200ms with a big (20K) note. } procedure MarkTitle(); { Returns true if current cursor is 'near' a bullet item. That could be because we are on a Para Marker thats a Bullet and/or either Leading or Trailing Para is a Bullet. We return with IsFirstChar true if we are on the first visible char of a line (not necessarily a bullet line). If we return FALSE, passed parameters may not be set. } function NearABulletPoint(out Leading, Under, Trailing, IsFirstChar, NoBulletPara: Boolean; out BlockNo, TrailOffset, LeadOffset: longint): boolean; { Responds when user clicks on a hyperlink } procedure OnUserClickLink(sender: TObject); { A method called by this or other apps to get what we might have selected } procedure PrimaryCopy(const RequestedFormatID: TClipboardFormat; Data: TStream); { Pastes into KMemo whatever is returned by the PrimarySelection system. } procedure PrimaryPaste(SelIndex: integer); { Return a string with a title for new note "New Note 2018-01-24 14:46.11" } function NewNoteTitle() : ANSIString; { Saves the note as text or rtf, consulting user about path and file name } procedure SaveNoteAs(TheExt: string); procedure MarkDirty(); function CleanCaption() : ANSIString; procedure SetBullet(PB: TKMemoParagraph; Bullet: boolean); // Advises other apps we can do middle button paste procedure SetPrimarySelection; procedure SymbolMenuClicked(Sender: TObject); { Restores block at StartLink to Text, attempts to merge linktext back into both the previous or next block if it can. There is a problem here. If a link is edited making it invalid but the remainer happens to also be a valid link, we don't get back to original if edit is reversed. } function UnlinkBlock(StartBlock: integer): integer; // Cancels any indication we can do middle button paste 'cos nothing is selected procedure UnsetPrimarySelection; //function UpdateNote(NRec: TNoteUpdaterec): boolean; public SingleNoteFileName : string; // Set by the calling process. FFN inc path, carefull, cli has a real global version SingleNoteMode : Boolean; NoteFileName : string; // Will contain the full note name, path, ID and .note NoteTitle : string; // only used during initial opening stage ? Dirty : boolean; Verbose : boolean; SearchedTerm : string; // If not empty, opening is associated with a search, go straight there. HaveSeenOnActivate : boolean; // Indicates we have run, eg, CheckForLinks at Activate TemplateIs : AnsiString; // If a new note is a member of Notebook, this holds notebook name until first save. { Public : Will mark this note as ReadOnly and not to be saved because the Sync Process has either replaced or deleted this note OR we are using it as an internal viewer. Can still read and copy content. Viewer users don't need big ugly yellow warning} procedure SetReadOnly(ShowWarning : Boolean = True); // Public: Call on a already open note if user has followed up a search with a double click procedure NewFind(Term: string); { Public : Saves the note in KMemo1, must have title but can make up a file name if needed If filename is invalid, bad GUID, asks user if they want to change it (they do !) WeAreClosing indicates that the whole application is closing (not just this note) We always save the note on FormDestroy or application exit, even if not dirty to update the position and OOS data. We used to call UpdateNote in the hope its quicker but it forgets to record notebook membership. Revist some day ....} procedure SaveTheNote(WeAreClosing: boolean=False); { Public : This is entry to manage Links. If FullBody, is a freshly loaded note with no links so we just scan and insert as necessary. Otherwise, its being called as the user types, we grab text around current cursor position, remove any invalid links and then scan and insert any that need be there. In all cases, we honour the use links setting from Sett. } procedure CheckForLinks(const FullBody: boolean); end; Type { TSaveThread } TSaveThread = class(TThread) private protected { Saves the contents of note in a single, seperate thread. It has had TheSL already populated with xml note content, it now normalises it adds Footer and writes it to disk. } procedure Execute; override; public TheSL : TStringList; TheLoc : TNoteUpdateRec; // defined in SaveNote Constructor Create(CreateSuspended : boolean); end; var EditBoxForm: TEditBoxForm; BusySaving : boolean; // Indicates that the thread that saves the note has not, yet exited. implementation {$R *.lfm} uses LazUTF8, //LCLType, // For the MessageBox keditcommon, // Holds some editing defines settings, // User settings and some defines used across units. SearchUnit, // Is the main starting unit and the search tool. LoadNote, // Will know how to load a Tomboy formatted note. LazFileUtils, // For ExtractFileName() RollBack, // RollBack form Spelling, NoteBook, MainUnit, // Not needed now for anything other than MainForm.Close() K_Prn, // Custom print unit. commonmark, Index, // An Index of current note. math, FileUtil, // just for ExtractSimplePath ... ~#1620 LCLIntf, // OpenUrl() TB_Utils, Note_Lister, // so we can get directly to note data. ResourceStr, // We borrow some search related strings from searchform bufstream, notenormal, // makes the XML look a little prettier LCLStrConsts, // just for rsMBClose ? KMemo2PDF, tb_symbol; // Backlinks {$ifdef LCLQT5}, qt5 {$endif}; const LinkScanRange = 100; // when the user changes a Note, we search +/- around // this value for any links that need adjusting. {$ifdef LDEBUG}var MyLogFile: TextFile;{$endif} { ============= T S A V E T H R E A D ================== } procedure TSaveThread.Execute; var Normaliser : TNoteNormaliser; WBufStream : TWriteBufStream; FileStream : TFileStream; SleepCnt : integer = 0; begin // Debugln('TSaveThread.Execute >>> start thread to save : ' + TheLoc.FFName); while (LockSyncingNow or LockSavingNow) do begin // declared and mostly used in Settings sleep(100); inc(SleepCnt); if SleepCnt > Sleeps then begin PostMessage(sett.Handle, WM_SYNCMESSAGES, WM_SAVETIMEOUT, 0); // ToDo : if this ever happens, we should mark note as dirty again ! How ? BusySaving := False; Debugln('TSaveThread.Execute - ERROR, failed to get Save Lock, Filename : ' + TheLoc.FFName); exit; end; end; LockSavingNow := True; Normaliser := TNoteNormaliser.Create; Normaliser.NormaliseList(TheSL); // TheSL belongs to the thread. Normaliser.Free; TheSL.Add(Footer(TheLoc)); // TWriteBufStream, TFileStream preferable to BufferedFileStream because of a lighter memory load. FileStream := TFileStream.Create(TheLoc.FFName, fmCreate); //FileStream := TFileStream.Create('/home/dbannon/savethread.note', fmCreate); WBufStream := TWriteBufStream.Create(FileStream, 4096); // 4K seems about right on Linux. try try TheSL.SaveToStream(WBufStream); except on E:Exception do begin Debugln('TSaveThread.Execute - ERROR, failed to save note : ' + E.Message); WBufStream.Free; FileStream.Free; TheSL.Free; PostMessage(sett.Handle, WM_SYNCMESSAGES, WM_SAVEERROR, 0); // Will release Lock exit; end; end; finally WBufStream.Free; FileStream.Free; TheSL.Free; BusySaving := False; end; PostMessage(sett.Handle, WM_SYNCMESSAGES, WM_SAVEFINISHED, 0); // Hmm, no error reporting happening here ? // Debugln('TSaveThread.Execute >>> End of Thread : ' + TheLoc.FFName); end; constructor TSaveThread.Create(CreateSuspended: boolean); begin inherited Create(CreateSuspended); FreeOnTerminate := True; end; // ============= U S E R C L I C K F U N C T I O N S ===================== procedure TEditBoxForm.SpeedButtonTextClick(Sender: TObject); begin PopupMenuText.PopUp; end; procedure TEditBoxForm.SpeedButtonToolsClick(Sender: TObject); begin PopupMenuTools.PopUp; end; procedure TEditBoxForm.SpeedButtonSearchClick(Sender: TObject); begin SearchForm.Show; end; procedure TEditBoxForm.SpeedButtonDeleteClick(Sender: TObject); var St : string; begin if KMemo1.ReadOnly then exit(); St := CleanCaption(); if IDYES = Application.MessageBox('Delete this Note', PChar(St), MB_ICONQUESTION + MB_YESNO) then begin TimerSave.Enabled := False; if SingleNoteMode then DeleteFileUTF8(NoteFileName) else if NoteFileName <> '' then SearchForm.DeleteNote(NoteFileName); Dirty := False; DeletingThisNote := True; Close; end; end; procedure TEditBoxForm.BitBtnBackLinksClick(Sender: TObject); begin PanelBackLinks.Visible := False; end; procedure TEditBoxForm.ListBoxBackLinksClick(Sender: TObject); begin if (ListBoxBackLinks.ItemIndex >= 0) and (ListBoxBackLinks.ItemIndex < ListBoxBackLinks.Count) then begin if (ListBoxBackLinks.Items[ListBoxBackLinks.ItemIndex] <> 'Cancel') and (ListBoxBackLinks.Items[ListBoxBackLinks.ItemIndex] <> 'Notes that Link to here') then SearchForm.OpenNote(ListBoxBackLinks.Items[ListBoxBackLinks.ItemIndex] ,'','',True, True, ListBoxBackLinks.Items[ListBoxBackLinks.ItemIndex]); PanelBackLinks.Visible := False; end; end; procedure TEditBoxForm.ShowBackLinks(); var //BackLinks : TFormBackLinks; Stl : TStringList; //BackTitle : string = ''; begin if not Sett. AutoSearchUpdate then begin showmessage('Back Links only available in Search While You Type mode'); exit; end; Stl := TStringList.Create; try TheMainNoteLister.SearchContent(lowercase(NoteTitle), Stl); if Stl.Count > 0 then LabelBackLinks.Caption := rsNotesLinked else LabelBackLinks.Caption := rsNoOtherNotes; PanelBackLinks.Visible := True; PanelBackLinks.BringToFront; ListBoxBackLinks.Items := Stl; finally Stl.Free; end; end; procedure TEditBoxForm.SpeedButtonLinkClick(Sender: TObject); var ThisTitle : ANSIString; Index : integer; begin { May be called with some text selected in which case it will try and create a new note with that title. If nothing selected, it populates and shows the BackLinks panel. A click on an item there will open that (backlinked) note. } if KMemo1.ReadOnly then exit(); if KMemo1.Blocks.RealSelLength > 1 then begin // ToDo : we should force a legal link here. eg, if no whitespace abound it, it will make a new note but text will not be linked. // so, if necessary, force a space between ajoining text ? ThisTitle := KMemo1.SelText; // Titles must not start or end with space or contain low characters while ThisTitle[1] = ' ' do UTF8Delete(ThisTitle, 1, 1); while ThisTitle[UTF8Length(ThisTitle)] = ' ' do UTF8Delete(ThisTitle, UTF8Length(ThisTitle), 1); Index := Length(ThisTitle); while Index > 0 do begin if ThisTitle[Index] < ' ' then delete(ThisTitle, Index, 1); dec(Index); end; if UTF8Length(ThisTitle) > 1 then begin SearchForm.OpenNote(ThisTitle); KMemo1Change(self); end; end else ShowBackLinks; end; procedure TEditBoxForm.SpeedButtonNotebookClick(Sender: TObject); var NotebookPick : TNotebookPick; begin // if its a new note that has been created from a template, then if the user looks at notebook list // here, before its saved, he does not see the notebook listed. So, we force a save to avoid confusion. // SaveTheNote() will clear the templateIS field when it does its stuff. if TemplateIs <> '' then SaveTheNote(); NotebookPick := TNotebookPick.Create(Application); NotebookPick.TheMode := nbSetNoteBooks; NotebookPick.FullFileName := NoteFileName; NotebookPick.Title := NoteTitle; NotebookPick.ChangeMode := False; NotebookPick.Top := Top; NotebookPick.Left := Left; if mrOK = NotebookPick.ShowModal then MarkDirty(); NotebookPick.Free; end; procedure TEditBoxForm.SpeedRollBackClick(Sender: TObject); begin if FormRollBack.Visible then exit; // Must not open model twice ! SaveTheNote(); FormRollBack.Left := left; FormRollBack.Top := top; FormRollBack.NoteFileName := NoteFileName; FormRollBack.ShownBy := self; FormRollBack.ShowModal; end; // ========================= B U L L E T S ===================================== // ToDo : when the text of a bullet has markup at the end, that markup is applied to bullet. procedure TEditBoxForm.BulletControl({const Toggle,} MoreBullet : boolean); var BlockNo : longint = 1; LastBlock, Blar : longint; //PB : TKMemoParagraph; begin if KMemo1.ReadOnly then exit(); MarkDirty(); BlockNo := Kmemo1.Blocks.IndexToBlockIndex(KMemo1.RealSelStart, Blar); LastBlock := Kmemo1.Blocks.IndexToBlockIndex(KMemo1.RealSelEnd, Blar); if (BlockNo = LastBlock) and (BlockNo > 1) and KMemo1.Blocks.Items[BlockNo].ClassNameIs('TKMemoParagraph') then begin dec(LastBlock); dec(BlockNo); end; // Don't change any trailing empty lines. while KMemo1.Blocks.Items[LastBlock].ClassNameIs('TKMemoParagraph') do if LastBlock > BlockNo then dec(LastBlock) else break; // OK, we are now in a TextBlock, possibly both start and end there. Must mark // next para as numb and then all subsquent ones until we do the one after end. repeat inc(BlockNo); if BlockNo >= Kmemo1.Blocks.count then // no para after block (yet) Kmemo1.Blocks.AddParagraph(); if KMemo1.Blocks.Items[BlockNo].ClassNameIs('TKMemoParagraph') then begin // special case, when clearing a bullet, ie already BulletOne and want less. The // ParaBlock has some built in left offset that won't go way. A new block // gets its attributes (inc the offset) from nearby ones. // ToDo : log with TK or patch to provide an optonal parameter to AddParagraph(BlockNo); ?? (* if (not MoreBullet) and (TKMemoParagraph(KMemo1.Blocks.Items[BlockNo]).Numbering = BulletOne) then begin KMemo1.Blocks.delete(BlockNo); KMemo1.Blocks.AddParagraph(BlockNo); debugln('BulletControl - Special Case'); end else *) SetBullet(TKMemoParagraph(KMemo1.Blocks.Items[BlockNo]), MoreBullet); end; until (BlockNo > LastBlock) and KMemo1.Blocks.Items[BlockNo].ClassNameIs('TKMemoParagraph'); end; function TEditBoxForm.NearABulletPoint(out Leading, Under, Trailing, IsFirstChar, NoBulletPara : Boolean; out BlockNo, TrailOffset, LeadOffset : longint ) : boolean; // on medium linux laptop, 20k note this function takes less than a mS var PosInBlock, Index, CharCount : longint; begin Under := False; NoBulletPara := False; BlockNo := kmemo1.Blocks.IndexToBlockIndex(KMemo1.RealSelStart, PosInBlock); if kmemo1.blocks.Items[BlockNo].ClassNameIs('TKMemoParagraph') then begin Under := (TKMemoParagraph(kmemo1.blocks.Items[BlockNo]).Numbering = pnuBullets); NoBulletPara := not Under; end; Index := 1; CharCount := PosInBlock; while BlockNo >= Index do begin if kmemo1.blocks.Items[BlockNo-Index].ClassNameIs('TKMemoParagraph') then break; CharCount := CharCount + kmemo1.blocks.Items[BlockNo-Index].Text.Length; inc(Index); // Danger - what if we don't find one going left ? end; if BlockNo < Index then begin Result := False; if Verbose then debugln('Returning False as we appear to be playing in Heading.'); exit(); end else Leading := (TKMemoParagraph(kmemo1.blocks.Items[BlockNo-Index]).Numbering = pnuBullets); IsFirstChar := (CharCount = 0); LeadOffset := Index; Index := 0; while true do begin // must not call Classnameis with blockno = count if Verbose then debugln('Doing para seek, C=' + inttostr(KMemo1.Blocks.Count) + ' B=' + inttostr(BlockNo) + ' I=' + inttostr(Index)); inc(Index); if (BlockNo + Index) >= (Kmemo1.Blocks.Count) then begin if Verbose then debugln('Overrun looking for a para marker.'); // means there are no para markers beyond here. So cannot be TrailingBullet Index := 0; break; end; if kmemo1.blocks.Items[BlockNo+Index].ClassNameIs('TKMemoParagraph') then break; end; TrailOffset := Index; if TrailOffset > 0 then Trailing := (TKMemoParagraph(kmemo1.blocks.Items[BlockNo+Index]).Numbering = pnuBullets) else Trailing := False; Result := (Leading or Under or Trailing); if Verbose then begin debugln('IsNearBullet -----------------------------------'); Debugln(' Result =' + booltostr(Result, true)); Debugln(' Leading =' + booltostr(Leading, true)); Debugln(' Under =' + booltostr(Under, true)); Debugln(' Trailing =' + booltostr(Trailing, true)); Debugln(' IsFirstChar =' + booltostr(IsFirstChar, true)); Debugln(' NoBulletPara=' + booltostr(NoBulletPara, true)); Debugln(' LeadOffset =' + inttostr(LeadOffset)); Debugln(' TrailOffset =' + inttostr(Trailoffset)); Debugln(' BlockNo =' + inttostr(BlockNo)); end; end; { procedure TEditBoxForm.CancelBullet(const BlockNo : longint; const UnderBullet : boolean); begin debugln('Cancel this bullet'); if UnderBullet then begin if Kmemo1.Blocks.Items[BlockNo].ClassNameis('TKMemoParagraph') then if TKMemoParagraph(KMemo1.Blocks.Items[BlockNo]).Numbering = pnuBullets then SetBullet(TKMemoParagraph(kmemo1.blocks.Items[BlockNo]), False); end else if (BlockNo+1) < Kmemo1.Blocks.Count then if Kmemo1.Blocks.Items[BlockNo+1].ClassNameis('TKMemoParagraph') then begin if TKMemoParagraph(KMemo1.Blocks.Items[BlockNo+1]).Numbering = pnuBullets then SetBullet(TKMemoParagraph(kmemo1.blocks.Items[BlockNo+1]), False); end; end; } { To behave like end users expect when pressing BackSpace we have to alter KMemo's way of thinking. a If the cursor is at the end of a Bullet Text, KMemo would remove the Bullet Marker, we stop that and remove the last character of the visible string. b If the cursor is at the begininng of a Bullet Text we must cancel the bullet (which is at the end of the Text) and not merge this line with one above. We know this is the case if the trailing paragraph marker is bullet AND we are the first char of the first block of the text. c If the cursor is on next line after a bullet, on a para marker that is not a bullet and there is no text on that line after the cursor, all we do is delete that para marker. d Again, we are on first char of the line after a bullet, this line is not a bullet itself and it has some text after the cursor. We merge that text up to the bullet line above, retaining its bulletness. So, mark trailing para bullet, delete leading. x A blank line, no bullet between two bullet lines. Use BS line should dissapear. That is, delete para under cursor, move cursor to end line above. This same as c y There is nothing after our bullet para marker. So, on an empty bulletline, user presses BS to cancel bullet but that cancels bullet and moves us up to next (bulleted) line. It has to, there is nowhere else to go. Verbose shows this as a case c ???? Lead Under Trail First OnPara(not bulleted) a ? T ? F remove the last character of the visible string to left. b ? F T T F Cursor at start, cancel bullet, don't merge x T F T T T Just delete this para. if Trailing move cursor to end of line above. c T F F T T Just delete this para. if Trailing move cursor to end of line above. y T T F T F Like c but add a para and move down. Not happy ..... d T F F T F mark trailing para as bullet, delete leading. e T T T T F must remove Bullet for para under cursor Special case where curser is at end of a bullet and there is no para beyond there ? So, its should act as (a) but did, once, act as (d) ?? Needs more testing ...... } procedure TEditBoxForm.SetBullet(PB : TKMemoParagraph; Bullet : boolean); {var Index : integer; Tick, Tock : qword; } begin // KMemo declares a number of Bullets/Paragraph number thingos. We map // BulletOne .. BulletEight to them in tb_utils. Change order/appearance there. // You cannot have different blocks using same bullet (ie pnuBullet, // pnuArrowBullet) with different indent levels. Its a KMemo thing. // The numbers here must match what we use in Loadnote, should be constants too. // Here I set the different bullet indents each and every time they are used. // ToDo : can I initialise the different bullet indents during startup ? { case PB.Numbering of pnuNone : debugln('TEditBoxForm.SetBullet pnuNone ' + booltostr(Bullet, True)); BulletOne : debugln('TEditBoxForm.SetBullet pnuOne ' + booltostr(Bullet, True)); BulletTwo : debugln('TEditBoxForm.SetBullet pnuTwo ' + booltostr(Bullet, True)); BulletThree : debugln('TEditBoxForm.SetBullet pnuThree ' + booltostr(Bullet, True)); BulletFour : debugln('TEditBoxForm.SetBullet pnuFour ' + booltostr(Bullet, True)); BulletFive : debugln('TEditBoxForm.SetBullet pnuFive ' + booltostr(Bullet, True)); BulletSix : debugln('TEditBoxForm.SetBullet pnuSix ' + booltostr(Bullet, True)); end; } KMemo1.Blocks.lockUpdate; try case PB.Numbering of pnuNone : if Bullet then begin PB.Numbering := BulletOne; PB.NumberingListLevel.FirstIndent:=-20; PB.NumberingListLevel.LeftIndent := 30; end; BulletOne : begin PB.Numbering:=pnuNone; PB.ParaStyle.NumberingListLevel := -1; if Bullet then begin PB.Numbering := BulletTwo; PB.NumberingListLevel.FirstIndent:=-20; PB.NumberingListLevel.LeftIndent := 50; end; end; BulletTwo : begin PB.Numbering:=pnuNone; if Bullet then begin PB.Numbering := BulletThree; PB.NumberingListLevel.FirstIndent:=-20; PB.NumberingListLevel.LeftIndent := 70; end else PB.Numbering := BulletOne; end; BulletThree : begin PB.Numbering:=pnuNone; if Bullet then begin PB.Numbering := BulletFour; PB.NumberingListLevel.FirstIndent:=-20; PB.NumberingListLevel.LeftIndent := 90; end else PB.Numbering := BulletTwo; end; BulletFour : begin PB.Numbering:=pnuNone; if Bullet then begin PB.Numbering := BulletFive; PB.NumberingListLevel.FirstIndent:=-20; PB.NumberingListLevel.LeftIndent := 110; end else PB.Numbering := BulletThree; end; BulletFive : begin PB.Numbering:=pnuNone; if Bullet then begin PB.Numbering := BulletSix; PB.NumberingListLevel.FirstIndent:=-20; PB.NumberingListLevel.LeftIndent := 130; end else PB.Numbering := BulletFour; end; BulletSix : begin PB.Numbering:=pnuNone; if Bullet then begin PB.Numbering := BulletSeven; PB.NumberingListLevel.FirstIndent:=-20; PB.NumberingListLevel.LeftIndent := 150; end else PB.Numbering := BulletFive; end; BulletSeven : begin PB.Numbering:=pnuNone; if Bullet then begin PB.Numbering := BulletEight; PB.NumberingListLevel.FirstIndent:=-20; PB.NumberingListLevel.LeftIndent := 170; end else PB.Numbering := BulletSix; end; BulletEight : if not Bullet then begin PB.Numbering:=pnuNone; PB.Numbering := BulletSeven; end; end; // end of case statement finally KMemo1.Blocks.UnlockUpdate; end; end; // =============== COPY ON SELECTION METHODS for LINUX and Windows ============ procedure TEditBoxForm.KMemo1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); {$IFNDEF DARWIN} // Mac cannot do Primary Paste, ie XWindows Paste var Point : TPoint; LinePos : TKmemoLinePosition; {$endif} begin {$IFNDEF DARWIN} if Button = mbMiddle then begin Point := TPoint.Create(X, Y); // X and Y are pixels, not char positions ! LinePos := eolEnd; while X > 0 do begin // we might be right of the eol marker. KMemo1.PointToIndex(Point, true, true, LinePos); if LinePos = eolInside then break; dec(Point.X); end; PrimaryPaste(KMemo1.PointToIndex(Point, true, true, LinePos)); exit(); end; if KMemo1.SelAvail and (Kmemo1.Blocks.SelLength <> 0) then SetPrimarySelection() else UnsetPrimarySelection(); {$endif} if (Button = mbLeft) and ([ssShift] = Shift) then begin //debugln('Start ' + dbgs(MouseDownPos) + ' to ' + dbgs(KMemo1.CaretPos)); KMemo1.SelStart := MouseDownPos; KMemo1.SelEnd := KMemo1.CaretPos; end; end; procedure TEditBoxForm.SetPrimarySelection; var FormatList: Array [0..1] of TClipboardFormat; begin if (PrimarySelection.OnRequest=@PrimaryCopy) then exit; FormatList[0] := CF_TEXT; try PrimarySelection.SetSupportedFormats(1, @FormatList[0]); PrimarySelection.OnRequest:=@PrimaryCopy; except end; end; procedure TEditBoxForm.UnsetPrimarySelection; begin if PrimarySelection.OnRequest=@PrimaryCopy then PrimarySelection.OnRequest:=nil; end; procedure TEditBoxForm.PrimaryCopy( const RequestedFormatID: TClipboardFormat; Data: TStream); var s : string; begin S := KMemo1.Blocks.SelText; if RequestedFormatID = CF_TEXT then if length(S) > 0 then Data.Write(s[1],length(s)); end; procedure TEditBoxForm.PrimaryPaste(SelIndex : integer); var Buff : string; begin // A primary paste will always have new content, never overwrites anything. if PrimarySelection.HasFormat(CF_TEXT) then begin // I don't know if this is useful at all. Buff := PrimarySelection().AsText; if Buff <> '' then begin Undoer.AddTextInsert(SelIndex, Buff); KMemo1.Blocks.InsertPlainText(SelIndex, Buff); KMemo1.SelStart := SelIndex; Kmemo1.SelEnd := SelIndex + length(Buff); end; end; //DumpKMemo('After Primary Paste'); { There is an issue when pasting multiline text, it possiblt relates to direction of selection, fixed by commenting out, at #13005 kmemo.pas, TKMemoBlocks.InsertString() - if not (Block is TKMemoContainer) then NormalToEOL(LocalIndex); I am sure that commenting out is not appropriate, leaving my working copy like that until I can workout what effect it has. Seem to note some surprising values for LocalIndex, related somehow. } end; { we insert datestring at selstart and optionall mark it small / italics } procedure TEditBoxForm.InsertDate(); var I : integer; Buff : string; begin Buff := TB_DateStamp(Sett.ComboDateFormat.ItemIndex); //Undoer.RecordInitial(0); Undoer.AddTextInsert(KMemo1.Blocks.SelStart, Buff, True); KMemo1.ExecuteCommand(ecInsertString, pchar(Buff)); if Sett.CheckStampItalics.checked or sett.CheckStampSmall.Checked then begin KMemo1.SelStart := Kmemo1.SelStart + 1; KMemo1.Sellength := Buff.Length-2; // we do not want to get the spaces. if Sett.CheckStampItalics.checked then AlterFont(3); if Sett.CheckStampBold.checked then AlterFont(2); if Sett.CheckStampSmall.checked then AlterFont(1, Sett.FontSmall); KMemo1.SelStart := Kmemo1.SelStart -1 + Buff.Length; KMemo1.Sellength := 0; end else for I := 0 to Buff.Length-1 do KMemo1.ExecuteCommand(ecRight); // move cursor end; // =================== U S E R F O N T C H A N G E S ====================== const ChangeSize = 1; // Used by AlterFont(..) and its friends. ChangeBold = 2; ChangeItalic = 3; ChangeColor = 4; ChangeFixedWidth = 5; ChangeStrikeout = 6; ChangeUnderline = 7; { This function will set font size, Bold or Italic or Color depending on the constant passed as first parameter. NewFontSize is ignored (and can be ommitted) if Command is ChangeBold or ChangeItalic, then toggle. If the function finds that the first char of selection already has that attribute it negates it, ie size becomes normal or no bold, no italics. It has to deal with several possible combinations and does so in three parts - 1. Dealing with what happens around the SelStart. Possibly splitting once or twice 2. Dealing with any complete blocks between start and end. 3. Dealing with the stuff around the end. If its not already been done by 1. The actual Commands are defined above and are not used outside this unit. Consider possible ways this function can be called - a. With selstart at first char in a block, Selend at end of same block. b. Selstart at other than first char, selend at end of same block. c. Selstart after first char and selend before last char of same block. d, e, f. as above but spanning blocks. a. & d. Require no splitting. Just apply change to block or blocks. b. & e. Needs one split. Split at SelStart and Apply to new and subsquent if any. c. & f. Needs two splits. Split at SelStar and SelEnd-1, then as above. So, decide what blocks we apply to, then apply. Sounds easy. AlterFont() is the entry point, it identifies and, if necessary splits blocks and calls AlterBlockFont() to do the changes, block by block. The decision as to turning [Colour,Bold,Italics] on or off SHOULD be made in AlterFont based on first char of selection and passed to AlterBlockFont. } procedure TEditBoxForm.AlterFont(const Command : integer; const NewFontSize : integer = 0); var FirstBlockNo, LastBlockNo, IntIndex, LastChar, FirstChar : longint; SplitStart : boolean = false; begin if KMemo1.ReadOnly then exit(); if Use_Undoer then Undoer.RecordInitial(0); Ready := False; MarkDirty(); LastChar := Kmemo1.RealSelEnd; // SelEnd points to first non-selected char FirstChar := KMemo1.RealSelStart; FirstBlockNo := Kmemo1.Blocks.IndexToBlockIndex(FirstChar, IntIndex); if IntIndex <> 0 then // Not Starting on block boundary. SplitStart := True; LastBlockNo := Kmemo1.Blocks.IndexToBlockIndex(LastChar, IntIndex); if IntIndex <> (length(Kmemo1.Blocks.Items[LastBlockNo].Text) -1) then // Not Last char in block LastBlockNo := KMemo1.SplitAt(LastChar) -1; // we want whats before the split. while LastBlockNo > FirstBlockNo do begin AlterBlockFont(FirstBlockNo, LastBlockNo, Command, NewFontSize); dec(LastBlockNo); end; // Now, only First Block to deal with if SplitStart then FirstBlockNo := KMemo1.SplitAt(FirstChar); AlterBlockFont(FirstBlockNo, FirstBlockNo, Command, NewFontSize); KMemo1.SelEnd := LastChar; // Any splitting above seems to subtly alter SelEnd, reset. KMemo1.SelStart := FirstChar; if Use_Undoer then Undoer.AddMarkup(); Ready := True; end; { Takes a Block number and applies changes to that block } procedure TEditBoxForm.AlterBlockFont(const FirstBlockNo, BlockNo : longint; const Command : integer; const NewFontSize : integer = 0); var Block, FirstBlock : TKMemoTextBlock; begin FirstBlock := TKMemoTextBlock(KMemo1.Blocks.Items[FirstBlockNo]); Block := TKMemoTextBlock(KMemo1.Blocks.Items[BlockNo]); if (Command = ChangeSize) and (NewFontSize = Sett.FontNormal) then begin // Don't toggle, just set to FontNormal Block.TextStyle.Font.Size := Sett.FontNormal; exit(); end; case Command of {ChangeSize : if Block.TextStyle.Font.Size = NewFontSize then begin Block.TextStyle.Font.Size := Sett.FontNormal; end else begin Block.TextStyle.Font.Size := NewFontSize; end; } ChangeSize : Block.TextStyle.Font.Size := NewFontSize; ChangeBold : if fsBold in FirstBlock.TextStyle.Font.style then begin Block.TextStyle.Font.Style := Block.TextStyle.Font.Style - [fsBold]; end else begin Block.TextStyle.Font.Style := Block.TextStyle.Font.Style + [fsBold]; end; ChangeItalic : if fsItalic in FirstBlock.TextStyle.Font.style then begin Block.TextStyle.Font.Style := Block.TextStyle.Font.Style - [fsItalic]; end else begin Block.TextStyle.Font.Style := Block.TextStyle.Font.Style + [fsItalic]; end; ChangeFixedWidth : if FirstBlock.TextStyle.Font.Name <> Sett.FixedFont then begin Block.TextStyle.Font.Pitch := fpFixed; Block.TextStyle.Font.Name := Sett.FixedFont; end else begin Block.TextStyle.Font.Pitch := fpVariable; Block.TextStyle.Font.Name := Sett.UsualFont; end; ChangeStrikeout : if fsStrikeout in FirstBlock.TextStyle.Font.style then begin Block.TextStyle.Font.Style := Block.TextStyle.Font.Style - [fsStrikeout]; end else begin Block.TextStyle.Font.Style := Block.TextStyle.Font.Style + [fsStrikeout]; end; ChangeUnderline : if fsUnderline in FirstBlock.TextStyle.Font.style then begin Block.TextStyle.Font.Style := Block.TextStyle.Font.Style - [fsUnderline]; end else begin Block.TextStyle.Font.Style := Block.TextStyle.Font.Style + [fsUnderline]; end; ChangeColor : if FirstBlock.TextStyle.Brush.Color <> Sett.HiColour then begin Block.TextStyle.Brush.Color := Sett.HiColour; end else begin Block.TextStyle.Brush.Color := Sett.BackGndColour; { clDefault; } end; end; end; // A method for responding to all text menu clicks. Could extend it to whole lot more ... procedure TEditBoxForm.MenuTextGeneralClick(Sender: TObject); begin case TMenuItem(sender).Name of 'MenuItemBulletRight' : BulletControl(True); 'MenuItemBulletLeft' : BulletControl(False); 'MenuHighLight' : AlterFont(ChangeColor); 'MenuLarge' : AlterFont(ChangeSize, Sett.FontLarge); // Note, fonts won't toggle ! 'MenuNormal' : AlterFont(ChangeSize, Sett.FontNormal); 'MenuSmall' : AlterFont(ChangeSize, Sett.FontSmall); 'MenuHuge' : AlterFont(ChangeSize, Sett.FontHuge); 'MenuBold' : AlterFont(ChangeBold); 'MenuItalic' : AlterFont(ChangeItalic); 'MenuUnderline' : AlterFont(ChangeUnderline); 'MenuStrikeout' : AlterFont(ChangeStrikeout); 'MenuFixedWidth' : AlterFont(ChangeFixedWidth); end; end; procedure TEditBoxForm.MenuItemIndexClick(Sender: TObject); var IForm : TFormIndex; begin IForm := TFormIndex.Create(Self); IForm.ModalResult := mrNone; IForm.TheKMemo := KMemo1; IForm.Left := Left; IForm.Top := Top; IForm.ShowModal; if IForm.SelectedBlock >= 0 then begin KMemo1.SelStart := KMemo1.Blocks.BlockToIndex(KMemo1.Blocks.Items[IForm.SelectedBlock]); KMemo1.SelLength := 0; end; IForm.Free; KMemo1.SetFocus; end; procedure TEditBoxForm.MenuItemSettingsClick(Sender: TObject); begin Sett.show; end; procedure TEditBoxForm.MenuStayOnTopClick(Sender: TObject); begin if MenuStayOnTop.Checked then begin FormStyle := fsNormal; MenuStayOnTop.Checked := false; end else begin FormStyle := fsSystemStayOnTop; MenuStayOnTop.Checked := true; end; end; procedure TEditBoxForm.FormActivate(Sender: TObject); {$ifdef TDEBUG}var Tick, Tock : integer; {$endif} begin if not HaveSeenOnActivate then begin; // Only the first Activate Ready := False; {$ifdef TDEBUG}Tick := gettickcount64();{$endif} CheckForLinks(True); {$ifdef TDEBUG} Tock := gettickcount64(); debugln('+++++++++++ OnActivate CheckForLinks() ' + inttostr(Tock - Tick) + 'mS' + ' HaveSeen=' + booltostr(HaveSeenOnActivate, true)); {$endif} if SearchedTerm <> '' then // We must do search after CheckForLinks NewFind(SearchedTerm); TimerHouseKeeping.Enabled := False; if SingleNoteMode then begin SpeedbuttonSearch.Enabled := False; SpeedButtonLink.Enabled := False; MenuItemSync.Enabled := False; SpeedButtonNotebook.Enabled := False; end; HaveSeenOnActivate := True; // ToDo : a regional, convert to typed const Ready := True; end; end; // --------------------- LOCAL F I N D M E T H O D S ------------------------- { Overview of local find process (local is note is 'Find', Searching all notes is 'Seach') : Works when the PanelFind is visible or not, gets called at note open if a search is underway. New Model, September 2022. SWYT, or maybe FWYT (Find While You Type) We select the found text but return focus back to the searchbox (so text is not overwritten). Tab, Ctrl-F (conditional) and closing Search Window moves focus to kmemo AND (??) deselects text leaving cursor at start of found item. Enter in the find box finds ! Ctrl-N must still make a new note. New system is much more Atomic, each event is self contained. User may be typing in EditSearch, each keypress will trigger a forward Find. Two small speed buttons back and forward just pass contents of edit to appropriate find method. No state and no total no. hits for current search term. When a user is typing, we should first try and match the word the cursor is on, only moving ahead if user presses Enter, the Right Button, shift-F3, ctrl-shift-G } const SearchPanelHeight = 39; procedure TEditBoxForm.PanelFindEnter(Sender: TObject); begin EditFind.SetFocus; end; procedure TEditBoxForm.SpeedCloseClick(Sender: TObject); begin close; end; procedure TEditBoxForm.MenuFindNextClick(Sender: TObject); begin SpeedRightClick(Self); end; procedure TEditBoxForm.MenuFindPrevClick(Sender: TObject); begin SpeedLeftClick(Self); end; procedure TEditBoxForm.NewFind(Term : string); // Public, called from SearchForm begin EditFind.Text := Term; FindInNote(Term, 0); // If we don't find it, no warning ! end; procedure TEditBoxForm.MenuItemFindClick(Sender: TObject); // works in two modes, Toggle or Always _activate_ Find begin if PanelFind.Height > 5 then begin if Sett.CheckFindToggles.Checked then begin PanelFind.Height := 1; // Hide it Kmemo1.SetFocus; end else begin EditFind.SetFocus; exit; end; end else begin PanelFind.Height := SearchPanelHeight; if KMemo1.RealSelLength > 0 then EditFind.Text := KMemo1.SelText; LabelFindInfo.Caption := {$ifdef DARWIN} rsFindNavRightHintMac + ', ' + rsFindNavLeftHintMac {$else}rsFindNavRightHint + ', ' + rsFindNavLeftHint{$endif}; EditFind.SetFocus; end; end; procedure TEditBoxForm.BitBtnCloseFindClick(Sender: TObject); begin PanelFind.Height := 1; Kmemo1.SetFocus; end; procedure TEditBoxForm.EditFindExit(Sender: TObject); begin if EditFind.Text = '' then begin EditFind.Hint:=rsSearchHint; EditFind.Text := rsMenuSearch; EditFind.SelStart := 1; EditFind.SelLength := length(EditFind.Text); end; EditFind.color := clGray; end; procedure TEditBoxForm.EditFindChange(Sender: TObject); begin FindNew(False); // User keystrokes do not jump forward until necessary end; procedure TEditBoxForm.EditFindEnter(Sender: TObject); begin editFind.Color:= clDefault; end; procedure TEditBoxForm.EditFindKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin // This needs to be a keydown else we get the trailing edge of key event that opened panel // Note that user typing normal characters are caught in TEditBoxForm.EditFindChange(); if (Key = VK_RETURN) then begin // Enter Key := 0; SpeedRightClick(self); exit; end; if Key = VK_F3 then begin // F3 inc Shift Key := 0; if [ssShift] = Shift then SpeedLeftClick(self) else SpeedRightClick(self); exit; end; // ---- Control keys and ... if (( {$ifdef DARWIN}[ssMeta]{$else}[ssCtrl]{$endif} = Shift) ) then begin case Key of VK_F: begin Key := 0; if Sett.CheckFindToggles.checked then begin MenuItemFindClick(Sender); KMemo1.SetFocus; // ToDo : check this logic end; exit; end; VK_N: begin Key := 0; SearchForm.OpenNote(''); exit; end; VK_G: begin Key := 0; if [ssCtrl, ssShift] = Shift then SpeedLeftClick(self) else SpeedRightClick(self); end; end; end; end; function TEditBoxForm.ExitError(MSG : string) : boolean; begin result := false; debugln('ERROR from tomboy-ng EditBox Unit : ' + MSG); end; procedure TEditBoxForm.SpeedLeftClick(Sender: TObject); // think btPrev // var Res : Boolean = false; begin if (EditFind.Caption = '') or (EditFind.Caption = rsMenuSearch) then exit; if FindInNoteBack(lowercase(EditFind.Text)) then LabelFindInfo.Caption := {$ifdef DARWIN} rsFindNavRightHintMac + ', ' + rsFindNavLeftHintMac {$else}rsFindNavRightHint + ', ' + rsFindNavLeftHint{$endif} else LabelFindInfo.Caption := rsNotAvailable; if PanelFind.Height = SearchPanelHeight then EditFind.SetFocus; end; procedure TEditBoxForm.FindNew(IncStartPos : boolean); var Found : boolean; begin if (EditFind.Caption = '') or (EditFind.Caption = rsMenuSearch) then exit; if IncStartPos then Found := FindInNote(lowercase(EditFind.Text), 1) else Found := FindInNote(lowercase(EditFind.Text), 0); if Found then LabelFindInfo.Caption := {$ifdef DARWIN} rsFindNavRightHintMac + ', ' + rsFindNavLeftHintMac {$else}rsFindNavRightHint + ', ' + rsFindNavLeftHint{$endif} else LabelFindInfo.Caption := rsNotAvailable; if PanelFind.Height = SearchPanelHeight then EditFind.SetFocus; end; procedure TEditBoxForm.SpeedRightClick(Sender: TObject); // think btNext begin FindNew(True); end; function TEditBoxForm.FindInNoteBack(Term : string) : boolean; var StartingCursor, StartBlock, IndexBlock, IntIndex, Found : integer; LoopCount : integer = 0; SearchString : string = ''; begin Result := False; StartingCursor := Kmemo1.Blocks.RealSelStart; StartBlock := Kmemo1.Blocks.IndexToBlockIndex(StartingCursor, IntIndex); if not KMemo1.Blocks[StartBlock].ClassNameIs('TKMemoParagraph') then begin SearchString := lowercase(Kmemo1.Blocks[StartBlock].Text); UTF8delete(SearchString, IntIndex+1, 99999); // Remove already searched content end {else if StartBlock = Kmemo1.Blocks.Count then dec(StartBlock)}; IndexBlock := StartBlock -1; // and if we start at block zero ? if IndexBlock < 0 then IndexBlock := KMemo1.Blocks.Count-1; while true do begin if IndexBlock < 0 then exit(ExitError('IndexBlock < 0')); if IndexBlock >= Kmemo1.Blocks.Count then exit(ExitError('IndexBlock too high')); if KMemo1.Blocks[IndexBlock].ClassNameIs('TKMemoParagraph') or (IndexBlock = 0) then begin Found := UTF8RPos(Term, SearchString); // 1 based if Found > 0 then begin Result := True; Kmemo1.SelStart := Kmemo1.Blocks.BlockToIndex(KMemo1.Blocks[IndexBlock]) + Found; Kmemo1.SelLength := UTF8Length(Term); Break; // we found one, might be only one in a loop end; SearchString := ''; end; if IndexBlock = StartBlock then exit(Term = lowercase(Kmemo1.Blocks.SelText)); // looped around to where we started. if IndexBlock = 0 then begin IndexBlock := KMemo1.Blocks.Count-1; // Possibly slow ...... inc(LoopCount); if LoopCount > 1 then exit(False); // Special case, empty note ! end; if not KMemo1.Blocks[IndexBlock].ClassNameIs('TKMemoParagraph') then SearchString := lowercase(Kmemo1.Blocks[IndexBlock].Text) + SearchString; dec(IndexBlock); end; end; function TEditBoxForm.FindInNote(Term : string; IncStartPos : integer) : boolean; var StartingCursor, StartBlock, IndexBlock, IntIndex, Found : integer; OffSets : integer = 0; // Allow for size of any paragraphs we skip over with no hit SearchString : string = ''; begin // We always start one char after the current cursor position. Find the next // match and highlight it. If we get back to cursor position, its a NOFIND. StartingCursor := Kmemo1.Blocks.RealSelStart; StartBlock := Kmemo1.Blocks.IndexToBlockIndex(StartingCursor, IntIndex); if not KMemo1.Blocks[StartBlock].ClassNameIs('TKMemoParagraph') then begin SearchString := lowercase(Kmemo1.Blocks[StartBlock].Text); UTF8delete(SearchString, 1, IntIndex+IncStartPos); // Remove already searched content, plus 1 if user not typing inc(Offsets, IncStartPos); end else inc(Offsets); // inc(Offsets); // account for either the Para or the skipped char in text IndexBlock := StartBlock+1; // Next block, if not there, drop through if IndexBlock >= KMemo1.Blocks.Count then begin // On very last line and block IndexBlock := 0; // Loop around. Offsets := 0; StartingCursor := 0; end; while IndexBlock < KMemo1.Blocks.Count do begin if KMemo1.Blocks[IndexBlock].ClassNameIs('TKMemoParagraph') and (SearchString <> '') then begin // **** Found := UTF8Pos(Term, SearchString); // 1 based if Found > 0 then begin Kmemo1.SelStart := StartingCursor + Offsets + Found -1; Kmemo1.SelLength := UTF8Length(Term); KMemo1.ExecuteCommand(ecDown); KMemo1.ExecuteCommand(ecDown); Kmemo1.SelStart := StartingCursor + Offsets + Found -1; Kmemo1.SelLength := UTF8Length(Term); //exit(Kmemo1.SelStart <> StartingCursor); // False if its the same one we started on ! exit(True); end; OffSets += utf8Length(SearchString) + 1; // +1 for the paragraph block // **** SearchString := ''; end else begin if not KMemo1.Blocks[IndexBlock].ClassNameIs('TKMemoParagraph') then SearchString += lowercase(Kmemo1.Blocks[IndexBlock].Text) else inc(OffSets); // Must allow for Para marked // **** end; if IndexBlock = StartBlock then begin // Hmm, thats were we started and its still not there ? Exit(Term = lowercase(Kmemo1.Blocks.SelText)); end; inc(IndexBlock); // **** if IndexBlock = KMemo1.Blocks.Count then begin // **** IndexBlock := 0; // Loop around. Offsets := 0; StartingCursor := 0; end; end; Result := False; // Here because user has initiated a new Find for something that does not exist. KMemo1.SelStart := StartingCursor; end; { ------- S T A N D A R D E D I T I N G F U N C T I O N S ----- } procedure TEditBoxForm.ButtMainTBMenuClick(Sender: TObject); begin PopupMainTBMenu.Popup; end; procedure TEditBoxForm.MenuItemCopyClick(Sender: TObject); begin KMemo1.ExecuteCommand(ecCopy); end; procedure TEditBoxForm.MenuItemCutClick(Sender: TObject); begin if KMemo1.ReadOnly then exit(); KMemo1.ExecuteCommand(ecCut); MarkDirty(); end; procedure TEditBoxForm.MenuItemDeleteClick(Sender: TObject); begin if KMemo1.ReadOnly then exit(); // KMemo1.ExecuteCommand(ecClearSelection); Undoer.AddPasteOrCut(True); KMemo1.Blocks.ClearSelection; end; procedure TEditBoxForm.MenuItemExportPlainTextClick(Sender: TObject); begin SaveNoteAs('txt'); end; procedure TEditBoxForm.MenuItemExportRTFClick(Sender: TObject); begin SaveNoteAs('rtf'); end; procedure TEditBoxForm.MenuItemExportMarkdownClick(Sender: TObject); begin SaveNoteAs('md'); end; procedure TEditBoxForm.MenuItemExportPDFClick(Sender: TObject); begin SaveNoteAs('pdf'); end; procedure TEditBoxForm.MenuItemCopyPlainClick(Sender: TObject); begin Clipboard.AsText := KMemo1.Blocks.SelText; end; procedure TEditBoxForm.SaveNoteAs(TheExt : string); var SaveExport : TSaveDialog; MDContent : TStringList; ExpComm : TExportCommon; FName : string; SleepCount : integer =0; Form2pdf: TFormKMemo2pdf; begin if not BusySaving then // In case a save has just started. SaveTheNote(); // This should return quickly, before save thread is finished. while BusySaving do begin // So, we wait until BusySaving is clear before proceeding sleep(20); // 20mS inc(SleepCount); if SleepCount > 1000 then begin // 20 seconds ? huge note, slow hardware ?? showmessage('Excessive delay in saving this note'); exit; end; end; SaveExport := TSaveDialog.Create(self); SaveExport.DefaultExt := TheExt; if Sett.ExportPath <> '' then SaveExport.InitialDir := Sett.ExportPath else begin if SingleNoteMode then SaveExport.InitialDir := ExtractFilePath(SingleNoteFileName) else begin {$ifdef UNIX} SaveExport.InitialDir := GetEnvironmentVariable('HOME'); {$endif} {$ifdef WINDOWS} SaveExport.InitialDir := GetEnvironmentVariable('HOMEPATH'); {$endif} end; end; //debugln('TEditBoxForm.SaveNoteAs Filename 1 = ' + CleanCaption()); //debugln('TEditBoxForm.SaveNoteAs Filename 2 = ' + TB_MakeFileName(CleanCaption())); SaveExport.Filename := TB_MakeFileName(CleanCaption()); if SaveExport.Execute then begin case TheExt of 'txt' : KMemo1.SaveToTXT(SaveExport.FileName); 'rtf' : KMemo1.SaveToRTF(SaveExport.FileName); 'md' : begin MDContent := TStringList.Create; ExpComm := TExportCommon.Create; try ExpComm.NotesDir := Sett.NoteDirectory; if SingleNoteMode then FName := NoteFileName else FName := ExtractFileNameOnly(NoteFileName); if ExpComm.GetMDcontent( FName, MDContent) then MDContent.SaveToFile(SaveExport.FileName) else showmessage('Failed to convert to MarkDown'); finally ExpComm.Free; MDContent.Free; end; end; 'pdf' : begin Form2pdf := TFormKMemo2pdf.create(self); Form2PDF.TheKMemo := KMemo1; Form2PDF.DefaultFont := sett.UsualFont; Form2PDF.FFileName := SaveExport.FileName; Form2PDF.TheTitle := Caption; if not Form2PDF.StartPDF() then begin; Form2PDF.ShowModal; Form2PDF.BringToFront; end; Form2pdf.free; end; end; end; //showmessage(SaveExport.FileName); SaveExport.Free; end; procedure TEditBoxForm.MarkDirty(); begin {if not Dirty then} TimerSave.Enabled := true; Dirty := true; if Caption = '' then Caption := '*' else if Caption[1] <> '*' then Caption := '* ' + Caption; end; function TEditBoxForm.CleanCaption(): ANSIString; begin if Caption = '' then exit(''); if Caption[1] = '*' then Result := Copy(Caption, 3, 256) else Result := Caption; end; procedure TEditBoxForm.SetReadOnly(ShowWarning : Boolean = True); begin if ShowWarning then PanelReadOnly.Height:= 60; KMemo1.ReadOnly := True; ButtMainTBMenu.Enabled:= False; // in helpnote mode, menu is not being updated. end; procedure TEditBoxForm.MenuItemPasteClick(Sender: TObject); begin if KMemo1.ReadOnly then exit(); Undoer.AddPasteOrCut(); Ready := False; KMemo1.ExecuteCommand(ecPaste); MarkDirty(); Ready := True; end; procedure TEditBoxForm.MenuItemPrintClick(Sender: TObject); var KPrint : TKprn; begin if PrintDialog1.Execute then begin KPrint := TKPrn.Create; KPrint.PrintKmemo(KMemo1); FreeandNil(KPrint); end; end; procedure TEditBoxForm.MenuItemSelectAllClick(Sender: TObject); begin KMemo1.ExecuteCommand(ecSelectAll); end; procedure TEditBoxForm.MenuItemSpellClick(Sender: TObject); var SpellBox : TFormSpell; begin if KMemo1.ReadOnly then exit(); if Sett.SpellConfig then begin SpellBox := TFormSpell.Create(Application); // SpellBox.Top := Placement + random(Placement*2); // SpellBox.Left := Placement + random(Placement*2); SpellBox.TextToCheck:= KMemo1.Blocks.Text; SpellBox.TheKMemo := KMemo1; SpellBox.ShowModal; end else showmessage('Sorry, spelling not configured'); end; procedure TEditBoxForm.MenuItemSyncClick(Sender: TObject); begin if KMemo1.ReadOnly then exit(); if Dirty then SaveTheNote(); Sett.Synchronise(); end; // ================================ S Y M B O L S ============================= procedure TEditBoxForm.SymbolMenuClicked(Sender: TObject); begin if (TMenuItem(Sender).Caption = rsMenuSettings) then begin if FormSymbol.ShowModal = mrOK then begin Sett.SaveSettings(self); PopulateSymbolMenu(PopupMenuSymbols); // debugln('Make out we saved the symbols'); end; end else begin KMemo1.ExecuteCommand(ecInsertString, pchar(TMenuItem(Sender).Caption)); KMemo1.ExecuteCommand(ecRight); end; end; procedure TEditBoxForm.AddItemMenu(TheMenu : TPopupMenu; Item : string; mtTag : integer; OC : TNotifyEvent); var MenuItem : TMenuItem; begin if Item = '-' then begin TheMenu.Items.AddSeparator; exit(); end; MenuItem := TMenuItem.Create(Self); MenuItem.Tag := ord(mtTag); // for 'File' entries, this identifies the function to perform. MenuItem.Caption := Item; MenuItem.OnClick := OC; TheMenu.Items.Add(MenuItem); end; procedure TEditBoxForm.PopulateSymbolMenu(AMenu : TPopupMenu); var i : integer; begin i := AMenu.Items.Count; while i > 0 do begin // Remove any existing entries first dec(i); AMenu.Items.Delete(i); end; for i := 0 to high(SymArray) do begin AddItemMenu(AMenu, SymArray[i].Sym, i, @SymbolMenuClicked); end; AddItemMenu(AMenu, '-', -1, @SymbolMenuClicked); AddItemMenu(AMenu, rsMenuSettings, -1, @SymbolMenuClicked); end; // ============== H O U S E K E E P I N G F U C T I O N S ================== procedure TEditBoxForm.FormCreate(Sender: TObject); begin PopulateSymbolMenu(PopupMenuSymbols); Use_Undoer := Sett.CheckUseUndo.checked; // Note, user must close and repen if they change this setting if Use_Undoer then Undoer := TUndo_Redo.Create(KMemo1) else Undoer := Nil; // SpeedClose.Caption := ' ' + copy(rsMBClose, 2, 20) + ' '; // chop off the initial '&' SingleNoteFileName := MainUnit.SingleNoteFileName(); if SingleNoteFileName = '' then SearchForm.RefreshMenus(mkAllMenu, PopupMainTBMenu) else begin SingleNoteMode := True; ButtMainTBMenu.Enabled := false; end; //PanelFind.Visible := False; PanelFind.Height := 1; // That is, hide it for now, visible a problem on Mac PanelFind.Caption := ''; {$ifdef WINDOWS}PanelFind.Color := Sett.AltColour;{$endif} // so we see black text, windows cannot change some colours ! {$ifdef DARWIN} SpeedRight.Hint := rsFindNavRightHintMac; SpeedLeft.Hint := rsFindNavLeftHintMac; {$else} SpeedRight.Hint := rsFindNavRightHint; SpeedLeft.Hint := rsFindNavLeftHint; {$endif} LabelFindCount.caption := ''; EditFind.Text := rsMenuSearch; {$ifdef DARWIN} MenuBold.ShortCut := KeyToShortCut(VK_B, [ssMeta]); MenuItalic.ShortCut := KeyToShortCut(VK_I, [ssMeta]); MenuStrikeout.ShortCut := KeyToShortCut(VK_S, [ssMeta]); MenuHighLight.ShortCut := KeyToShortCut(VK_H, [ssAlt]); MenuFixedWidth.ShortCut:= KeyToShortCut(VK_T, [ssMeta]); MenuUnderline.ShortCut := KeyToShortCut(VK_U, [ssMeta]); MenuItemFind.ShortCut := KeyToShortCut(VK_F, [ssMeta]); MenuItemEvaluate.ShortCut := KeyToShortCut(VK_E, [ssMeta]); MenuFindNext.shortcut := KeyToShortCut(VK_G, [ssMeta]); MenuFindPrev.shortcut := KeyToShortCut(VK_G, [ssShift, ssMeta]); {$endif} DeletingThisNote := False; end; procedure TEditBoxForm.SpeedSymbolClick(Sender: TObject); begin PopupMenuSymbols.popup; end; { FormShow gets called under a number of conditions Title Filename Template - Re-show, everything all loaded. Ready = true yes . . just exit - New Note no no no GetNewTitle(), add CR, CR, Ready, MarkTitle(O), zero dates. - New Note from Template no yes, dispose yes R1 ImportNote(), null out filename - New Note from Link Button, save immediatly yes no no cp Title to Caption and to KMemo, Ready, MarkTitle(). - Existing Note from eg Tray Menu, Searchbox yes yes no R1 ImportNote() } procedure TEditBoxForm.SetTheColors; begin KMemo1.Blocks.LockUpdate; {$ifdef windows} // Color:= Sett.textcolour; if Sett.DarkTheme then Color := Sett.BackGndColour; {$endif} PanelFind.Color := Sett.AltColour; Panel1.Color := Sett.AltColour; KMemo1.Colors.SelTextFocused := Sett.TextColour; KMemo1.Colors.SelText := Sett.TextColour; // when looses focus KMemo1.Colors.BkGnd:= Sett.BackGndColour; KMemo1.Colors.SelBkGnd := Sett.AltBackGndColor; // Selected backgnd when looses focus KMemo1.Colors.SelBkGndFocused := Sett.AltBackGndColor; // Selected backgnd with focus Kmemo1.Blocks.DefaultTextStyle.Font.Color := Sett.TextColour; Kmemo1.Blocks.DefaultTextStyle.Brush.Color := Sett.BackGndColour; KMemo1.Blocks.UnLockUpdate; end; procedure TEditBoxForm.FormShow(Sender: TObject); var ItsANewNote : boolean = false; // Tick, Tock, Tuck : qword; begin if Ready then exit; // its a "re-show" event. Already have a note loaded. // Ready := False; // But it must be false aready, it was created FALSE // Tick := GetTickCount64(); PanelReadOnly.Height := 1; TimerSave.Enabled := False; KMemo1.Font.Size := Sett.FontNormal; KMemo1.Font.Name := Sett.UsualFont; // KMemo1.Colors.SelBkGnd := Sett.BackGndColour; {$ifdef LCLGTK2} KMemo1.ExecuteCommand(ecPaste); // this to deal with a "first copy" issue on Linux. // above line generates a gtk2 assertion but only in single note mode. I suspect // thats because its a modal form and in normal use, this window is not modal. // If we don't make above call in SNM, we get the same assertion sooner or later, as soon // as we select some text so may as well get it over with. No need to do it in Qt5, Win, Mac {$endif} Kmemo1.Clear; // Note clear and setcolors() will be called again in importNote() but quick ... SetTheColors(); if SingleNoteMode then ItsANewNote := LoadSingleNote() // Might not be Tomboy XML format else if NoteFileName = '' then begin // might be a new note or a new note from Link if NoteTitle = '' then // New Note NoteTitle := NewNoteTitle(); ItsANewNote := True; end else begin Caption := NoteFileName; ImportNote(NoteFileName); // also sets Caption and Createdate, clears 260mS end; if ItsANewNote then begin left := (screen.Width div 2) - (width div 2); top := (screen.Height div 2) - (height div 2); CreateDate := ''; Caption := NoteTitle; KMemo1.Blocks.AddParagraph(); KMemo1.Blocks.AddParagraph(); if kmemo1.blocks.Items[0].ClassNameIs('TKMemoParagraph') then Kmemo1.Blocks.DeleteEOL(0); if kmemo1.blocks.Items[0].ClassNameIs('TKMemoTextBlock') then Kmemo1.Blocks.DeleteEOL(0); KMemo1.Blocks.AddTextBlock(NoteTitle, 0); MarkTitle(); end; // Tock := gettickcount64(); // MarkTitle(); // 70mS, ImortNote() does it all now. Not needed for new note KMemo1.SelStart := KMemo1.Text.Length; // set curser pos to end KMemo1.SelEnd := Kmemo1.Text.Length; // ToDo : why do we do this ? KMemo1.SetFocus; KMemo1.executecommand(ecEditorTop); KMemo1.ExecuteCommand(ecDown); Ready := true; Dirty := False; PanelBackLinks.Visible := false; // writeln('TEditBoxForm.FormShow 4 SelIndex = ', Kmemo1.SelStart); // Tuck := GetTickCount64(); // debugln('TEditBoxForm.FormShow ' + inttostr(Tock - Tick) + ' ' + inttostr(Tuck - Tock) + ' Total=' + inttostr(Tuck - Tick)); end; { called when user manually closes this form. } procedure TEditBoxForm.FormClose(Sender: TObject; var CloseAction: TCloseAction); begin Release; end; procedure TEditBoxForm.FormCloseQuery(Sender: TObject; var CanClose: boolean); begin CanClose := True; end; procedure TEditBoxForm.FormDestroy(Sender: TObject); begin if Undoer <> Nil then Undoer.free; UnsetPrimarySelection; // tidy up copy on selection. if (length(NoteFileName) = 0) and (not Dirty) then exit; // A new, unchanged note, no need to save. if not Kmemo1.ReadOnly then if not DeletingThisNote then if (not SingleNoteMode) or Dirty then // We always save, except in SingleNoteMode (where we save only if dirty) SaveTheNote(Sett.AreClosing); // Jan 2020, just call SaveTheNote, it knows how to record the notebook state SearchForm.NoteClosing(NoteFileName); end; // Make sure position and size is appropriate. procedure TEditBoxForm.AdjustFormPosition(); begin // First of all, deal with zero or neg settings if Top < 20 then Top := 20; if Left < 20 then Left := 20; if Width < 50 then width := 50; if Height < 50 then height := 50; // ensure we don't start with more than two thirds _beyond_ boundaries. // don't seem to need this, on Linux at least, new window is always within screen. Test on Windows/Mac {$ifdef LINUX}exit;{$endif} // Jan 2020, a possible problem in at least single note mode of notes beyond right hand edge of screen. bug #116 if (Left + (Width div 3)) > Screen.Width then begin Left := Screen.Width - (Width div 3); end; if (Top + (Height div 3)) > Screen.Height then begin Top := Screen.Height - (Height div 3); end; end; procedure TEditBoxForm.TimerSaveTimer(Sender: TObject); begin TimerSave.Enabled:=False; // showmessage('Time is up'); SaveTheNote(); end; function TEditBoxForm.LoadSingleNote() : boolean; var SLNote : TStringList; FileType : string; begin { Here we do some checks of the file name the user put on command line. If the file is not present, we assume that want to make a new note by that name. If its a Tomboy note (and all we test for is 'xml' in first line, 'tomboy' in second, then proceed normally. Note that the rtf import is not working but it loads fine as text, rtf being the kmemo's underlying lang. If we load a Text file, I either append or change extension to .note as by default, it becomes a note. } Result := False; { debugln('Path = [' + ExtractFilePath(NoteFileName) + ']'); debugln('Filename = [' + ExtractFileNameOnly(NoteFileName) + ']'); if DirectoryExistsUTF8(ExtractFilePath(NoteFileName)) then debugln('Dir is writable'); debugln('New name =' + AppendPathDelim(ExtractFilePath(NoteFileName)) + ExtractFileNameOnly(NoteFileName) + '.note'); } FileType := ''; if not FileExistsUTF8(NoteFileName) then FileType := 'new' else begin try SLNote := TStringList.Create; //try SlNote.LoadFromFile(NoteFileName); if SLNote.count = 0 then // to deal with a file created, eg with touch FileType := 'text' else if (UTF8Pos('xml', SLNote.Strings[0]) > 0) and (UTF8Pos('tomboy', SLNote.Strings[1]) > 0) then FileType := 'tomboy' else if (UTF8Pos('{\rtf1', SLNote.Strings[0]) > 0) then FileType := 'rtf' else if FileIsText(NoteFileName) then FileType := 'text'; // Wow, thats brave ! //except on //end; finally FreeAndNil(SLNote); end; end; if Verbose then debugln('Decided the file is of type ' + FileType); case FileType of 'tomboy' : try ImportNote(NoteFileName); except on E: Exception do debugln('!!! EXCEPTION during IMPORT ' + E.Message); end; // 'rtf' : KMemo1.LoadFromRTF(NoteFileName); // Wrong, will write back there ! 'text', 'rtf' : begin try KMemo1.LoadFromFile(NoteFileName); CleanUTF8(); NoteFileName := AppendPathDelim(ExtractFilePath(NoteFileName)) + ExtractFileNameOnly(NoteFileName) + '.note'; except on E: Exception do debugln('!!! EXCEPTION during LoadFromFile ' + E.Message); end; end; 'new' : begin Result := True; NoteTitle := NewNoteTitle(); end; '' : debugln('Error, cannot identify that file type'); end; if Application.HasOption('save-exit') then begin MarkDirty(); NoteFileName := ''; SaveTheNote(); close; end; end; function TEditBoxForm.GetTitle(out TheTitle : ANSIString) : boolean; var BlockNo : longint = 0; begin Result := False; TheTitle := ''; while Kmemo1.Blocks.Items[BlockNo].ClassName <> 'TKMemoParagraph' do begin TheTitle := TheTitle + Kmemo1.Blocks.Items[BlockNo].Text; inc(BlockNo); if BlockNo >= Kmemo1.Blocks.Count then break; end; if TheTitle <> '' then Result := True; end; procedure TEditBoxForm.MarkTitle(); var BlockNo : integer = 0; EndBlock, blar : integer; // Tick, Tock, Tuck : qword; // ToDo : remove begin // if Not Ready then exit(); // ToDo : what is effect of disabling this ? { if there is more than one block, and the first, [0], is a para, delete it.} if KMemo1.Blocks.Count <= 2 then exit(); // Don't try to mark title until more blocks. Ready := false; Kmemo1.Blocks.LockUpdate; if Kmemo1.Blocks.Items[BlockNo].ClassName = 'TKMemoParagraph' then Kmemo1.Blocks.DeleteEOL(0); try // Tick := GetTickCount64(); // this while loop can take 70mS when loading a big note, 100mS when updating title in a big note while Kmemo1.Blocks.Items[BlockNo].ClassName <> 'TKMemoParagraph' do begin if Kmemo1.Blocks.Items[BlockNo].ClassNameIs('TKMemoTextBlock') then begin // just possible its an image, ignore .... TKMemoTextBlock(Kmemo1.Blocks.Items[BlockNo]).TextStyle.Font.Size := Sett.FontTitle; TKMemoTextBlock(Kmemo1.Blocks.Items[BlockNo]).TextStyle.Font.Color := Sett.TitleColour; TKMemoTextBlock(Kmemo1.Blocks.Items[BlockNo]).TextStyle.Font.Style := [fsUnderline]; end; inc(BlockNo); if BlockNo >= Kmemo1.Blocks.Count then begin break; end; end; // Stopped at first TKMemoParagraph if it exists. // Tock := GetTickCount64(); BlocksInTitle := BlockNo; { Make sure user has not smeared Title charactistics to next line Scan back from cursor to end of title, if Title font, reset. } EndBlock := KMemo1.Blocks.IndexToBlockIndex(KMemo1.Selstart, Blar); while (EndBlock < 10) and (EndBlock < (KMemo1.Blocks.Count -2)) do inc(EndBlock); // in case user has smeared several lines down. while EndBlock > BlocksInTitle do begin if (TKMemoTextBlock(Kmemo1.Blocks.Items[EndBlock]).TextStyle.Font.Size = Sett.FontTitle) then begin TKMemoTextBlock(Kmemo1.Blocks.Items[EndBlock]).TextStyle.Font.Size := Sett.FontNormal; TKMemoTextBlock(Kmemo1.Blocks.Items[EndBlock]).TextStyle.Font.Color := Sett.TextColour; TKMemoTextBlock(Kmemo1.Blocks.Items[EndBlock]).TextStyle.Font.Style := []; end; dec(EndBlock); end; finally KMemo1.Blocks.UnLockUpdate; Ready := True; end; // Tuck := GetTickCount64(); // debugln('TEditBoxForm.MarkTitle ' + inttostr(Tock - Tick) + ' ' + inttostr(Tuck - Tock) + ' Total=' + inttostr(Tuck - Tick)); end; // This is a debug method, take care, it uses writeln and will kill Windows ! procedure TEditBoxForm.DumpKMemo(WhereFrom : string); var i : integer; begin Writeln('TEditBoxForm.DumpKMemo from ' + WhereFrom); for i := 0 to Kmemo1.Blocks.Count-1 do begin writeln(Inttostr(i) + ' ' + KMemo1.Blocks.Items[i].ClassName + ' = ' + KMemo1.Blocks.Items[i].Text); if KMemo1.Blocks.Items[i].ClassNameIs('TKMemoTextBlock') or KMemo1.Blocks.Items[i].ClassNameIs('TKMemoHyperlink') then writeln(' Bold=' + booltostr(fsBold in TKMemoTextBlock(KMemo1.Blocks.Items[i]).TextStyle.Font.Style, True)); end; end; // ============== L I N K R E L A T E D F U N C T I O N S ============== { Kmemo1.blocks.linetext returns a UTF8 (ANSI) string that has newlines recorded as a two byte 194 182 marker. They show up on console etc as ¶ - Thus the string "180°c¶", Length 6 chars and 8 bytes is - 1 [1] 2 [8] 3 [0] 4 194 5 176 // those two are the temperature symbol, one extra byte 6 [c] 7 194 8 182 // those two are the newline, one extra byte } { Housekeeping may call CheckForLinks(FullBody); If FullBody, we scan over whold note setting Links where necessary. Else, we grab a small lump of text arround the cursor position, finishing on line boundaries and using its size clear any invalid links in KMemo1. Then we scan that lump of text for anything that looks like a link. Locking for all of this action is done in CheckForLinks(). CheckForLinks(StartScan, EndScan); ClearNearLink(StartScan, EndScan); unlinks all TKMemoHyperlinks that are not valid Weblinks Unlocks Calls UNLinkBlock() UnLinkBlock deletes the TKMemoHyperLink and puts back a block containing the origional text, merging to surrounding text is possible if attributes match. Will copy some text attributes from a link and reappy them to the text after unlinking. loops over all Titles in NoteLister calling MakeAllLinks() for each one. Calls MakeAllLinks() is called for each Title in NoteLister, it searches for the Title in range and then checks its surrounded by deliminators. If so, calls MakeLink() on it. Calls CheckForHTTP() Scans over range looking for something that starts with http .... Makes a link if it finds something valid using MakeLink() Both call MakeLink() Does some sanity tests, might decide the offered local link is longer than an existing one and use it instead. Otherwise it exits if there is already a hyperlink starting there, else makes one. Copy the existing text attributes to the TKMemoHyperlink. MyRecipes, release mode, 2000 notes, 2 local links, Clear 91ms Check 147mS fancy total 140mS New Model, October 2022, 10 or so links at top of MyRecipes, ~100mS if directly affecting a link, 3-5mS otherwise. } function TEditBoxForm.SaveLimitedAttributes(const BlockNo : TKMemoBlockIndex; out FontAtt : FontLimitedAttrib) : boolean; begin (* debugln('SaveLimitedAttributes - using block ' + inttostr(BlockNo) + ' color=' + colortostring(TKMemoTextBlock(kmemo1.Blocks.Items[BlockNo]).TextStyle.Brush.Color) + ' FPcolor=' + colortostring(FPcolorToTColor(TKMemoTextBlock(kmemo1.Blocks.Items[BlockNo]).TextStyle.Brush.FPColor))); debugln('SaveLimitedAttributes - Next block ' + inttostr(BlockNo+1) + ' color=' + colortostring(TKMemoTextBlock(kmemo1.Blocks.Items[BlockNo+1]).TextStyle.Brush.Color) + ' FPcolor=' + colortostring(FPcolorToTColor(TKMemoTextBlock(kmemo1.Blocks.Items[BlockNo+1]).TextStyle.Brush.FPColor))); *) result := Kmemo1.Blocks.Items[BlockNo].ClassNameIs('TKMemoHyperlink') or Kmemo1.Blocks.Items[BlockNo].ClassNameIs('TKMemoTextBlock'); if not result then begin // Probably unnecessary .... FontAtt.BackColour := KMemo1.Colors.BkGnd; FontAtt.Size := Sett.FontNormal; FontAtt.Styles := []; // debugln('SaveLimitedAttributes - using default values'); end; FontAtt.Styles := TKMemoTextBlock(kmemo1.Blocks.Items[BlockNo]).TextStyle.Font.Style; FontAtt.Size := TKMemoTextBlock(kmemo1.Blocks.Items[BlockNo]).TextStyle.Font.Size; FontAtt.BackColour := TKMemoTextBlock(kmemo1.Blocks.Items[BlockNo]).TextStyle.Brush.Color; end; function TEditBoxForm.RestoreLimitedAttributes(const BlockNo : TKMemoBlockIndex; var FontAtt : FontLimitedAttrib) : boolean; begin result := Kmemo1.Blocks.Items[BlockNo].ClassNameIs('TKMemoHyperlink') or Kmemo1.Blocks.Items[BlockNo].ClassNameIs('TKMemoTextBlock'); if not result then exit; if fsUnderline in TKMemoTextBlock(kmemo1.Blocks.Items[BlockNo]).TextStyle.Font.Style then FontAtt.Styles := FontAtt.Styles + [fsUnderline] else FontAtt.Styles := FontAtt.Styles - [fsUnderline]; TKMemoTextBlock(kmemo1.Blocks.Items[BlockNo]).TextStyle.Font.Style := FontAtt.Styles; TKMemoTextBlock(kmemo1.Blocks.Items[BlockNo]).TextStyle.Brush.Color := FontAtt.BackColour; TKMemoTextBlock(kmemo1.Blocks.Items[BlockNo]).TextStyle.Font.Size := FontAtt.Size; end; procedure TEditBoxForm.MakeLink(const Index, Len : longint; const Term : string); // ToDo : A lot of clean up required // Note : the HTTP check does not pass the Term, gives an empty string instead !!!! var TermByteLen : integer; // Might be same as Len (http) or longer if link contains UTF8 Hyperlink : TKMemoHyperlink; TrueLink, AText : string; BlockNoS, BlockNoE, i : integer; BlockOffset : integer; // A zero based count of characters ahead of char pointed by Index FontAtt : FontLimitedAttrib; begin if Term = '' then TermByteLen := Len else TermByteLen := length(Term); // Debugln('TEditBoxForm.MakeLink 0 Index=', Index.tostring, ' Len=', Len.tostring, ' term=[' + Term + ']'); if Index = 0 then exit; // Thats this note's title, skip it ! BlockNoE := KMemo1.Blocks.IndexToBlockIndex(Index+Len-1, BlockOffset); // Block where proposed link Ends BlockNoS := KMemo1.Blocks.IndexToBlockIndex(Index, BlockOffset); // Block where proposed link starts //debugln('[' + KMemo1.Blocks.Items[BlockNoS].Text +'] [' + KMemo1.Blocks.Items[BlockNoE].Text + ']'); SaveLimitedAttributes(BlockNoS, FontAtt); // Record the existing colours asap ! if KMemo1.Blocks.Items[BlockNoS].ClassNameIs('TKMemoHyperLink') then begin AText := lowercase(KMemo1.Blocks.Items[BlockNoS].Text); if AText.StartsWith('http') then exit; // Already checked by Clean... if AText = Term then exit; // Already there end; //debugln('MakeLink Index=' + Index.ToString + ' Len=' + Len.ToString + ' BlockNoS=' + BlockNoS.ToString + ' BlockNoE=' + BlockNoE.ToString); //debugln('MakeLink S=[' + KMemo1.Blocks.Items[BlockNoS].Text + '] E=[' + KMemo1.Blocks.Items[BlockNoE].Text + ']'); i := BlockNoS; while i < BlockNoE do begin // debugln('MakeLink in loop, Block Content is [' + KMemo1.Blocks.Items[i].Text + ']'); if KMemo1.Blocks.Items[i].ClassNameIs('TKMemoHyperlink') then begin // is there a link there already ? if KMemo1.Blocks.Items[i].text.StartsWith('http') then exit; // Leave existing web links alone, already checked. if KMemo1.Blocks.Items[i].text.Length >= Len then exit; // Leave it alone, is already at least as long // debugln('MakeLink Unlinking ' + KMemo1.Blocks.Items[i].text); UnlinkBlock(i); // Existing shorter, we will replace BlockNoE := KMemo1.Blocks.IndexToBlockIndex(Index+Len-1, BlockOffset); // Sadly, we need to start this loop again BlockNoS := KMemo1.Blocks.IndexToBlockIndex(Index, BlockOffset); // and keep iterating until we have clear space i := BlockNoS; end; if KMemo1.Blocks.Items[i].ClassNameIs('TKMemoParagraph') then begin // Thats an ERROR ! // debugln('MakeLink exiting cos its a TKMemopara term=' + Term); exit; end; inc(i); end; TrueLink := utf8copy(Kmemo1.Blocks.Items[BlockNoS].Text, BlockOffset+1, Len); // Thats the bit thats in first block, possibly everything // The below might leave a empty block. Messy to delete here but .... if BlockNoE > BlockNoS then begin // Multiple blocks, two or more .... TKMemoTextBlock(Kmemo1.Blocks.Items[BlockNoS]).Text := copy(Kmemo1.Blocks.Items[BlockNoS].Text, 1, UTF8Length(Kmemo1.Blocks.Items[BlockNoS].Text)- UTF8Length(TrueLink)); i := 0; while BlockNoE > (BlockNoS+i) do begin // ie two blocks, run loop once TrueLink := TrueLink + Kmemo1.Blocks.Items[BlockNoS+i+1].Text; // +1 to get next block inc(i); // i must be > 0 because we are multiblock end; // That will get all of last block's text, probably excessive //debugln('MakeLink - link is split over multiple blocks. [' + TrueLink + ']'); // The below might leave a empty block. Messy to delete here but .... TKMemoTextBlock(Kmemo1.Blocks.Items[BlockNoS+i]).Text // BlockNoS+i is last block containing some of link := utf8copy(Kmemo1.Blocks.Items[BlockNoS+i].Text, 1 + Kmemo1.Blocks.Items[BlockNoS+i].Text.Length - UTF8length(TrueLink) + len, 9999); delete(TrueLink, Len+1, 999); // Get rid of that excess, +1 to start deleting after link text dec(i); while i > 1 do begin dec(i); Kmemo1.Blocks.Delete(BlockNoS+1); end; inc(BlockNoS); // Assumes we have left BlockNoS in place, removing trailing text, point to spot after existing value end else begin // All the proposed link was in the BlockNoS BlockNoS := KMemo1.SplitAt(Index); // debugln('TEditBoxForm.MakeLink 1 BlockNoS.Text =[' + KMemo1.Blocks.Items[BlockNoS].Text + '] = '+ inttostr(length(Term))); // ToDo : remove // debugln('Len=' + inttostr(Len)); { Chop of everything after the required Text. But len is a char count, not a byte count. } TKMemoTextBlock(Kmemo1.Blocks.Items[BlockNoS]).Text // remove content after the link //:= string(Kmemo1.Blocks.Items[BlockNoS].Text).Remove(0, Len); := string(Kmemo1.Blocks.Items[BlockNoS].Text).Remove(0, TermByteLen); // bytes ! if Kmemo1.Blocks.Items[BlockNoS].Text = '' then KMemo1.blocks.Delete(BlockNoS); // Link went to very end of orig block. if Kmemo1.Blocks.Items[BlockNoS-1].Text = '' then begin // Link must have started at beginning of orig block KMemo1.blocks.Delete(BlockNoS-1); dec(BlockNoS) end; // debugln('TEditBoxForm.MakeLink 2 BlockNoS.Text after trimming [' + KMemo1.Blocks.Items[BlockNoS].Text + ']'); // ToDo : remove end; // When we get to here, Link text (and any blocks completely spanned by link text) have been removed // and BlockNoS points to where link need be pushed into. Might have some empty text blocks .... // debugln('TEditBoxForm.MakeLink 3 TrueLink =' + TrueLink); // ToDo : remove {$ifdef LDEBUG}TG2 := gettickcount64();{$endif} Hyperlink := TKMemoHyperlink.Create; Hyperlink.Text := TrueLink; Hyperlink.Textstyle.StyleChanged := true; Hyperlink.OnClick := @OnUserClickLink; {HL := }KMemo1.Blocks.AddHyperlink(Hyperlink, BlockNoS); RestoreLimitedAttributes(BlockNoS, FontAtt); // debugln('MakeLink MADELINK BlockNoS=' + BlockNoS.Tostring + ' Text=[' + TrueLink +'] Att Col=' + ColorToString(FPColortoTColor(FontAtt.FPBackColour))); HyperLink.Textstyle.Font.Color := Sett.LinkColour; // debugln('TEditBoxForm.MakeLink 4 H.Text =' + Hyperlink.Text); // ToDo : remove {$ifdef LDEBUG}TG3 := gettickcount64(); TG1 := TG1 + (TG3-Tg2);{$endif} end; // Starts searching a string at StartAt for Term, returns 1 based offset from start of str if found, 0 if not. Like UTF8Pos( function TEditBoxForm.RelativePos(const Term : ANSIString; const MText : PChar; StartAt : integer) : integer; begin result := Pos(Term, MText+StartAt); if Result <> 0 then Result := Result + StartAt; end; procedure TEditBoxForm.MakeAllLinks(const Buff : string; const Term : ANSIString; const BlockOffset : integer); // Passed a text only version of the note in Buff var Offset : Integer; // The char position of a search term in Buffer ByteBeforeTerm, ByteAfterTerm : integer; ASelStart, ASelLength, i : integer; begin // if pos('bgc 11', TheMainNoteLister.NoteList[i]^.TitleLow) > 0 then // if Term = 'bgc 11' then // debugln('NewMakeAllLinks found it =========================' + Term); Offset := UTF8Pos(Term, Buff); while Offset > 0 do begin // will be zero when UTF8Pos() fails to find term // debugln('NewMakeAllLinks Acting on Term=' + Term); ByteBeforeTerm := UTF8CodepointToByteIndex(PChar(Buff), length(Buff), Offset)-1; ByteAfterTerm := UTF8CodepointToByteIndex(PChar(Buff), length(Buff), Offset+UTF8length(Term)); // Term may contain UTF8 char // debugln('TEditBoxForm.MakeAllLinks Offset=' + inttostr(Offset) + ' len=' + inttostr(length(Term)) + ' Buff=[' + Buff + ']'); if ((Offset = 1) or (Buff[ByteBeforeTerm] in [' ', #10, ',', '.'])) and (((Offset + length(Term)) >= length(Buff)) // Line ends at end of link term or (Buff[ByteAfterTerm] in [' ', #10, ',', '.'])) then begin // a suitable seperator at end of link term MakeLink(BlockOffset + Offset -1, UTF8length(Term), Term); // MakeLink takes a Char Index ! TimerHouseKeeping.Enabled := False; end; Offset := UTF8Pos(Term, Buff, Offset + 1); end; end; procedure TEditBoxForm.CheckForHTTP(const Buff : string; const Offset : integer); var http : integer; Len : integer = 1; // Returns the length of the char that b is first byte of { function LengthUTF8Char(b : byte) : integer; begin case b of 0..191 : Result := 1; 192..223 : Result := 2; 224..239 : Result := 3; 240..247 : Result := 4; end; end; } function ValidWebLength() : integer; var ADot : boolean = false; begin // we arrive here with http >= 1 Result := 7; if (not((http = 1) or (Buff[http-1] in [' ', ',', #10]))) then exit(0); // invalid start while (not(Buff[http+result] in [' ', ',', #10])) do begin // that might be end of link if (http+result) >= length(Buff) then exit(0); // invalid end if Buff[http+result] = '.' then ADot := True; inc(result); // next byte end; if Buff[http+result-1] = '.' then exit(0); // The dot was at the end. if (result < 13) or (not ADot) then exit(0); end; begin http := pos('http', Buff); // note that http is in bytes, '1' means first byte of Buff while (http <> 0) do begin if (UTF8copy(Buff, http, 7) = 'http://') or (copy(Buff, http, 8) = 'https://') then begin Len := ValidWebLength(); // reads http and Buff if Len > 0 then begin // debugln('CheckForHTTP Calling MakeLink() Offset=' + Offset.Tostring + '+' + (UTF8Length(pchar(Buff), http-1)).ToString + ' Len=' + (UTF8Length(pchar(Buff)+http, Len)).ToString); MakeLink(OffSet + UTF8Length(pchar(Buff), http-1), UTF8Length(pchar(Buff)+http, Len), ''); // must pass char values, not byte end; end; http := UTF8pos('http', Buff, http+Len+1); // find next one, +1 to ensure moving on end; end; procedure TEditBoxForm.CheckForLinks(const FullBody : boolean); var Content : string = ''; BuffOffset, LineNumb, BlockNo : integer; EndScan : Integer = 0; i : integer; {$ifdef TDEBUG}T0:qword=0;T1:qword=0;T2:qword=0;T3:qword=0;T4:qword=0;T5:qword=0;{$endif} // Puts one para of kMemo, starting at LineNumb, into Content. Ret Starting offset. function GrabPara() : integer; begin Content := ''; Result := KMemo1.Blocks.LineStartIndex[LineNumb]; while LineNumb < KMemo1.Blocks.LineCount do begin Content := Content + lowercase(Kmemo1.blocks.LineText[LineNumb]); dec(LineNumb); //inc(LineNumb); if Content[high(Content)] = #182 then begin // Line returns with two char line ending delete(Content, High(Content), 1); // delete the 182 Content[High(Content)] := #10; // replace the 194 break; end; end; end; // Returns the 0 based UTF8 Char index to the start of the passed back St, // So, the char 17 in St is actually char 17 + Return in KMemo, Note that Lines // returns a string with a two char newline, 194 182 we replace that with // a one char #10 to match the KMemo Selection Index. function GrabContent() : integer; var Li : TKMemoLineIndex; TSt : string; begin Li := Kmemo1.blocks.IndexToLineIndex(Kmemo1.Blocks.SelStart);// Thats the line index we are currently on Result := Kmemo1.Blocks.SelStart - Kmemo1.blocks.LineStartIndex[Li]; // How far we are to the right of start of line, CHARACTERS i := -1; while (Li + i) > -1 do begin // Zero is an acceptable line index TSt := Kmemo1.blocks.LineText[LI+i]; // Get the preceeding text if TST[length(TST)] = #182 then begin // Replace the 2 byte Newline marker delete(TSt, length(TST),1); TST[length(TST)] := #10 end; Content := lowercase(TSt) + Content; Result := Result + UTF8length(TSt); if Result > LinkScanRange then break; dec(i); end; i := 0; while (Li + i) < KMemo1.blocks.LineCount do begin // Going forward TSt := Kmemo1.blocks.LineText[LI+i]; if TST[length(TST)] = #182 then begin delete(TSt, length(TST),1); TST[length(TST)] := #10 end; Content := Content + lowercase(TSt); if (UTF8length(Content) - Result) > LinkScanRange then break; inc(i); end; Result := Kmemo1.Blocks.SelStart - Result; EndScan := UTF8Length(Content) + Result; end; function GetPrevPara(const Bk :integer) : integer; var Index : integer; begin // if BK < 10 then // debugln('Less than ten'); Index := Bk; Content := ''; while not KMemo1.Blocks[Index].ClassNameIs('TKMemoParagraph') do begin dec(Index); if Index <= 0 then break; end; Result := Index; // OK, here, BK is either Para or we have reached the very beginning. while Index <= Bk do begin if (Index > -1) and (not KMemo1.Blocks[Index].ClassNameIs('TKMemoParagraph')) then Content := Content + lowercase(KMemo1.Blocks[Index].Text); inc(Index); end; Content := Content + #10; end; begin {$ifdef LDEBUG} AssignFile(MyLogFile, 'log.txt'); rewrite(MyLogFile); TG1 := 0; {$endif} if (FullBody) then begin // Scan and do links in whole note, no unlinking required LineNumb := KMemo1.Blocks.LineCount -1; {$ifdef TDEBUG}T0 := gettickcount64();{$endif} { We iterate over the KMemo, loading a line, checking it for Links and hyperlinks, then do next line } KMemo1.Blocks.LockUpdate; BlockNo := GetPrevPara(KMemo1.Blocks.Count -1); while BlockNo > 0 do begin BlockNo := GetPrevPara(BlockNo-1); // At this point, BlockNo points to Par marker before our text. // debugln('BlockNo=' + (BlockNo+1).ToString + ' ' + Content); if BlockNo >= 0 then // debugln('Char index=' + inttostr(KMemo1.Blocks.BlockToIndex(KMemo1.Blocks[BlockNo+1]))); BuffOffSet := KMemo1.Blocks.BlockToIndex(KMemo1.Blocks[BlockNo+1]); for i := 0 to TheMainNoteLister.NoteList.Count-1 do // for each title in main list if TheMainNoteLister.NoteList[i]^.Title <> NoteTitle then begin // don't link to self if length(Content) > 3 then begin // Two significent char plus a newline {$ifdef LDEBUG}writeln(MyLogFile, 'FB ' + TheMainNoteLister.NoteList[i]^.TitleLow);{$endif} MakeAllLinks(Content, TheMainNoteLister.NoteList[i]^.TitleLow, BuffOffset); end; end; // OK, lets do HTTPS then. if Sett.CheckShowExtLinks.Checked then if length(Content) > 12 then CheckForHTTP(Content, BuffOffset); end; KMemo1.Blocks.UnLockUpdate; {$ifdef TDEBUG}T1 := gettickcount64(); debugln('CheckForLinks Timing T1=' + (T1-T0).tostring); {$endif} end else begin // Just scan +/- LinkScanRange of current cursor, Edit Mode {$ifdef TDEBUG}T1 := gettickcount64();{$endif} KMemo1.blocks.LockUpdate; BuffOffset := GrabContent(); // Also sets EndScan {$ifdef TDEBUG}T2 := gettickcount64();{$endif} ClearNearLink(BuffOffset, EndScan); // Parameters in utf8char, not bytes {$ifdef TDEBUG}T3 := gettickcount64();{$endif} if Sett.ShowIntLinks and (not SingleNoteMode) then begin for i := 0 to TheMainNoteLister.NoteList.Count-1 do begin // For each note title in the main list. {$ifdef LDEBUG}writeln(MyLogFile, 'BV ' + TheMainNoteLister.NoteList[i]^.TitleLow);{$endif} if TheMainNoteLister.NoteList[i]^.Title <> NoteTitle then MakeAllLinks(Content, TheMainNoteLister.NoteList[i]^.TitleLow, BuffOffset); end; TimerHouseKeeping.Enabled := False; end; {$ifdef TDEBUG}T4 := gettickcount64();{$endif} if Sett.CheckShowExtLinks.Checked then CheckForHTTP(Content, BuffOffset); // Mark any unmarked web links KMemo1.blocks.UnLockUpdate; // ToDo : unlock can take 100ms when making a new Link in edit mode. {$ifdef TDEBUG}T5 := gettickcount64(); debugln('CheckForLinks Timing T1=' + (T2-T1).ToString + 'mS ' + (T3-T2).ToString + 'mS ' + (T4-T3).ToString + 'mS ' + (T5-T4).ToString + 'mS '); {$endif} end; {$ifdef LDEBUG}CloseFile(MyLogFile);{$endif} end; function TEditBoxForm.UnlinkBlock(StartBlock : integer) : integer; var Existing : string; ChangedOne : boolean = false; Blk : TKMemoTextBlock; FontAtt : FontLimitedAttrib; function CanMergeBlocks(LinkBlock, TextBlock : integer) : boolean; // Merges two blocks IFF they are same sort, font, size etc begin if (KMemo1.Blocks.Items[TextBlock].ClassNameIs('TKMemoTextBlock') or KMemo1.Blocks.Items[TextBlock].ClassNameIs('TKMemoHyperlink')) and (KMemo1.Blocks.Items[LinkBlock].ClassNameIs('TKMemoTextBlock') or KMemo1.Blocks.Items[LinkBlock].ClassNameIs('TKMemoHyperlink')) then result := ((LinkBlock) < KMemo1.Blocks.count) and ((TextBlock) < KMemo1.Blocks.count) and (TKMemoTextBlock(KMemo1.Blocks.Items[TextBlock]).TextStyle.Font.Size = TKMemoTextBlock(KMemo1.Blocks.Items[LinkBlock]).TextStyle.Font.Size) and ((fsBold in TKMemoTextBlock(KMemo1.Blocks.Items[TextBlock]).TextStyle.Font.Style) = (fsBold in TKMemoTextBlock(KMemo1.Blocks.Items[LinkBlock]).TextStyle.Font.Style)) and ((fsItalic in TKMemoTextBlock(KMemo1.Blocks.Items[TextBlock]).TextStyle.Font.Style) = (fsItalic in TKMemoTextBlock(KMemo1.Blocks.Items[LinkBlock]).TextStyle.Font.Style)) and ((fsStrikeOut in TKMemoTextBlock(KMemo1.Blocks.Items[TextBlock]).TextStyle.Font.Style) = (fsStrikeOut in TKMemoTextBlock(KMemo1.Blocks.Items[LinkBlock]).TextStyle.Font.Style)) and ( TKMemoTextBlock(KMemo1.Blocks.Items[TextBlock]).TextStyle.Brush.Color = TKMemoTextBlock(KMemo1.Blocks.Items[LinkBlock]).TextStyle.Brush.Color) else Result := False; // ie cannot merge ! end; begin if not KMemo1.Blocks.Items[StartBlock].ClassNameIs('TKMemoHyperlink') then begin debugln('ERROR UnLink pointed at "not a Link" '); exit(StartBlock); end; // In the first two cases here, link text is shown with attributes of block it was merged into if CanMergeBlocks(StartBlock, StartBlock-1) then begin Existing := KMemo1.Blocks.Items[StartBlock].Text; Kmemo1.Blocks.Delete(StartBlock); dec(StartBlock); TKMemoTextBlock(KMemo1.Blocks.Items[StartBlock]).Text := KMemo1.Blocks.Items[StartBlock].Text + Existing; ChangedOne := True; {$ifdef LDEBUG} debugln('UnLinkBlock Merge Left StartBlock=' + StartBlock.Tostring + ' Existing=' + Existing); {$endif} end; if CanMergeBlocks(StartBlock, StartBlock+1) then begin Existing := KMemo1.Blocks.Items[StartBlock].Text; Kmemo1.Blocks.Delete(StartBlock); TKMemoTextBlock(KMemo1.Blocks.Items[StartBlock]).Text := Existing + KMemo1.Blocks.Items[StartBlock].Text; ChangedOne := True; {$ifdef LDEBUG} debugln('UnLinkBlock Merge Right StartBlock=' + StartBlock.Tostring + ' Existing=' + Existing); {$endif} end; if not changedOne then begin Existing := KMemo1.Blocks.Items[StartBlock].Text; SaveLimitedAttributes(StartBlock, FontAtt); Kmemo1.Blocks.Delete(StartBlock); Blk := KMemo1.Blocks.AddTextBlock(Existing, StartBlock); RestoreLimitedAttributes(StartBlock, FontAtt); Blk.TextStyle.Font.Style := Blk.TextStyle.Font.Style - [fsBold, fsItalic]; Blk.TextStyle.Font.Size := Sett.FontNormal; {$ifdef LDEBUG} debugln('UnLinkBlock No Merge StartBlock=' + StartBlock.Tostring + ' Existing=' + Existing); {$endif} end; Result := StartBlock; // only changed with merge left end; procedure TEditBoxForm.ClearNearLink(const StartS, EndS : integer); inline; // note that kmemo is locked before we get here. var Blar, StartBlock, EndBlock : longint; LinkText : ANSIString; function ValidWebLink() : boolean; // returns true if LinkText is valid web address var DotSpot : integer; Str : String; begin if pos(' ', LinkText) > 0 then exit(false); if (copy(LinkText,1, 8) <> 'https://') and (copy(LinkText, 1, 7) <> 'http://') then exit(false); Str := TKMemoTextBlock(KMemo1.Blocks.Items[StartBlock-1]).Text; if (KMemo1.Blocks.Items[StartBlock-1].ClassName <> 'TKMemoParagraph') and not Str.EndsText(' ', Str) then exit(false); if (KMemo1.Blocks.Items[StartBlock+1].ClassName <> 'TKMemoParagraph') and (not TKMemoTextBlock(KMemo1.Blocks.Items[StartBlock+1]).Text.StartsWith(' ')) then exit(false); DotSpot := pos('.', LinkText); if DotSpot = 0 then exit(false); if (DotSpot < 8) or (DotSpot > length(LinkText)-1) then exit(false); if LinkText.EndsWith('.') then exit(false); result := true; end; function ValidLocalLink() : boolean; begin if SingleNoteMode then exit(False); if not TheMainNoteLister.IsThisaTitle(LinkText) then exit(False); Result := KMemo1.Blocks.Items[StartBlock-1].ClassNameIs('TKMemoParagraph') or TKMemoTextBlock(KMemo1.Blocks.Items[StartBlock-1]).Text.EndsWith(' '); Result := Result and ( (KMemo1.Blocks.count = StartBlock+1) or (KMemo1.Blocks.Items[StartBlock+1].ClassNameIs('TKMemoParagraph') or (TKMemoTextBlock(KMemo1.Blocks.Items[StartBlock+1]).Text[1] // !!!!!!!!!! in [' ', ','])) ); end; begin Ready := False; EndBlock := KMemo1.Blocks.IndexToBlockIndex(EndS, Blar); StartBlock := KMemo1.Blocks.IndexToBlockIndex(StartS, Blar); if StartBlock < 2 then StartBlock := 2; if EndBlock > Kmemo1.Blocks.Count then EndBlock := Kmemo1.Blocks.Count; try while StartBlock < EndBlock do begin if TKMemoTextBlock(KMemo1.Blocks.Items[StartBlock]).TextStyle.Font.Size = Sett.FontTitle then begin inc(StartBlock); continue; // We are NOT dealing with title here end; if KMemo1.Blocks.Items[StartBlock].ClassNameIs('TKMemoHyperlink') then begin LinkText := lowercase(Kmemo1.Blocks.Items[StartBlock].Text); // ! trim() // Only if its not a valid link, remove it. if not (ValidWebLink() or ValidLocalLink()) then begin // LocalLinks ignored in SingleNoteMode StartBlock := UnLinkBlock(StartBlock); if EndBlock > Kmemo1.Blocks.Count then EndBlock := Kmemo1.Blocks.Count; end; end else begin // Must check here that its not been subject to the copying of a links colour and underline // we know its not a link and we know its not title. So, if TextBlock, check color ... // Note : as of Jan 2023, title and link can be different colours with TKMemoTextBlock(KMemo1.Blocks.Items[StartBlock]) do if KMemo1.Blocks.Items[StartBlock].ClassNameIs('TKMemoTextBlock') // Only an issue with TextBlocks and (TextStyle.Font.Color = Sett.LinkColour ) then begin TextStyle.Font.Style := TextStyle.Font.Style - [fsUnderLine]; TextStyle.Font.Color := Sett.TextColour; end; end; inc(StartBlock); end; finally Ready := True; end; end; { Scans across whole note removing any links it finds. Block containing link must be removed and new non-link block created in its place. Note that the scaning is very quick, gets bogged down doing the remove/add This function is not needed at present but leave it here in case its useful after user chooses to not display links. } procedure TEditBoxForm.ClearLinks(const StartScan : longint =0; EndScan : longint = 0); var BlockNo, EndBlock, Blar : longint; LinkText : ANSIString; begin Ready := False; BlockNo := KMemo1.Blocks.IndexToBlockIndex(StartScan, Blar); // DANGER, we must adjust StartScan to block boundary EndBlock := KMemo1.Blocks.IndexToBlockIndex(EndScan, Blar); // DANGER, we must adjust EndScan to block boundary KMemo1.Blocks.LockUpdate; while BlockNo <= EndBlock do begin // DANGER, must check these block numbers work if Kmemo1.Blocks.Items[BlockNo].ClassName = 'TKMemoHyperlink' then begin LinkText := Kmemo1.Blocks.Items[BlockNo].Text; Kmemo1.Blocks.Delete(BlockNo); KMemo1.Blocks.AddTextBlock(Linktext, BlockNo); end; inc(BlockNo); end; KMemo1.Blocks.UnLockUpdate; Ready := True; end; procedure TEditBoxForm.OnUserClickLink(sender : TObject); begin if (copy(TKMemoHyperlink(Sender).Text, 1, 7) = 'http://') or (copy(TKMemoHyperlink(Sender).Text, 1, 8) = 'https://') then OpenUrl(TKMemoHyperlink(Sender).Text) else SearchForm.OpenNote(TKMemoHyperlink(Sender).Text); end; procedure TEditBoxForm.DoHousekeeping(); var CurserPos, SelLen, BlockNo, Blar : longint; TempTitle : ANSIString; {$ifdef LDEBUG}TS1, TS2 : qword;{$endif} begin if KMemo1.ReadOnly then exit(); Ready := False; CurserPos := KMemo1.RealSelStart; SelLen := KMemo1.RealSelLength; BlockNo := KMemo1.Blocks.IndexToBlockIndex(CurserPos, Blar); if ((BlocksInTitle + 10) > BlockNo) then begin // We don't check title if user is not close to it. MarkTitle(); GetTitle(TempTitle); if not ((TempTitle = caption) or ('* ' + TempTitle = Caption)) then TitleHasChanged := True; if Dirty then Caption := '* ' + TempTitle else Caption := TempTitle; end; // OK, if we are in the first or second (?) block, no chance of a link anyway. if BlockNo < 2 then begin if KMemo1.Blocks.Count = 0 then // But bad things happen if its really empty ! KMemo1.Blocks.AddParagraph(); Ready := True; exit(); end; if Sett.ShowIntLinks or Sett.CheckShowExtLinks.Checked then begin {$ifdef LDEBUG}TS1 := gettickcount64();{$endif} CheckForLinks(False); // does its own locking TimerHouseKeeping.Enabled := False; {$ifdef LDEBUG}TS2 := gettickcount64(); debugln('------------- DoHousekeeping Update Links ' + inttostr(TS2-TS1) + 'ms');{$endif} end; KMemo1.SelStart := CurserPos; KMemo1.SelLength := SelLen; Ready := True; end; procedure TEditBoxForm.TimerHousekeepingTimer(Sender: TObject); begin TimerHouseKeeping.Enabled := False; DoHouseKeeping(); end; { ---------------------- C A L C U L A T E F U N C T I O N S ---------------} procedure TEditBoxForm.MenuItemEvaluateClick(Sender: TObject); begin InitiateCalc(); end; procedure TEditBoxForm.ExprTan(var Result: TFPExpressionResult; const Args: TExprParameterArray); var x: Double; begin x := ArgToFloat(Args[0]); Result.resFloat := tan(x); end; function TEditBoxForm.DoCalculate(CalcStr : string) : string; var FParser: TFPExpressionParser; parserResult: TFPExpressionResult; begin result := ''; if length(CalcStr) < 1 then exit(''); if CalcStr[length(CalcStr)] = '=' then CalcStr := copy(CalcStr, 1, length(CalcStr)-1); FParser := TFPExpressionParser.Create(nil); try try FParser.Identifiers.AddFunction('tan', 'F', 'F', @ExprTan); FParser.Builtins := [bcMath]; FParser.Expression := CalcStr; parserResult := FParser.Evaluate; case parserResult.ResultType of rtInteger : result := inttostr(parserResult.ResInteger); rtFloat : result := floattostrf(parserResult.ResFloat, ffFixed, 0, 3); end; finally FParser.Free; end; except on E: EExprParser do showmessage(E.Message); end; end; RESOURCESTRING rsUnabletoEvaluate = 'Unable to find an expression to evaluate'; // Called from a Ctrl-E, 'Equals', maybe 'Evaluate' ? Anyway, directs to appropriate // methods. procedure TEditBoxForm.InitiateCalc(); var AnsStr : string; begin if Kmemo1.blocks.RealSelLength > 0 then begin if not ComplexCalculate(AnsStr) then exit; AnsStr := '=' + AnsStr; end else if not SimpleCalculate(AnsStr) then if not ColumnCalculate(AnsStr) then exit; if AnsStr = '' then showmessage(rsUnabletoEvaluate) else begin //debugln('KMemo1.SelStart=' + inttostr(KMemo1.SelStart) + 'KMemo1.RealSelStart=' + inttostr(KMemo1.RealSelStart)); KMemo1.SelStart := KMemo1.Blocks.RealSelEnd; KMemo1.SelLength := 0; KMemo1.Blocks.InsertPlainText(KMemo1.SelStart, AnsStr); KMemo1.SelStart := KMemo1.SelStart + length(AnsStr); KMemo1.SelLength := 0; //debugln('KMemo1.SelStart=' + inttostr(KMemo1.SelStart) + 'KMemo1.RealSelStart=' + inttostr(KMemo1.RealSelStart)); end; end; // Returns all text in a para, 0 says current one, 1 previous para etc ... function TEditBoxForm.PreviousParagraphText(const Backby : integer) : string; var BlockNo, StopBlockNo, Index : longint; begin Result := ''; StopBlockNo := KMemo1.NearestParagraphIndex; // if we are on first line, '1'. Index := BackBy + 1; // we want to overshoot BlockNo := StopBlockNo; while Index > 0 do begin dec(BlockNo); dec(Index); if BlockNo < 1 then begin debugln('underrun1'); exit; end; // its all empty up there .... while not Kmemo1.Blocks.Items[BlockNo].ClassNameIs('TKMemoParagraph') do begin dec(BlockNo); if BlockNo < 1 then begin debugln('Underrun 2'); exit; end; end; if Index = 1 then StopBlockNo := BlockNo; // almost there yet ? end; inc(BlockNo); while BlockNo < StopBlockNo do begin Result := Result + Kmemo1.Blocks.Items[BlockNo].Text; inc(BlockNo); end; //debugln('PREVIOUS BlockNo=' + inttostr(BlockNo) + ' StopBlockNo=' + inttostr(StopBlockNo)); end; // Return content of paragraph that caret is within, up to caret pos. function TEditBoxForm.ParagraphTextTrunc() : string; var BlockNo, StopBlockNo, PosInBlock : longint; begin Result := ''; StopBlockNo := kmemo1.Blocks.IndexToBlockIndex(KMemo1.RealSelEnd, PosInBlock); if StopBlockNo < 0 then StopBlockNo := 0; BlockNo := StopBlockNo-1; while (BlockNo > 0) and (not Kmemo1.Blocks.Items[BlockNo].ClassNameIs('TKMemoParagraph')) do dec(BlockNo); // debugln('BlockNo=' + inttostr(BlockNo) + ' StopBlock=' + inttostr(StopBlockNo) + ' PosInBlock=' + inttostr(PosInBlock)); if BlockNo > 0 then inc(BlockNo); if BlockNo < 0 then BlockNo := 0; if (BlockNo > StopBlockNo) then exit; while BlockNo < StopBlockNo do begin Result := Result + Kmemo1.Blocks.Items[BlockNo].Text; inc(BlockNo); end; if (PosInBlock > 0) then begin Result := Result + copy(KMemo1.Blocks.Items[BlockNo].Text, 1, PosInBlock); end; end; // Looks for a number at both begining and end of string. Ret empty ones if unsuccessful function TEditBoxForm.FindNumbersInString(AStr: string; out AtStart, AtEnd : string) : boolean; var Index : integer = 1; begin if AStr = '' then exit(false); AtStart := ''; AtEnd := ''; while AStr[length(AStr)] = ' ' do delete(AStr, Length(AStr), 1); // remove trailing spaces while Index <= length(AStr) do begin if AStr[Index] in ['0'..'9', '.', '-'] then AtStart := AtStart + AStr[Index] else break; inc(Index); end; if AtStart = '-' then Atstart := ''; // Just a - is not useful Index := length(AStr); while Index > 0 do begin if AStr[Index] in ['0'..'9', '.', '-'] then AtEnd := AStr[Index] + AtEnd else break; dec(Index); end; if AtEnd = '-' then AtEnd := ''; // Just a - is not useful result := (AtStart <> '') or (AtEnd <> ''); end; // Tries to find a column of numbers above, trying to rhs, then lhs. // if we find tow or more lines, use it. function TEditBoxForm.ColumnCalculate(out AStr : string) : boolean; var TheLine, CalcStrStart, CalcStrEnd : string; AtStart, AtEnd : string; // strings that hold a token, if found at start or end of line Index : integer = 1; StartDone : boolean = False; EndDone : boolean = False; begin AStr := ''; // The string we will do our calc on CalcStrStart := ''; CalcStrEnd := ''; repeat // until we have a unusable line both left and right. TheLine := PreviousParagraphText(Index); FindNumbersInString(TheLine, AtStart, AtEnd); //debugln('Scanned string [' + TheLine + '] and found [' + AtStart + '] and [' + atEnd + ']'); if AtEnd = '' then if StartDone then break else EndDone := True; if AtStart = '' then if EndDone then break else StartDone := True; // record that no more tokens at Start will be used if (AtStart <> '') and (not StartDone) then if CalcStrStart = '' then CalcStrStart := AtStart else CalcStrStart := CalcStrStart + ' + ' + AtStart; if (AtEnd <> '') and (not EndDone) then if CalcStrEnd = '' then CalcStrEnd := AtEnd else CalcStrEnd := CalcStrEnd + ' + ' + AtEnd; inc(Index); until (AtStart = '') and (AtEnd = ''); // Note, we break before that situation anyway ! if not EndDone then AStr := CalcStrEnd; if not StartDone then AStr := CalcStrStart; AStr := DoCalculate(AStr); Result := (AStr <> ''); end; // Assumes that the current selection contains a complex calc expression. function TEditBoxForm.ComplexCalculate(out AStr : string) : boolean; var BlockNo, Temp : longint; begin BlockNo := kmemo1.Blocks.IndexToBlockIndex(KMemo1.RealSelEnd-1, Temp); if kmemo1.blocks.Items[BlockNo].ClassNameIs('TKMemoParagraph') then begin // debugln('Para cleanup in progress'); Temp := KMemo1.SelLength; Kmemo1.SelStart := KMemo1.Blocks.RealSelStart; KMemo1.SelLength := Temp-1; end; if abs(KMemo1.SelLength) < 1 then exit(false); // debugln('Complex Calc [' + KMemo1.Blocks.SelText + ']'); AStr := DoCalculate(KMemo1.Blocks.SelText); Result := (AStr <> ''); end; const CalcChars : set of char = ['0'..'9'] + ['^', '*', '-', '+', '/'] + ['.', '=', ' ', '(', ')']; // acts iff char under curser or to left is an '=' function TEditBoxForm.SimpleCalculate(out AStr : string) : boolean; var Index : longint; GotEquals : boolean = false; begin Result := False; AStr := ParagraphTextTrunc(); // look for equals while length(AStr) > 0 do begin if AStr[length(AStr)] = ' ' then begin delete(AStr, length(AStr), 1); continue; end; if AStr[length(AStr)] = '=' then begin delete(AStr, length(AStr), 1); GotEquals := True; continue; end; if not GotEquals then exit else break; end; // if to here, we have a string that used to start with =, lets see what else it has ? Index := length(AStr); if Index = 0 then exit; while AStr[Index] in CalcChars do begin dec(Index); if Index < 1 then break; end; delete(AStr, 1, Index); debugln('SimpleCalc=[' + AStr + ']'); // Special case exists, if the calc string was following some text terminated with // a '.', we end up a string starting with '. ' and thats bad. if copy(AStr, 1, 2) = '. ' then delete(AStr, 1, 2); AStr := DoCalculate(AStr); exit(AStr <> ''); end; // ===================== K M E M O K E Y S T R O K E S ===================== procedure TEditBoxForm.KMemo1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin MouseDownPos := KMemo1.CaretPos; // regional record in case we are doing shift click //debugln('Mousedown ' + dbgs(KMemo1.CaretPos)); //{$ifdef LCLCOCOA} if ssCtrl in Shift then PopupMenuRightClick.popup; //{$else} if Button = mbRight then PopupMenuRightClick.PopUp; //{$endif} end; { Any change to the note text and this gets called. So, vital it be quick } procedure TEditBoxForm.KMemo1Change(Sender: TObject); begin if not Ready then exit(); // don't do any of this while starting up. MarkDirty(); TimerHouseKeeping.Enabled := False; TimerHouseKeeping.Enabled := True; // HouseKeeping is now driven by a timer; end; procedure TEditBoxForm.KMemo1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); var TrailOffset, BlockNo, // Will hold block number cursor is under. LeadOffset : longint; LeadingBullet, // The para immediatly previous to cursor is a bullet UnderBullet, // We are under a Para and its a Bullet TrailingBullet, // We are under Text but the block behind us is a Bullet. FirstChar : boolean; // Cursor is under the first character of a line of text. NoBulletPara : boolean = false; begin if not Ready then begin // Will this help with issue #279 if [ssCtrl] = shift then Key := 0; exit(); // should we drop key on floor ???? end; // don't let any ctrl char get through the kmemo on mac {$ifdef DARWIN} if [ssCtrl] = Shift then begin case Key of VK_1 : AlterFont(ChangeSize, Sett.FontSmall); VK_2 : AlterFont(ChangeSize, Sett.FontNormal); VK_3 : AlterFont(ChangeSize, Sett.FontLarge); VK_4 : AlterFont(ChangeSize, Sett.FontHuge); end; Key := 0; exit; end; if ([ssAlt, ssShift] = Shift) and ((Key = VK_RIGHT) or (Key = VK_LEFT)) then exit; // KMemo - extend selection one word left or right {$endif} if (Key = VK_ESCAPE) and Sett.CheckEscClosesNote.Checked then close; // Will do normal save stuff first. // Record this event in the Undoer if its ssShift or empty set, rest are ctrl, meta etc .... if Use_Undoer and (([ssShift] = Shift) or ([] = Shift)) then // while we pass presses like this to undoer, not all are Undoer.RecordInitial(Key); // used, onKeyPress must follow and it gets only text type keys. {$ifndef DARWIN} // -------------- Shift ------------------- if [ssShift] = shift then begin if (Key = VK_LEFT) or (Key = VK_RIGHT) then exit; // KMemo - extend selection one char left or right if (Key = VK_F3) then begin key := 0; if (EditFind.Text <> rsMenuSearch) then SpeedLeftClick(self); end; if (Key = VK_RETURN) then begin // Shift-Enter, intended to do so paragraph things but messes badly with bullets. #305 Key := 0; exit(); end; end; {$endif} // -------------- Control ------------------ if {$ifdef Darwin}[ssMeta] = Shift {$else}[ssCtrl] = Shift{$endif} then begin case key of VK_Return, VK_G : begin key := 0; if (EditFind.Text <> rsMenuSearch) then SpeedRightClick(self); end; VK_Q : MainForm.close(); VK_1 : AlterFont(ChangeSize, Sett.FontSmall); VK_2 : AlterFont(ChangeSize, Sett.FontNormal); VK_3 : AlterFont(ChangeSize, Sett.FontLarge); VK_4 : AlterFont(ChangeSize, Sett.FontHuge); VK_B : AlterFont(ChangeBold); VK_I : AlterFont(ChangeItalic); VK_S : AlterFont(ChangeStrikeOut); VK_T : AlterFont(ChangeFixedWidth); VK_H : AlterFont(ChangeColor); VK_U : AlterFont(ChangeUnderLine); VK_F : begin Key := 0; MenuItemFindClick(self); end; VK_L : SpeedButtonLinkClick(Sender); VK_V : begin if Use_Undoer then Undoer.AddPasteOrCut(); exit; end; // Must exit to prevent setting Key to 0 VK_X : begin if Use_Undoer then Undoer.AddPasteOrCut(True); exit; end; // Must exit to prevent setting Key to 0 VK_Z : if Use_Undoer then Undoer.UnDo; // Note : Ctrl-Z does not go through to KMemo VK_Y : if Use_Undoer then Undoer.Redo; // Note : Ctrl-Y does not go through to KMemo VK_D : InsertDate(); VK_N : SearchForm.OpenNote(''); VK_E : InitiateCalc(); VK_F4 : close; // close just this note, normal saving will take place VK_C, VK_A, VK_HOME, VK_END, VK_UP, VK_DOWN, VK_LEFT, VK_RIGHT, VK_PRIOR, VK_NEXT, VK_INSERT : exit; end; Key := 0; // so we don't get a ctrl key character in the text exit(); end; { Control-Z bug hex 1A, 26 is reported to be getting past above filter and ending up in a note #279. } // ------------- Alt (or Option in Mac) ------------------ if [ssAlt] = Shift then begin case key of {$ifdef DARWIN} VK_H : begin AlterFont(ChangeColor); ; Key := 0; end; {$endif} VK_RIGHT : begin BulletControl(True); Key := 0; end; VK_LEFT : begin BulletControl(False); Key := 0; end; VK_Return : if (EditFind.Text <> rsMenuSearch) then begin Key := 0; SpeedLeftClick(self); end; end; exit(); end; // ------------------ Control and Shift (or, Mac, Command and Shift) ---------------- if {$ifdef Darwin}[ssMeta, ssShift]{$else}[ssCtrl, ssShift]{$endif} = Shift then begin case Key of VK_F : SpeedButtonSearchClick(self); // Search all notes VK_G : if (EditFind.Text <> rsMenuSearch) then SpeedLeftClick(self); VK_Z : if Use_Undoer then Undoer.UnDo; {$ifndef DARWIN} VK_RIGHT, VK_LEFT : exit; // KMemo knows how to do this, select word ... {$endif} end; Key := 0; exit(); end; if Key = VK_TAB then begin // ToDo : Tabs do not work as expected KMemo1.InsertChar(KMemo1.Blocks.RealSelStart, ' '); KMemo1.InsertChar(KMemo1.Blocks.RealSelStart, ' '); KMemo1.InsertChar(KMemo1.Blocks.RealSelStart, ' '); KMemo1.InsertChar(KMemo1.Blocks.RealSelStart, ' '); Key := 0; exit; end; if Key = VK_F3 then begin key := 0; if (EditFind.Text <> rsMenuSearch) then SpeedRightClick(self); end; if Key <> 8 then exit(); // We are watching for a BS on a Bullet Marker // Mac users don't have a del key, they use a backspace key thats labled 'delete'. Sigh... if KMemo1.Blocks.RealSelEnd > KMemo1.Blocks.RealSelStart then exit(); if not NearABulletPoint(LeadingBullet, UnderBullet, TrailingBullet, FirstChar, NoBulletPara, BlockNo, TrailOffset, LeadOffset) then exit(); if (not FirstChar) and (not UnderBullet) then exit(); // We do have to act, don't pass key on. Key := 0; Ready := False; MarkDirty(); TimerHouseKeeping.Enabled := False; TimerHouseKeeping.Enabled := True; // KMemo1.Blocks.LockUpdate; Do not lock because we move the cursor down here. if UnderBullet and (not FirstChar) then begin // case a KMemo1.ExecuteCommand(ecDeleteLastChar); if Verbose then debugln('Case a'); Ready := True; exit(); end; // anything remaining must have FirstChar if TrailingBullet and (not NoBulletPara) then begin // case b if Verbose then debugln('Case b or e'); if UnderBullet then // case e TrailOffset := 0; if kmemo1.blocks.Items[BlockNo+TrailOffset].ClassNameIs('TKMemoParagraph') then SetBullet(TKMemoParagraph(kmemo1.blocks.Items[BlockNo+TrailOffset]), False) // TKMemoParagraph(kmemo1.blocks.Items[BlockNo+TrailOffset]).Numbering := pnuNone else DebugLn('ERROR - this case b block should be a para'); Ready := True; exit(); end; // anything remaining is outside bullet list, looking in. Except if Trailing is set... if kmemo1.blocks.Items[BlockNo].ClassNameIs('TKMemoParagraph') then begin KMemo1.Blocks.Delete(BlockNo); // delete this blank line. if TrailingBullet then begin KMemo1.ExecuteCommand(ecUp); KMemo1.ExecuteCommand(ecLineEnd); if Verbose then debugln('Case x'); end else begin if UnderBullet then begin // this test is wrong, real test is are we at end of text ? if Verbose then DebugLn('Case y'); KMemo1.Blocks.AddParagraph(); // Maybe only need add that if at end of text, NearABulletPoint() could tell us ? KMemo1.ExecuteCommand(ecDown); end else if Verbose then debugln('Case c'); end; end else begin // merge the current line into bullet above. if kmemo1.blocks.Items[BlockNo+TrailOffset].ClassNameIs('TKMemoParagraph') then SetBullet(TKMemoParagraph(kmemo1.blocks.Items[BlockNo+TrailOffset]), True) // TKMemoParagraph(kmemo1.blocks.Items[BlockNo+TrailOffset]).Numbering := pnuBullets; else DebugLn('ERROR - this case d block should be a para'); if kmemo1.blocks.Items[BlockNo-Leadoffset].ClassNameIs('TKMemoParagraph') then begin KMemo1.Blocks.Delete(BlockNo-LeadOffset); if Verbose then debugln('Case d'); end; end; Ready := True; // most of the intevention paths through this method take ~180mS on medium powered linux laptop end; procedure TEditBoxForm.KMemo1KeyPress(Sender: TObject; var Key: char); begin if Use_Undoer then Undoer.AddKeyPress(Key); end; procedure TEditBoxForm.KMemo1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); begin if Use_Undoer then Undoer.AddKeyUp(Key, Shift); end; // ======= I M P O R T I N G and E X P O R T I N G F U N C T I O N S ======= procedure TEditBoxForm.ImportNote(FileName: string); var Loader : TBLoadNote; // T1, T2, T3, T4, T5 : qword; // Temp time stamping to test speed W, H : integer; begin // Timing numbers below using MyRecipes on my Dell linux laptop. For local comparison only ! // Note QT5 times quite a lost faster, Loading is slow and so is resizing ! Sept 2022, updated and revised April 2023 // Very useful to set default colors and size of form BEFORE loading note. // T1 := gettickcount64(); GetHeightWidthOfNote(FileName, H, W); Width := W; Height := H; Loader := TBLoadNote.Create(); Loader.FontNormal:= Sett.FontNormal; Loader.FontSize:= Sett.FontNormal; KMemo1.Blocks.LockUpdate; KMemo1.Clear; SetTheColors(); // T2 := gettickcount64(); Loader.LoadFile(FileName, KMemo1); // 100mS GTK2, without locking its all time and a lot of it ! // T3 := gettickcount64(); Createdate := Loader.CreateDate; //Ready := true; Caption := Loader.Title; // if Sett.ShowIntLinks or Sett.CheckShowExtLinks.checked then // CheckForLinks(True); // 12mS (14ms GTK2) KMemo1.Blocks.UnlockUpdate; // 140mS // T4 := gettickcount64(); Left := Loader.X; Top := Loader.Y; AdjustFormPosition(); Loader.Free; // 0mS TimerHouseKeeping.Enabled := False; // we have changed note but no housekeeping reqired // T5 := gettickcount64(); // debugln('Load Note=' + inttostr(T2 - T1) + 'mS ' + inttostr(T3 - T2) + 'mS ' + inttostr(T4 - T3) + 'mS ' + inttostr(T5 - T4) + 'mS '); // debugln('ImportNote Total=' + inttostr(T5 - T1) + 'mS '); end; procedure TEditBoxForm.CleanUTF8(); function BitSet(Value : byte; TheBit : integer) : boolean; // theBit 0-7 begin Result := ((Value shr TheBit) and 1) = 1; end; function CleanedUTF8(var TheText : string) : boolean; var cnt : integer = 1; NumbBytes : integer = 0; i : integer; begin Result := false; while Cnt <= TheText.Length do begin if BitSet(byte(TheText[cnt]), 7) then begin // OK, we have a utf8 code. It will need at least one extra byte, maybe 2 or 3 NumbBytes := 1; if BitSet(byte(TheText[cnt]), 5) then inc(NumbBytes); if BitSet(byte(TheText[cnt]), 4) then inc(NumbBytes); if Cnt + NumbBytes > TheText.Length then begin // enough bytes remaining .... delete(TheText, Cnt, 1); Result := true; continue; end; for i := 1 to NumbBytes do begin // are they the right sort of bytes ? if not BitSet(byte(TheText[cnt + i]), 7) then begin delete(TheText, Cnt, 1); // NumbBytes := -1; // so the dec below does not skip a char Result := true; break; end; end; Cnt := Cnt + NumbBytes; end; inc(cnt); end; end; var i : integer = 0; AStr : string; TB : TKMemoTextBlock; begin KMemo1.blocks.LockUpdate; while i < Kmemo1.blocks.count do begin AStr := Kmemo1.Blocks.Items[i].text; if KMemo1.Blocks.Items[i].ClassNameis('TKMemoTextBlock') or KMemo1.Blocks.Items[i].ClassNameIs('TKMemoHyperlink') then begin if CleanedUTF8(AStr) then begin TB := KMemo1.Blocks.AddTextBlock(AStr, i); TB.TextStyle.Font := TKMemoTextBlock(KMemo1.blocks.Items[i+1]).TextStyle.Font; TB.TextStyle.Brush := TKMemoTextBlock(KMemo1.blocks.Items[i+1]).TextStyle.Brush; KMemo1.Blocks.Delete(i+1); end; end; inc(i); end; KMemo1.blocks.UnLockUpdate; end; // ===================================== S A V I N G =========================== { When changes are made to note content, a timer is triggered and extended as user types. Sooner or later, the timer demands SaveTheNote() be called. It locks kmemo, builds a list of its content using Saver, TBSaveNote (which is badely named, it generates the xml to save but does not, itself, save to disk. Unlocks. It calls SearchForm.UpdateList() OR if its because we are closing the note and note is clean, goes diret to TheMainNoteLister with just an updated LCD. Note, the note has not hit the disk yet ! That list is passed to SaveStringList, it makes a new thread that normalises content of string list and then writes it to disk. } {$define SAVETHREAD} function TEditBoxForm.SaveStringList(const SL: TStringList; Loc : TNoteUpdateRec) : boolean; var {$ifdef SAVETHREAD} TheSaveThread : TSaveThread; {$else} Normaliser : TNoteNormaliser; WBufStream : TWriteBufStream; FileStream : TFileStream; {$ENDIF} begin if BusySaving then exit(False); BusySaving := True; Result := True; {$ifdef SAVETHREAD} TheSaveThread := TSaveThread.Create(true); TheSaveThread.TheLoc := Loc; TheSaveThread.TheSL := Sl; TheSaveThread.Start; // It will clean up after itself. {$else} Normaliser := TNoteNormaliser.Create; Normaliser.NormaliseList(SL); Normaliser.Free; SL.Add(Footer(Loc)); // TWriteBufStream, TFileStream preferable to BufferedFileStream because of a lighter memory load. FileStream := TFileStream.Create(Loc.FFName, fmCreate); //FileStream := TFileStream.Create('/home/dbannon/savethread.note', fmCreate); WBufStream := TWriteBufStream.Create(FileStream, 4096); // 4K seems about right on Linux. try try SL.SaveToStream(WBufStream); except on E:Exception do begin Debugln('ERROR, failed to save note : ' + E.Message); WBufStream.Free; FileStream.Free; SL.Free; end; end; finally WBufStream.Free; FileStream.Free; SL.Free; end; BusySaving := False; {$ENDIF} end; procedure TEditBoxForm.SaveTheNote(WeAreClosing : boolean = False); var Title : string; Saver : TBSaveNote; SL : TStringList; OldFileName : string =''; Loc : TNoteUpdateRec; NoteContent : string = ''; // Might hold a lowercase text version of note for searcing purposes. LineNumb : integer = 0; FName : string; ItsANewNote : boolean = false; //T1, T2, T3, T4, T5, T6, T7 : qword; // Timing shown is for One Large Note. begin //TheMainNoteLister.DumpNoteNoteList('TEditBoxForm.SaveTheNote ' + NoteTitle); if BusySaving then begin MainForm.ShowNotification('Failed to Auto Save', 3000); // inform user via notifications exit; end; //T1 := gettickcount64(); Saver := Nil; if KMemo1.ReadOnly then exit(); if length(NoteFileName) = 0 then begin NoteFileName := Sett.NoteDirectory + GetAFilename(); ItsANewNote := True; end; if (not WeAreClosing) // just checking for valid ID here and (Sett.NoteDirectory = CleanAndExpandDirectory(ExtractFilePath(NoteFileName))) then begin // Check name of Repo note, not SNM. UTF8 OK if not IDLooksOK(ExtractFileNameOnly(NoteFileName)) then if mrYes = QuestionDlg('Invalid GUID', 'Give this note a new GUID Filename (recommended) ?', mtConfirmation, [mrYes, mrNo], 0) then begin OldFileName := NoteFileName; NoteFileName := Sett.NoteDirectory + GetAFilename(); Loc.LastChangeDate:= TheMainNoteLister.GetLastChangeDate(ExtractFileNameOnly(OldFileName)); SearchForm.UpdateList(CleanCaption(), Loc.LastChangeDate, NoteFileName, self); // some timewasting menu rewrite ?? Debugln('We have just registered a new name for that note with invalid GUID'); end; end; if TemplateIs <> '' then begin SL := TStringList.Create(); SL.Add(TemplateIs); TheMainNoteLister.SetNotebookMembership(ExtractFileNameOnly(NoteFileName) + '.note', SL); SL.Free; TemplateIs := ''; end; Saver := TBSaveNote.Create(); Saver.CreateDate := CreateDate; // Misnamed now, does not save, just puts xml into SL if not GetTitle(Title) then exit(); // If title has changed, we make a backup copy. if TitleHasChanged then begin SearchForm.BackupNote(NoteFileName, 'ttl'); TitleHasChanged := False; end; Caption := Title; KMemo1.Blocks.LockUpdate; // to prevent changes during read of kmemo //T2 := GetTickCount64(); SL := TStringList.Create(); try Saver.ReadKMemo(NoteFileName, Title, KMemo1, SL); // Puts all the content into the StringList, SL //T3 := GetTickCount64(); if Dirty and (not SingleNoteMode) and Sett.AutoSearchUpdate then begin // SLOW ! Replace the search Content in note lister while LineNumb < KMemo1.Blocks.LineCount do begin NoteContent := NoteContent + lowercase(Kmemo1.blocks.LineText[LineNumb]); inc(LineNumb); if NoteContent[high(NoteContent)] = #182 then begin // Line returns with two char line ending delete(NoteContent, High(NoteContent), 1); // delete the 182 NoteContent[High(NoteContent)] := #10; // replace the 194 end; end; end; //T4 := GetTickCount64(); finally KMemo1.Blocks.UnLockUpdate; if Saver <> Nil then Saver.Destroy; Caption := CleanCaption(); end; //T5 := GetTickCount64(); Loc.Width:=inttostr(Width); Loc.Height:=inttostr(Height); Loc.X := inttostr(Left); Loc.Y := inttostr(Top); Loc.OOS := booltostr(WeAreClosing, True); Loc.CPos:='1'; loc.FFName := NoteFileName; loc.CreateDate := CreateDate; if Dirty or SingleNoteMode then begin // In SingeNoteMode, there is no NoteLister, so date is always updated. Loc.LastChangeDate:= TB_GetLocalTime(); // Next line makes a partial entry for a new note. SearchForm.UpdateList(CleanCaption(), Loc.LastChangeDate, NoteFileName, self); // 6mS - 8mS timewasting menu rewrite ?? No usually now //debugln('TEditBoxForm.SaveTheNote - called SearchForm.UpdateList with ' + CleanCaption()); end else Loc.LastChangeDate // Must be closing. := TheMainNoteLister.GetLastChangeDate(ExtractFileNameOnly(NoteFileName)); // Dec 2022 - I moved the following block down here to ensure a new note is in note lister before setting content if Dirty and (not SingleNoteMode) and Sett.AutoSearchUpdate then begin // This is quick, LineNumb := TheMainNoteLister.NoteList.Count -1; // start searching at end of list cos thats where new notes live FName := ExtractFileName(NoteFileName); while LineNumb > -1 do begin // If its a new note, we created a partial entry a few lines up. if TheMainNoteLister.NoteList[LineNumb]^.ID = FName then begin TheMainNoteLister.NoteList[LineNumb]^.Content := NoteContent; if ItsaNewNote then SearchForm.MarkLinkOnOpenNotes(); // In case note was created as a new Link from another note. break; end; dec(LineNumb); end; if LineNumb = -1 then debugln('TEditBoxForm.SaveTheNote did not find note in notelister to insert content into. ' + NoteTitle); end; if SaveStringList(SL, Loc) then Dirty := False; // Note, thats not a guaranteed good save, //debugln({$I %CURRENTROUTINE%}, '() ', {$I %FILE%}, ', ', 'line:', {$I %LINE%}, ' : ', 'At end, dirty=' + booltostr(Dirty, true)); //T6 := GetTickCount64(); //debugln('Save Note Initial=' + inttostr(T2-T1) + ' Saver=' + inttostr(T3-T2) // + ' BuildContent=' + Inttostr(T4-T3) + ' ContentToNoteLister=' + inttostr(T5-T4) + ' SendToSaveStringList=' + (T6-T5).tostring); // Save Note Initial=0 Saver=4 BuildContent=4 ContentToNoteLister=0 SendToSaveStringList=0 with locking disabled // ToDo : Building search content is pretty slow ?? // Move into SaveThread would require passing kmemo there too but thats probably the answer // maybe review the lines approach ? Saver is doing a lot more .... (* {$ifdef SAVETHREAD} debugln('Total time to save threaded is ' + inttostr(T5-T1)); {$else} debugln('Total time to save UN-threaded is ' + inttostr(T5-T1)); {$endif} *) end; function TEditBoxForm.NewNoteTitle(): ANSIString; begin Result := 'New Note ' + FormatDateTime('YYYY-MM-DD hh:mm:ss.zzz', Now); end; function TEditBoxForm.GetAFilename() : ANSIString; var GUID : TGUID; begin CreateGUID(GUID); Result := copy(GUIDToString(GUID), 2, 36) + '.note'; end; end. // As UpdateNote does not record Notebook membership, abandon it for now. // Maybe come back later and see if it can be patched, its probably quicker. // Was only called on a clean note .... (* function TEditBoxForm.UpdateNote(NRec : TNoteUpdaterec) : boolean; var InFile, OutFile: TextFile; {NoteDateSt, }InString, TempName : string; begin if not fileexists(NRec.FFName) then exit(false); // if its not there, the note has just been deleted TempName := AppendPathDelim(Sett.NoteDirectory) + 'tmp'; if not DirectoryExists(TempName) then CreateDir(AppendPathDelim(tempname)); TempName := tempName + pathDelim + 'location.note'; // generate a random name ?? AssignFile(InFile, NRec.FFName); AssignFile(OutFile, TempName); try try Reset(InFile); Rewrite(OutFile); while not eof(InFile) do begin readln(InFile, InString); if (Pos('<cursor-position>', InString) > 0) then break; writeln(OutFile, InString); end; // OK, we are looking atthe part we want to change, ignore infile, we know better. writeln(OutFile, ' <cursor-position>' + NRec.CPos + '</cursor-position>'); writeln(OutFile, ' <selection-bound-position>1</selection-bound-position>'); writeln(OutFile, ' <width>' + NRec.Width + '</width>'); writeln(OutFile, ' <height>' + NRec.height + '</height>'); writeln(OutFile, ' <x>' + NRec.X + '</x>'); writeln(OutFile, ' <y>' + NRec.Y + '</y>'); writeln(OutFile, ' <open-on-startup>' + NRec.OOS + '</open-on-startup>'); //Must see if this note is in a notebook, if so, record here. writeln(OutFile, '</note>'); finally CloseFile(OutFile); CloseFile(InFile); end; except on E: EInOutError do begin debugln('File handling error occurred updating clean note location. Details: ' + E.Message); exit(False); end; end; result := CopyFile(TempName, Nrec.FFName); // wrap this in a Try if result = false then debugln('ERROR moving [' + TempName + '] to [' + NRec.FFName + ']'); end; *) ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������tomboy-ng_0.39-1/source/mainunit.pas����������������������������������������������������������������0000644�0001750�0001750�00000104151�14551457644�017272� 0����������������������������������������������������������������������������������������������������ustar �dbannon�������������������������dbannon����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������unit Mainunit; { Copyright (C) 2017-2022 David Bannon License: This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html ------------------ The Main unit for the application, it displayes the small splash screen (if enabled), manages some of the command line switches, runs the IPC server to communicate with other instances, starts single note mode. Makes some decisions about Windows Dark Theme. Manages display of SysTrayIcon (but events, ie clicks, are in SearchUnit). Possible sensible to move the TrayIcon and its popupMenu to Search Unit, then have a single method responsible for creating and setting it up. } {$mode objfpc}{$H+} { HISTORY 2018/05/12 Extensive changes - MainUnit is now just that. This is not the same unit that used this name previously! 2018/05/19 Control if we allow opening window to be dismissed and show TrayIcon and MainMenu. 2018/05/20 Alterations to way we startup, wrt mainform status report. 2018/05/20 Set the recent menu items caption to be 'empty' in case user looks before having set a notes directory. 2018/06/02 Added a cli switch to debug sync 2018/06/19 Got some stuff for singlenotemode() - almost working. 2018/06/22 As above but maybe working now ? DRB 2018/07/04 Display number of notes found and a warning if indexing error occurred. 2018/07/11 Added --version and --no-splash to options, this form now has a main menu and does not respond to clicks anywhere with the popup menu, seems GTK does not like sharing menus (eg between here and the trayIcon) in gtk3 ! So, in interests of uniformity, everyone gets a Main Menu and no Popup. 2018/11/01 Now include --debug-log in list of INTERAL switches. 2018/12/02 Now support Alt-[Left, Right] to turn off or on Bullets. 2018/12/03 Added show splash screen to settings, -g or an indexing error will force show 2019/03/19 Added a checkbox to hide screen on future startups 2019/03/19 Added setting option to show search box at startup 2019/04/07 Restructured Main and Popup menus. Untested Win/Mac. 2019/04/13 Mv numb notes to tick line, QT5, drop CheckStatus() 2019/05/06 Support saving pos and open on startup in note. 2019/05/14 Display strings all (?) moved to resourcestrings 2019/06/11 Moved an ifdef 2019/07/21 Added a TitleColour for dark theme 2019/08/20 Linux only, looks for (translated) help files in config dir first. 2019/09/6 Button to download Help Notes in non-English 2019/09/21 Restructured model for non-english help notes, names in menus ! 2019/10/13 Prevent Dismiss if desktop is Enlightenment, in OnCreateForm() 2019/11/05 Don't treat %f as a command line file name, its an artifact 2019/11/08 Tidy up building GTK3 and Qt5 versions, cleaner About 2019/11/20 Don't assign PopupMenu to TrayIcon on (KDE and Qt5) 2019/12/08 New "second instance" model. 2019/12/11 Heavily restructured Startup, Main Menu everywhere ! 2019/12/20 Added option --delay-start for when desktop is slow to determine its (dark) colours 2020/03/30 Allow user to set display colours. 2020/04/10 Make help files non modal 2020/04/12 Force sensible sizes for help notes. 2020/04/28 Added randomize to create, need it for getlocaltime in settings. 2020/05/16 Don't prevent closing of splash screen. 2020/05/23 Don't poke SingleNoteFileName in during create, get it from Mainunit in OnCreate() 2020/05/26 Improved tabbing 2020/06/11 remove unused closeASAP, open splash if bad note. 2020/07/09 New help notes location. A lot moved out of here. 2020/11/07 Fix multiple About Boxes (via SysTray) issue. Untested on Win/Mac 2020/11/18 Changed other two buttons to BitBtn so qt5 looks uniform. 2021/01/04 Pointed Tomdroid menu to tomdroidFile. 2021/01/23 We now test for a SysTray, show warning and Help is not there. 2021/04/01 Removed "have config", we always have config, if we cannot save it, user knows.... 2021/05/11 On Gnome Linux, test for libappindicator3 and appindicator shell plugin 2021/05/15 On Gnome, if plugin is present but disabled, offer to enable it for user. 2021/05/19 If libappindicator is not present, check for libayatana-appindicator, but only if lcl is patched ! 2021/07/13 Don't do full SysTray check on Gnome with Qt, AccessViolation, just guess. 2021/11/09 Dont consider libayatana unless compiled with > 2.0.12 2022/05/03 Add unix username to IPC pipe. 2022/08/10 Added an about Lazarus to splash screen and simplified the About screen. 2022/10/20 To Avoid calling IndexNotes() from Import, now function, IndexNewNote() 2022/11/14 ShowNotifications() now cross platform. 2023/03/17 Provide better support for dark theme, particularly for Qt5 in qt5ct mode 2023/04/30 Another Gnome (for 44.0) fix, apparently it does not like an empty menu in the trayicon at show. CommandLine Switches --delay-start --debug-log=some.log --dark-theme Windows only, over rides the registery setting. --gnome3 ignored -g --debug-sync Turn on Verbose mode during sync --debug-index Verbose mode when reading the notes directory. --debug-spell Verbose mode when setting up speller --config-dir=<some_dir> Directory to keep config and sync manifest in. -o note_fullfilename --open=<note_fullfilename> Opens, in standalone mode, a note. Don't start the SimpleIPC conversation. --help -h Shows and exits (not implemented) something to divert debug msg to a file ?? something to do more debugging ? --no-splash Do not show the small opening status/splash window on startup --save-exit (Single note only) after import, save and exit. --version Print version no and exit. } interface uses Classes, SysUtils, Forms, Controls, Graphics, Dialogs, Menus, ExtCtrls, StdCtrls, LCLTranslator, DefaultTranslator, Buttons, simpleipc, LCLType, ComCtrls {$ifdef LINUX}, x, xlib, process {$endif} // Relate to testing for SysTray {$IFDEF LCLGTK3}, LazGdk3, LazGLib2 {$ENDIF} // we need declare a GTK3 function that has not yet made it to bindings , fpimage, fpreadjpeg, fppdf, fpparsettf, fpttf, typinfo ; type { TMainForm } TMainForm = class(TForm) // ApplicationProperties1: TApplicationProperties; commented out 2023/12/03,no idea why its here, removed from form too ButtSysTrayHelp: TBitBtn; BitBtnHide: TBitBtn; BitBtnQuit: TBitBtn; ButtMenu: TBitBtn; CheckBoxDontShow: TCheckBox; ImageAboutLaz: TImage; ImageSpellCross: TImage; ImageSpellTick: TImage; ImageNotesDirCross: TImage; ImageSyncCross: TImage; ImageNotesDirTick: TImage; ImageSyncTick: TImage; LabelBadNoteAdvice: TLabel; LabelError: TLabel; Label3: TLabel; Label4: TLabel; Label5: TLabel; LabelNotesFound: TLabel; TrayIcon: TTrayIcon; procedure BitBtnHideClick(Sender: TObject); procedure BitBtnQuitClick(Sender: TObject); procedure ButtMenuClick(Sender: TObject); procedure ButtonCloseClick(Sender: TObject); procedure ButtonConfigClick(Sender: TObject); procedure ButtonDismissClick(Sender: TObject); procedure ButtSysTrayHelpClick(Sender: TObject); procedure CheckBoxDontShowChange(Sender: TObject); procedure FormClose(Sender: TObject; var CloseAction: TCloseAction); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure FormResize(Sender: TObject); procedure FormShow(Sender: TObject); procedure ImageAboutLazClick(Sender: TObject); procedure LabelErrorClick(Sender: TObject); procedure TrayIconClick(Sender: TObject); private AboutFrm : TForm; NoLeftClickOnTrayIcon : boolean; // Is false for everyone except KDE. //HelpList : TStringList; CommsServer : TSimpleIPCServer; // Start SimpleIPC server listening for some other second instance. procedure StartIPCServer(); procedure CommMessageReceived(Sender: TObject); // Attempt to detect we are in a dark theme, sets relevent colours, if main form // is dark, then rest of app will be too except for the KMemo. procedure TestDarkThemeInUse(); {$ifdef LINUX} function CheckGnomeExtras(): boolean; // Test for traditional SysTray, if not successful we call look for the // the things that can be added to a Gnome Desktop to make it work. function CheckForSysTray(): boolean; {$endif} public UseTrayMenu : boolean; PopupMenuSearch : TPopupMenu; // we create these dynamically PopupMenuTray : TPopupMenu; MainTBMenu : TPopupMenu; // Cross Platform, Linux libnotify, others TrayIcon Balloon procedure ShowNotification(const Message: string; ShowTime: integer = 3000); // Called by the Sett unit when it knows the true config path. // procedure SetAltHelpPath(ConfigPath: string); procedure ShowAbout(); { Updates status data on MainForm, tick list } procedure UpdateNotesFound(Numb: integer); { Opens a note in single note mode. Pass a full file name, a bool that closes whole app on exit and one that indicates ReadOnly mode. } procedure SingleNoteMode(FullFileName: string; const CloseOnExit, ViewerMode : boolean); { Shortcut to SingleNoteMode(Fullfilename, True, False) } procedure SingleNoteMode(FullFileName: string); end; // This here temp, it returns the singlenotefilename from CLI Unit. function SingleNoteFileName() : string; // See https://github.com/salvadorbs/AsuiteComps/blob/beab429e63a120d9e2e25c55b64dc092e1c271e9/library/platform/unix/Hotkeys.Manager.Platform.pas#L93 {$IFDEF LCLGTK3} // function gdk_x11_window_get_xid(AX11Window: PGdkWindow): guint32; cdecl; external; function gdk_x11_display_get_xdisplay(AX11Display: PGdkDisplay): PDisplay; cdecl; external; {$ENDIF} var MainForm: TMainForm; implementation {$R *.lfm} { TMainForm } uses LazLogger, LazFileUtils, LazUTF8, settings, ResourceStr, SearchUnit, {$ifdef LCLGTK2} gtk2, gdk2, // required to fix a bug that clears clipboard contents at close. {$endif} {$ifdef LINUX} {$ifdef LCLGTK2} gtk2extra, {$endif} // Relate to testing for SysTray {$ifdef LCLQT5} qt5, {$endif} // Relate to testing for SysTray Clipbrd, {$endif} // Stop linux clearing clipboard on app exit. Editbox, // Used only in SingleNoteMode Note_Lister, cli, LazVersion, tb_utils, {$ifdef LINUX}LCLVersion,{$endif} LCLIntf {$ifdef Linux}, libnotify {$endif} {$ifdef windows}, registry{$endif} ; function SingleNoteFileName() : string; begin result := SingleNoteName; // Thats the global in CLI Unit end; procedure TMainForm.SingleNoteMode(FullFileName: string); begin SingleNoteMode(FullFileName, True, False); end; procedure TMainForm.SingleNoteMode(FullFileName : string; const CloseOnExit, ViewerMode : boolean); var EBox : TEditBoxForm; begin if DirectoryExistsUTF8(ExtractFilePath(FullFileName)) or (ExtractFilePath(FullFileName) = '') then begin try try EBox := TEditBoxForm.Create(Application); //EBox.SingleNoteFileName := SingleNoteFileName(); // Thats the global from CLI Unit, via a local helper function EBox.NoteTitle:= ''; EBox.NoteFileName := FullFileName; Ebox.TemplateIs := ''; EBox.Dirty := False; if ViewerMode then EBox.SetReadOnly(False); EBox.ShowModal; except on E: Exception do begin debugln('!!! EXCEPTION - ' + E.Message); showmessage(E.Message); end; end; finally try FreeandNil(EBox); except on E: Exception do debugln('!!! EXCEPTION - What ? no FreeAndNil ?' + E.Message); end; end; end else begin DebugLn('Sorry, cannot find that directory [' + ExtractFilePath(FullFileName) + ']'); showmessage('Sorry, cannot find that directory [' + ExtractFilePath(FullFileName) + ']'); end; if CloseOnExit then Close; // we also use singlenotemode internally in several places end; // ----------------------------------------------------------------- // S T A R T U P T H I N G S // ----------------------------------------------------------------- procedure TMainForm.FormCreate(Sender: TObject); begin AboutFrm := Nil; Randomize; // used by sett.getlocaltime() //HelpList := Nil; UseTrayMenu := true; if SingleNoteFileName() = '' then StartIPCServer() // Don't bother to check if we are client, cannot be if we are here. else UseTrayMenu := False; {$ifdef LCLCARBON} UseTrayMenu := false; {$endif} if UseTrayMenu then begin PopupMenuTray := TPopupMenu.Create(Self); TrayIcon.PopUpMenu := PopupMenuTray; // SearchForm will populate it when ready // TrayIcon.Show; // Gnome does not like showing it before menu is populated, so, call from SearchForm.create end; LabelBadNoteAdvice.Caption := ''; end; procedure TMainForm.FormDestroy(Sender: TObject); begin freeandnil(CommsServer); // freeandnil(HelpNotes); //if HelpList <> Nil then writeln('Help List has ' + inttostr(HelpList.Count)); // freeandnil(HelpList); end; procedure TMainForm.FormClose(Sender: TObject; var CloseAction: TCloseAction); var {$ifdef LCLGTK2} c: PGtkClipboard; t: string; {$endif} // OutFile : TextFile; AForm : TForm; begin //debugln('TMainForm.FormClose - at user request'); // ToDo : remove this {$ifdef LCLGTK2} c := gtk_clipboard_get(GDK_SELECTION_CLIPBOARD); t := Clipboard.AsText; gtk_clipboard_set_text(c, PChar(t), Length(t)); gtk_clipboard_store(c); {$endif} Sett.AreClosing:=True; if assigned(TheMainNoteLister) then begin AForm := TheMainNoteLister.FindFirstOpenNote(); while AForm <> Nil do begin AForm.close; AForm := TheMainNoteLister.FindNextOpenNote(); end; end; end; procedure TMainForm.CommMessageReceived(Sender : TObject); Var S : String; begin // debugln('Here in Main.CommMessageRecieved, a message was received'); CommsServer .ReadMessage; S := CommsServer .StringMessage; if S = 'SHOWSEARCH' then begin SearchForm.Show; SearchForm.MoveWindowHere(SearchForm.Caption); end else if S.StartsWith('REINDEX') then SearchForm.IndexNewNote(copy(S, 9, 100), False) else debugln('TMainForm.CommMessageReceived - invalid message [' + S + ']'); // eg REINDEX:48480CC5-EC3E-4AA0-8C83-62886DB291FD.note { case S of 'SHOWSEARCH' : begin SearchForm.Show; SearchForm.MoveWindowHere(SearchForm.Caption); end; 'REINDEX' : SearchForm.IndexNotes(); end; } end; procedure TMainForm.StartIPCServer(); begin CommsServer := TSimpleIPCServer.Create(Nil); CommsServer.ServerID:='tomboy-ng' {$ifdef UNIX} + '-' + GetEnvironmentVariable('USER'){$endif}; // on multiuser system, unique CommsServer.OnMessageQueued:=@CommMessageReceived; CommsServer.Global:=True; // anyone can connect CommsServer.StartServer({$ifdef WINDOWS}False{$else}True{$endif}); // start listening, threaded end; resourcestring rsFailedToIndex = 'Failed to index one or more notes.'; {$ifdef LINUX} function TMainForm.CheckGnomeExtras() : boolean; var {$ifndef LCLQT5}H : TLibHandle;{$endif} MayBeNotGnome : boolean = false; PlugInName : string = ''; // holds name if CheckPlugIn found it. function CheckPlugIn(EnabledOnly : boolean) : boolean; var AProcess: TProcess; List : TStringList = nil; begin result := false; AProcess := TProcess.Create(nil); AProcess.Executable:= 'gnome-extensions'; AProcess.Parameters.Add('list'); if EnabledOnly then AProcess.Parameters.Add('--enabled'); //AProcess.Parameters.Add(PlugInName); AProcess.Options := AProcess.Options + [poWaitOnExit, poUsePipes]; try try // Next line raise an exception if gnome-extensions is not installed, it is handled. // ExitStatus for List is always zero so don't bother checking AProcess.Execute; List := TStringList.Create; List.LoadFromStream(AProcess.Output); //debugln(List.Text); if FindInStringList(List, 'ubuntu-appindicators@ubuntu.com') > -1 then // Ubuntu, Debian PlugInName := 'ubuntu-appindicators@ubuntu.com'; if FindInStringList(List, 'appindicatorsupport@rgcjonas.gmail.com') > -1 then // fedora PlugInName := 'appindicatorsupport@rgcjonas.gmail.com'; except on E: EProcess do MayBeNotGnome := True; // Says that gnome-extensions is not installed. end; finally freeandnil(List); freeandnil(AProcess); end; result := (PlugInName <> ''); end; function EnablePlugIn() : boolean; var AProcess: TProcess; begin result := false; AProcess := TProcess.Create(nil); AProcess.Executable:= 'gnome-extensions'; AProcess.Parameters.Add('enable'); AProcess.Parameters.Add(PlugInName); //AProcess.Options := AProcess.Options + [poWaitOnExit, poUsePipes]; try // We know we have gnome-extensions command and a valid extension name AProcess.Execute; finally freeandnil(AProcess); end; result := CheckPlugIn(True); end; { First we try and find a SysTray Library, libappindicator3 or libayatana-appindicator3. If not available, not much we can do, report and exit; We then try for enabling it using Gnome Extensions, if not available its either not installed or not gnome. If its there but disabled on Gnome we ask user and enable it. } begin // Ayatana is supported instead of Cannonical's appindicator in Laz Trunk post 22/05/2021, r65122 // Does no harm to check here but if its not in Lazarus, its won't be used when needed. result := false; {$ifndef LCLQT5} // It appears QT5 can talk direct to gnome-shell-extension-appindicator ?? H := LoadLibrary('libappindicator3.so.1'); if ('' <> getEnvironmentVariable('LAZUSEAPPIND')) and (H = NilHandle) then debugln('===== libappindicator3 is not present'); {$if (lcl_fullversion>2001200)} // 2.0.12 - Release Versions of Lazarus before 2.2.0 did not know about libayatana if H = NilHandle then begin // OK, lets try for libayatana H := LoadLibrary('libayatana-appindicator3.so.1'); // see https://bugs.freepascal.org/view.php?id=38909 if ('' <> getEnvironmentVariable('LAZUSEAPPIND')) and (H = NilHandle) then debugln('===== libayatana-appindicator3 is not present'); end; {$endif} if H = NilHandle then begin debugln('Failed to Find an AppIndicator Library, SysTray may not work.'); exit(False); // nothing to see here folks. end else if ('' <> getEnvironmentVariable('LAZUSEAPPIND')) then debugln('===== We have an AppIndicator Library'); unloadLibrary(H); {$endif} // end of if not QT5 Result := CheckPlugIn(True); if not Result then if MaybeNotGnome then debugln('===== SysTray not detected, not Gnome Desktop') // We also issue that message on a system that supports libappindicator3 without // needing (or installed) gnome-shell-extension-appindicator, eg U20.04 Mate // Plasma can use just libappindicator3 or Ayatana by itself. else if CheckPlugIn(False) then begin // Ah, its there but not enabled debugln('SysTray Plugin for Gnome detected but not enabled'); // Offer to enable it for user ?? if IDYES = Application.MessageBox('Enable gnome-shell-extension-appindictor ?', 'The SysTray extension is installed but not enabled', MB_ICONQUESTION + MB_YESNO) then Result := EnablePlugIn(); if Result then showmessage('Enabled, please restart tomboy-ng') else showmessage('Sorry, failed to enable plugin'); end else debugln('SysTray Plugin for Gnome not present'); end; function TMainForm.CheckForSysTray() : boolean; var A : TAtom; XDisplay: PDisplay; ForceAppInd : string; begin Result := False; // Don't test for SysTray under GTK3, will never be there. One or other AppIndicator // is your only chance. And XInternAtom() function SegVs on Gnome DTs so don't try it. // Ayatana is supported instead of Cannonical's appindicator in Laz Trunk // post 22/05/2021, r65122 and in Lazarus 2.2.0. Important in Bullseye, not Ubuntu < 21.10 if pos('KDE', upcase(GetEnvironmentVariable('XDG_CURRENT_DESKTOP'))) > 0 then begin NoLeftClickOnTrayIcon := True; // That will get all KDE and penalise X11 users, sorry ! exit(True); // So far, every KDE I have tested has a System Tray, but works badley under wayland in 2023 at least. end; {$ifdef LCLQT6}exit(true);{$endif} {$IFnDEF LCLGTK3} // Interestingly, by testing we seem to ensure it does work on U2004, even though the test fails ! {$ifdef LCLGTK2}XDisplay := gdk_display; {$endif} {$ifdef LCLQT5} // If using Gnome and QT5, cannot safely test for a SysTray, we'll guess.... if pos('GNOME', upcase(GetEnvironmentVariable('XDG_CURRENT_DESKTOP'))) > 0 then exit(CheckGnomeExtras()); XDisplay := QX11Info_display; {$endif} // OK, don't call next line in a KDE system ..... A := XInternAtom(XDisplay, '_NET_SYSTEM_TRAY_S0', False); // gtk2 or non-Gnome Qt5 result := (XGetSelectionOwner(XDisplay, A) <> 0); ForceAppInd := GetEnvironmentVariable('LAZUSEAPPIND'); if ForceAppInd <> '' then debugln('Tradition Systray Available = ' + booltostr(result, True)); // if ForceAppInd = 'YES' then // result := false; {$ENDIF} // if we are false here, its probably because its a recent Gnome Desktop or GTK3, no SysTray. // However, if libappindicator3 or Ayatana is installed and the Gnome Shell Extension, // appindicators is installed and enabled, it will 'probably' be OK. // Downside of above is we do all the Gnome Tests on non gnome desktops if running GTK3 if (pos('GNOME', upcase(GetEnvironmentVariable('XDG_CURRENT_DESKTOP'))) > 0) and (result = false) then Result := CheckGnomeExtras() // Thats libappindicator3 and an installed and enabled gnome-shell-extension-appindicator else Result := True; // Now, that is a hope for the best, GTK3 but non Gnome end; {$endif} // hides CheckForSystemTray() and CheckGnomeExtras() from non Linux procedure TMainForm.FormShow(Sender: TObject); var NoteID, NoteTitle : string; (* {$ifndef LCLGTK2} {$endif} *) Lab : TLabel; Butt : TBitBtn; begin TestDarkThemeInUse(); // {$ifndef LCLGTK2} // GTK2 seems only one we can be sure is auto colours ! // We honour --dark-theme for most and if we can guess its dark we'll // act accordingly. if Sett.DarkThemeSwitch then begin // If Qt is doing its own colours, let it ! color := Sett.AltColour; font.color := Sett.TextColour; // These do not work for Windows ? for Butt in [ButtMenu, BitBtnQuit, BitBtnHide, ButtSysTrayHelp] do Butt.Color := Sett.AltColour; //ButtMenu.Color := Sett.AltColour; //BitBtnQuit.Color := Sett.AltColour; //BitBtnHide.Color := Sett.AltColour; // ButtSysTrayHelp.Color := Sett.AltColour; for Lab in [Label5, LabelNotesFound, Label3, Label4, LabelBadNoteAdvice, LabelError] do TLabel(Lab).Font.Color:= Sett.TextColour; CheckBoxDontShow.Font.color := Sett.TextColour; end; // {$endif} if SingleNoteFileName() <> '' then begin // That reads the global in CLI Unit SingleNoteMode(SingleNoteFileName); exit; end; LabelBadNoteAdvice.Caption:= ''; ButtSysTrayHelp.Visible := False; {$ifdef LINUX} if not CheckForSysTray() then begin LabelBadNoteAdvice.Caption := rsWARNNOSSYSTRAY; ButtSysTrayHelp.Visible := True; ImageAboutLaz.Visible := False; end; {$endif} if TheMainNoteLister.XMLError then begin LabelError.Caption := rsFailedToIndex; LabelBadNoteAdvice.Caption:= rsBadNotesFound1; ImageAboutLaz.Visible := False; end else begin LabelError.Caption := ''; if Application.HasOption('no-splash') or (not Sett.CheckShowSplash.Checked) then ButtonDismissClick(Self); end; (* if Application.HasOption('no-splash') or (not Sett.CheckShowSplash.Checked) then begin {if AllowDismiss then} ButtonDismissClick(Self); end; *) Left := 10; Top := 40; CheckBoxDontShow.checked := not Sett.CheckShowSplash.Checked; if Sett.CheckShowSearchAtStart.Checked then SearchForm.Show; if TheMainNoteLister.FindFirstOOSNote(NoteTitle, NoteID) then repeat SearchForm.OpenNote(NoteTitle, Sett.NoteDirectory + NoteID); until TheMainNoteLister.FindNextOOSNote(NoteTitle, NoteID) = false; FormResize(self); // Qt5 apparently does not call FormResize at startup. if ButtSysTrayHelp.Visible then debugln('You cannot see me'); end; procedure TMainForm.ImageAboutLazClick(Sender: TObject); begin OpenURL('https://www.lazarus-ide.org/'); end; procedure TMainForm.LabelErrorClick(Sender: TObject); begin if LabelError.Caption <> '' then showmessage(rsBadNotesFound1 + #10#13 + rsBadNotesFound2); end; procedure TMainForm.UpdateNotesFound(Numb : integer); begin LabelNotesFound.Caption := rsFound + ' ' + inttostr(Numb) + ' ' + rsNotes; // ImageConfigCross.Left := ImageConfigTick.Left; // ImageConfigTick.Visible := Sett.HaveConfig; // ImageConfigCross.Visible := not ImageConfigTick.Visible; ImageNotesDirCross.Left := ImageNotesDirTick.Left; ImageNotesDirTick.Visible := Numb > 0; ImageNotesDirCross.Visible := not ImageNotesDirTick.Visible; ImageSpellCross.Left := ImageSpellTick.Left; ImageSpellTick.Visible := Sett.SpellConfig; ImageSpellCross.Visible := not ImageSpellTick.Visible; ImageSyncCross.Left := ImageSyncTick.Left; ImageSyncTick.Visible := Sett.ValidSync; ImageSyncCross.Visible := not ImageSyncTick.Visible; end; procedure TMainForm.ButtonDismissClick(Sender: TObject); begin {$ifdef LCLCOCOA} // ToDo : is this still necessary ? Or can Cocoa hide like other systems ? width := 0; height := 0; {$else} hide(); {$endif} end; procedure TMainForm.ButtSysTrayHelpClick(Sender: TObject); begin SearchForm.ShowHelpNote('systray.note'); end; procedure TMainForm.CheckBoxDontShowChange(Sender: TObject); var OldMask : boolean; begin if Visible then begin Sett.CheckShowSplash.Checked := not Sett.CheckShowSplash.Checked; OldMask := Sett.MaskSettingsChanged; Sett.MaskSettingsChanged := False; Sett.SaveSettings(Sender); Sett.MaskSettingsChanged := OldMask; end; end; procedure TMainForm.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin if ssCtrl in Shift then begin if key = ord('N') then begin SearchForm.OpenNote(''); // MMNewNoteClick(self); OK as long as Notes dir is set Key := 0; exit(); end; end; end; procedure TMainForm.FormResize(Sender: TObject); var MN : integer; begin MN := (Width div 3); ButtMenu.Width := MN; BitBtnHide.Width := MN; ButtSysTrayHelp.Left := 2* MN; ButtSysTrayHelp.width := MN; end; procedure TMainForm.TestDarkThemeInUse(); {$ifdef WINDOWS} function WinDarkTheme : boolean; // we also need to test in High Contrast mode, its not a colour theme. var RegValue : integer; Registry : TRegistry; begin Registry := TRegistry.Create; try Registry.RootKey := HKEY_CURRENT_USER; if Registry.OpenKeyReadOnly('\Software\Microsoft\Windows\CurrentVersion\Themes\Personalize') then begin try RegValue := Registry.ReadInteger('AppsUseLightTheme'); except on E: ERegistryException do exit(True); // If Key present but not AppsUseLightTheme, default to Dark end; exit(RegValue = 0); end else exit(false); finally Registry.Free; end; end; {$else} var Col : string; {$endif} begin if Application.HasOption('dark-theme') then // Manual override always wins unless its GTK2 (GTK3 ?) ! {$ifndef LCLGTK2} Sett.DarkThemeSwitch := True {$endif} else begin Sett.DarkTheme := false; Sett.DarkThemeSwitch := false; {$ifdef WINDOWS} Sett.DarkTheme := WinDarkTheme(); {$else} // if char 3, 5 and 7 are all 'A' or above, we are not in a DarkTheme Col := hexstr(qword(GetRGBColorResolvingParent()), 8); Sett.DarkTheme := (Col[3] < 'A') and (Col[5] < 'A') and (Col[7] < 'A'); {$endif} end; Sett.SetColours; end; { ------------- M E N U M E T H O D S ----------------} procedure TMainForm.ButtonConfigClick(Sender: TObject); begin Sett.Show(); end; procedure TMainForm.ButtonCloseClick(Sender: TObject); begin end; procedure TMainForm.ButtMenuClick(Sender: TObject); begin MainTBMenu.popup(Left + 40, Top + 40); end; procedure TMainForm.BitBtnQuitClick(Sender: TObject); begin Sett.CloseNowPlease(); // might delay exiting app up to 5 seconds while it finishes Sync. MainForm.Close; end; procedure TMainForm.BitBtnHideClick(Sender: TObject); begin {$ifdef LCLCOCOA} // ToDo : is this still necessary ? Or can Cocoa hide like other systems ? width := 0; height := 0; {$else} hide(); {$endif} end; procedure TMainForm.TrayIconClick(Sender: TObject); begin if not NoLeftClickOnTrayIcon then // At present, only KDE DE, does sweep up x11 users too ! PopupMenuTray.PopUp() else if Sett.CheckNotifications.Checked then ShowNotification('Please Right Click TrayIcon on this System', 2000); end; {procedure TMainForm.RecentMenuClicked(Sender: TObject); begin if TMenuItem(Sender).Caption <> SearchForm.MenuEmpty then SearchForm.OpenNote(TMenuItem(Sender).Caption); end; } // Linux only uses libnotify, Win and MacOS work through TrayIcon procedure TMainForm.ShowNotification(const Message : string; ShowTime : integer = 3000); {$ifdef LINUX} var LNotifier : PNotifyNotification; begin notify_init(argv[0]); LNotifier := notify_notification_new (pchar('tomboy_ng'), pchar(Message), pchar('dialog-information')); notify_notification_set_timeout(LNotifier, ShowTime); // figure is mS notify_notification_show (LNotifier, nil); notify_uninit; {$else} begin TrayIcon.BalloonTitle := 'tomboy-ng'; TrayIcon.BalloonHint := 'rsAutosnapshotRun'; TrayIcon.BalloonTimeOut := ShowTime; Mainform.TrayIcon.ShowBalloonHint; {$endif} end; RESOURCESTRING rsAbout = 'tomboy-ng notes - cross platform, sync and manage notes.'; // rsAbout1 = 'This is tomboy-ng, a rewrite of Tomboy Notes using Lazarus'; // rsAbout2 = 'and FPC. While its ready for production'; // rsAbout3 = 'use, you still need to be careful and have good backups.'; rsAboutVer = 'Version'; rsAboutBDate = 'Build date'; rsAboutCPU = 'TargetCPU'; rsAboutOperatingSystem = 'OS'; procedure TMainForm.ShowAbout(); var Stg : string; begin if AboutFrm <> Nil then begin AboutFrm.Show; AboutFrm.EnsureVisible(); exit; end; // Stg := rsAbout1 + #10 + rsAbout2 + #10 + rsAbout3 + #10 Stg := rsAbout + #10 + rsAboutVer + ' ' + Version_String; // version is in cli unit. {$ifdef LCLCOCOA} Stg := Stg + ', 64bit Cocoa'; {$endif} {$ifdef LCLQT5} Stg := Stg + ', QT5'; {$endif} {$ifdef LCLQT6} Stg := Stg + ', QT6'; {$endif} {$ifdef LCLGTK3} Stg := Stg + ', GTK3'; {$endif} {$ifdef LCLGTK2} Stg := Stg + ', GTK2'; {$endif} Stg := Stg + #10 + rsAboutBDate + ' ' + {$i %DATE%} + ' (Laz ' + inttostr(laz_major) +'.' + inttostr(laz_minor) + '.' + inttostr(laz_release) + ')' + #10 + rsAboutCPU + ' ' + {$i %FPCTARGETCPU%} + ' ' + rsAboutOperatingSystem + ' ' + {$i %FPCTARGETOS%} + ' ' + GetEnvironmentVariable('XDG_CURRENT_DESKTOP'); {$if defined(LCLQT5) or defined(LCLQT6)} Stg := Stg + #10 + 'QT_QPA_PLATFORMTHEME : ' + GetEnvironmentVariable('QT_QPA_PLATFORMTHEME') + #10 + 'QT_QPA_PLAFORM : ' + GetEnvironmentVariable('QT_QPA_PLATFORM'); {$endif} Stg := Stg + #10 + 'https://github.com/tomboy-notes/tomboy-ng'; AboutFrm := CreateMessageDialog(Stg, mtInformation, [mbClose]); AboutFrm.ShowModal; AboutFrm.free; AboutFrm := Nil; //Showmessage(Stg); end; end. �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������tomboy-ng_0.39-1/source/notenormal.pas��������������������������������������������������������������0000644�0001750�0001750�00000027646�14551457644�017641� 0����������������������������������������������������������������������������������������������������ustar �dbannon�������������������������dbannon����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������unit notenormal; { Copyright (C) 2017-2022 David Bannon License: This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html ------------------ } { A unit to 'normalise' a Tomboy Note, that is ensure tags remain with the para they relate to. Makes the xml a lot prettier and, more importantly, heaps easier t parse when exporting. Now incorporated into the tomboy-ng saving engine. Needed by the POT and CommonMark exporters. It recieves a TStringList containing a note (possibly loaded from disk) probably read from the KMemo and heading for disk. Remember, this code all runs in a thread, don't go sprinkling debugln()s, triggers memory leaks HISTORY : 2021/08/19 Bug in RemoveRedundentTags that sometimes ate character after tag pair 2021/09/21 Added code to convert blocks of monospace to to now have each para wrapped. 2022/11/09 Remove any ctrl char (ie < 32) except #10 and #13, don't know its necessary but #279 } {$mode objfpc}{$H+} interface uses Classes, SysUtils; type { TNoteNormaliser } // Will tidy up the location of tags to keep para or sentences together // As well as making for pretty to look xml, its far easier to parse, when converting to, eg markdown // Open a note into a string list, create NoteNormaliser and pass the string list to NormaliseList. TNoteNormaliser = class private procedure MoveTagDown(const StL: TStringList; const StIndex, TagSize: integer); function MoveTagLeft(var St: string): boolean; function MoveTagRight(var St: string): boolean; procedure MoveTagUp(const StL: TStringList; const StIndex: integer; var TagSize: integer); function OffTagAtStart(St: string): integer; function OnTagAtEnd(St: string): integer; function RemoveRedundentTag(var St: string): boolean; { Re-align monospaced lines. Acts on blocks only, does not alter in line mono. Looks for blocks wrapped in a single set of monospace tags, converts to a pair of tags per line (or more correctly, paragraph).} function TidyMonospace(StL: TStringList): boolean; public procedure NormaliseList(STL: TStringList); end; implementation uses lazlogger; // ---------------------- N O R M A L I S I N G ------------------------------------ // Deals with 'off' tags that need to be moved up to the para they apply to. procedure TNoteNormaliser.MoveTagUp(const StL : TStringList; const StIndex : integer; var TagSize : integer); var Tag : string; begin // we have to detect when our line starts with </note-content> or </text> and // terminate processing of this string, they are not text markup. Tag := copy(StL.strings[StIndex], 1, TagSize); if (Tag = '</note-content>') or (Tag = '</text>') then begin TagSize := 0; exit; end; StL.Insert(StIndex, copy(StL.Strings[StIndex], TagSize+1, length(StL.Strings[StIndex]))); StL.Delete(StIndex+1); StL.Insert(StIndex-1, StL.strings[StIndex-1]+Tag); StL.Delete(StIndex); end; function TNoteNormaliser.MoveTagRight(var St: string): boolean; var Index, TagStart, StartAt : integer; begin Index := Pos('> ', St); if Index = 0 then exit(False); StartAt := 1; repeat Index := St.IndexOf('> ', StartAt); if Index < 0 then exit(False); TagStart := Index; while St[TagStart] <> '<' do dec(TagStart); if St[TagStart+1] = '/' then begin // Not interested, an 'off' tag StartAt := Index+1; continue; end else break; until false; delete(St, Index+2, 1); insert(' ', St, TagStart); result := True; end; { Will move a tag to the left if it has a space there, ret T if it moved one.} function TNoteNormaliser.MoveTagLeft(var St: string): boolean; var Index : integer; begin Index := Pos(' </', St); if Index = 0 then exit(False); delete(St, Index, 1); insert(' ', St, St.IndexOf('>', Index)+2); // 2 ? IndexOf rets a zero based and we want to go one past Result := true; end; function TNoteNormaliser.OnTagAtEnd(St : string) : integer; var I, L : integer; begin if St = '' then exit(0); L := length(st); if St[L] <> '>' then exit(0); i := 1; while St[L-i] <> '<' do begin // march backwards until we find start of tag inc(i); if i > L then begin debugln('ERROR : Overrun looking for tag start'); exit(-1); end; end; if St[L-i+1] = '/' then exit(0); // not our problems, tags at the end should be 'off' tags. result := i+1; end; // Looks for an 'off' tag at the start of a line, they belong further up the list, 0 says none found function TNoteNormaliser.OffTagAtStart(St : string) : integer; var I : integer = 2; L : integer; begin if (St = '') or (St[1] <> '<') or (St[2] <> '/') then // Hmm, a single unescaed < on a line will crash exit(0); L := length(St); while St[i] <> '>' do begin inc(i); if i > L then begin debugln('ERROR : overrun looking for tag end, line =[' + st + ']'); exit(-1); end; end; result := i; end; // Deals with 'on' tags that need to be moved down to the paras that they apply to procedure TNoteNormaliser.MoveTagDown(const StL : TStringList; const StIndex, TagSize : integer); var Tag : string; begin Tag := copy(StL.strings[StIndex], length(StL.strings[StIndex])-TagSize+1, TagSize); StL.Insert(StIndex, copy(StL.strings[StIndex], 1, length(StL.strings[StIndex])-TagSize)); StL.Delete(StIndex+1); StL.Insert(StIndex+1, Tag+StL.Strings[StIndex+1]); StL.Delete(StIndex+2); end; // When there is an off tag and and complementry on tag (or visa versa) with nothing // between they are redundent and we remove them right here and now. No excuses ! // Rets True if it made a change, repeat until it finds nothing to do. function TNoteNormaliser.RemoveRedundentTag(var St : string) : boolean; var OffTag : integer = 0; // String Helpers are zero based ! Tag1, Tag2 : string; // might get, eg monospace for a fixed spacing tag // Ret T if it finds TagSt starting at Offset (and it removed it) function Removed(const OffSet : integer; TagSt : string; replace : boolean) : boolean; begin if OffSet < 0 then exit(False); if St.Substring(OffSet, length(TagSt)) = TagSt then begin //St := St.Remove(OffSet, length(Tag1 + Tag2) +1); St := St.Remove(OffSet, length(TagSt)); if Replace then St := St.Insert(OffSet, ' '); exit(True); end else Result := False; end; begin //if pos('Column Mode', St) > 0 then //writeln('---- ' + St); while(true) do begin OffTag := st.IndexOf('</', OffTag); if OffTag >= 0 then begin Tag1 := St.Substring(OffTag, st.IndexOf('>', OffTag) - OffTag +1); // ie thats full tag Tag2 := Tag1.Remove(Tag1.IndexOf('/', 1), 1); // we target Tag1Tag2 or reversed, with and without a space between if Removed(OffTag, Tag1+Tag2, False) then exit(True); if Removed(OffTag, Tag1+' '+Tag2, True) then exit(True); if Removed(OffTag-length(Tag2), Tag2+Tag1, False) then exit(True); // ERROR HERE if Removed(OffTag-length(Tag2), Tag2+' ' + Tag1, True) then exit(True); // If still here, that offtag was not associated with an immediate on tag. inc(OffTag); continue; end else exit(False); // no more offtags left to consider or maybe on offtags at all end { Loop: Find next offtag, exit false if we cannot find one try and find a matching ontag with nothing between. If above fails, goto LOOP: I don't think so. } end; function TNoteNormaliser.TidyMonospace(StL : TStringList) : boolean; var Start, i, OffSet : integer; St : string; function ConvertMono : boolean; begin St := StL[Start]; StL.Delete(Start); StL.Insert(Start, St + '</monospace>'); // First one inc(Start); while Start <= i do begin St := StL[Start]; StL.Delete(Start); if Start = i then StL.Insert(Start, '<monospace>' + St) // Last one else StL.Insert(Start, '<monospace>' + St + '</monospace>'); inc(Start); end; Result := True; end; begin i := 0; Result := False; while i < STL.Count do begin if (copy(STL[i], 1, 11) = '<monospace>') and (pos('</monospace>', Stl[i]) < 1) then begin Start := i; inc(i); continue; end; Offset := pos('</monospace>', Stl[i]); // OK, looking for an end tag. if (OffSet > 0) and (pos('<monospace>', Stl[i]) < 1) then begin // Possible but is it at end of line ? St := Stl[i]; while St[St.Length] in [#10, #13, ' '] do delete(St, St.Length, 1); if St.Length = Offset + 11 then exit(ConvertMono); // returns true end; inc(i); end; end; procedure TNoteNormaliser.NormaliseList(STL : TStringList); // ToDo : look into removing any char < #32 except #10 and #13. Bug #279 indicates // loss of a note due to Ctrl-Z appearing in the disk file. No idea how but if we can // quickly filter here while saving, good. var TagSize, StIndex, ChIndex : integer; TempSt : string; ChangedLine : Boolean = false; //Tick, Tock : qword; begin StIndex := 0; //Tick := gettickcount64(); while StIndex < StL.Count do begin repeat TagSize := OnTagAtEnd(StL.Strings[StIndex]); if TagSize > 0 then MoveTagDown(StL, StIndex, TagSize); until TagSize < 1; // WARNING, that includes error code, -1 TempSt := StL.Strings[StIndex]; while MoveTagLeft(TempSt) do; while MoveTagRight(TempSt) do; if TempSt <> StL.Strings[StIndex] then begin StL.Insert(StIndex, TempSt); StL.Delete(StIndex + 1); end; inc(StIndex); end; StIndex := StL.Count -1; // start at bottom and work up while StIndex > 0 do begin // we don't care about the first line. repeat TagSize := OffTagAtStart(StL.strings[StIndex]); if TagSize > 0 then MoveTagUp(StL, StIndex, TagSize); until TagSize < 1; dec(StIndex); end; StIndex := StL.Count -1; // remove any trailing spaces. while StIndex > 0 do begin TempSt := Stl[StIndex]; ChIndex := 1; // Issue #279, ctrl-Z characters ending up in file, 5/2023, same user found a ctrl-r, 18 ?? ChangedLine := False; // ToDo : review the addition of this code, it does appear to work and be safe but ... while ChIndex <= length(TempSt) do begin if (ord(TempSt[ChIndex]) < 32) and (ord(TempSt[ChIndex]) <> 10) and (ord(TempSt[ChIndex]) <> 13) then begin //debugln('Removing char ' + ord(TempSt[ChIndex]).ToString); // Carefull, causes memory leak when run in thread delete(TempSt, ChIndex, 1); ChangedLine := True; end else inc(ChIndex); end; if TempSt.endswith(' ') or ChangedLine then Stl[StIndex] := TempSt.TrimRight; dec(StIndex); end; StIndex := 0; // Redundent, sequencial tags. while StIndex < StL.Count do begin TempSt := STL[StIndex]; if RemoveRedundentTag(TempSt) then begin while RemoveRedundentTag(TempSt) do; // in case more than one in line StL.Insert(StIndex, TempSt); StL.Delete(StIndex + 1); end; inc(StIndex); end; TidyMonospace(StL); //Tock := gettickcount64(); //debugln('TNoteNormaliser.NormaliseList took ' + inttostr(Tock-Tick) + 'mS'); // triggers memory leaks end; end. ������������������������������������������������������������������������������������������tomboy-ng_0.39-1/source/searchunit.pas��������������������������������������������������������������0000644�0001750�0001750�00000250776�14551457644�017632� 0����������������������������������������������������������������������������������������������������ustar �dbannon�������������������������dbannon����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������unit SearchUnit; { Copyright (C) 2017-2022 David Bannon License: This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html ------------------ This form will put its icon in the System Tray and its resposible for acting on any of the menu choices from that tray icon. The form, and therefore the application, does not close if the user clicks the (typically top right) close box, just hides. It does not close until the user clicks 'close' from the System Tray Menu. It also displays the Search box showing all notes and manages the note_lister, the data structure holding info in memory of all notes. } { HISTORY 20170928 Added a function that returns true if passed string is in the current title list. 20171005 - Added an ifdef Darwin to RecentNotes() to address a OSX bug that prevented the recent file names being updated. 2017/10/10 - added a refresh ButtonSMenu, need to make it auto but need to look at timing implication for people with very big note sets first. 2017/10/10 - added the ability to update the stringlist when a new note is created or an older one updated. So, recent notes list under TrayIcon is now updated whenever a save is made. 2017/11/07 - switched over to using NoteLister, need to remove a lot of unused code. 2017/11/28 - fixed a bug I introduced while restructuring OpenNote to better handle a note being auto saved. This bug killed the Link ButtonSMenu in EditNote 2017/11/29 - check to see if NoteLister is still valid before passing on updates to a Note's status. If we are quiting, it may not be. 2017/12/03 Added code to clear Search box when it gets focus. Issue #9 2017/12/05 Added tests that we have a Notes Directory before opening a new note or the search box. Issue #23. 2017/12/27 Changes flowing from this no longer being the main form. 1. Setting is now main form. This is to deal with a Cocoa issue where we we cannot Hide() in the OnShow event. 2017/12/28 Ensured recent items in popup menu are marked as empty before user sets a notes dir. 2017/12/29 DeleteNote() now moves file into Backup/. 2017/12/30 Removed commented out code relting to calling Manual Sync 2018/01/01 Added a check to see if FormSync is already visible before calling ShowModal 2018/01/01 Added code to mark a previously sync'ed and now deleted note in local manifest. 2018/01/01 Set goThumbTracking true so contents of scroll box glide past as you move the "Thumb Slide". 2018/01/01 Moved call to enable/disable the sync menu item into RecentMenu(); 2018/01/25 Changes to support Notebooks 2018/01/39 Altered the Mac only function that decides when we should update the traymenu recent used list. 2018/02/04 Don't show or populate the TrayIcon for Macs. Hooked into Sett's Main Menu for Mac and now most IconTray/Main menu items are responded to in Sett. 2018/02/04 Now control MMSync when we do the Popup One. 2018/04/12 Added ability to call MarkNoteReadOnly() to cover case where user has unchanged note open while sync process downloads or deletes that note from disk. 2018/04/13 Taught MarkNoteReadOnly() to also delete ref in NoteLister to a sync deleted note 2018/05/12 Extensive changes - MainUnit is now just that. Name of this unit changed. 2018/05/20 Alterations to way we startup, wrt mainform status report. Mark 2018/06/04 NoteReadOnly() now checks if NoteLister is valid before calling. 2018/07/04 Pass back some info about how the note indexing went. 2018/08/18 Can now set search option, Case Sensitive, Any Combination from here. 2018/08/18 Update Mainform line about notes found whenever IndexNotes() is called. 2018/11/04 Added ProcessSyncUpdates to keep in memory model in line with on disk and recently used list 2018/11/25 Now uses Sync.DeleteFromLocalManifest(), called when a previously synced note is deleted 2018/12/29 Small improvements in time to save a file. 2019/02/01 OpenNote() now assignes a new note to the notebook if one is open (ie ButtonNotebookOptions is enabled) 2019/02/09 Move autosize stringgrid1 (back?) into UseList() 2019/02/16 Clear ButtonSMenu now calls UseList() to ensure autosize happens. 2019/03/13 Now pass editbox the searchterm (if any) so it can move cursor to first occurance in note 2019/04/07 Restructured Main and Popup menus. Untested Win/Mac. 2019/04/13 Don't call note_lister.GetNotes more than absolutly necessary. 2019/04/15 One Clear Filters ButtonSMenu to replace Clea and Show All Notes. Checkboxes Mode instead of menu 2019/04/16 Fixed resizing atifacts on stringGrids by turning off 'Flat' property, Linux ! 2019/08/18 Removed AnyCombo and CaseSensitive checkboxes and replaced with SearchOptionsMenu, easier translations 2019/11/19 When reshowing an open note, bring it to current workspace, Linux only. Test on Wayland ! 2019/12/11 Heavily restructured Startup, Main Menu everywhere ! 2019/12/12 Commented out #868 that goRowHighlight to stringgridnotebook, ugly black !!!!! 2019/12/19 Restored the File Menu names to the translate system. 2020/01/24 Fixed a Qt5 startup issue, don't fill in RecentItems in menu before File & Help are there. 2020/01/29 A lot of tweaks around UseList(), MMenu Recent no longer from StringGrid, ctrl updates to speed up. 2020/01/31 LoadStringGrid*() now uses the Lazarus column mode. Better ctrl of Search Term highlight (but still highlit when makeing form re-visible). Drop Create Date and Filename from Search results string grid. But I still cannot control the little green triangles in stringgrid headings indicating sort. 2020/02/01 Do not refresh the string grids automatically, turn on the refresh ButtonSMenu for user to do it. 2020/02/19 hilight selected notebook name. 2020/03/09 Make sure 'x' (put in by a bug) is not a valid sync repo path. 2020/05/10 Faster search 2020/05/19 Replaced StringGridNotebook with a ListBox 2020/06/07 ListBoxNotebooks sorted (but not reverse sortable, that would require TListBox becoming TListView) 2020/07/09 New help notes location. 2020/07/17 OpenNote was checking EditSearch.test = 'search' instead of rsMenuSearch 2020/11/14 ListViewNotes now has alternating colours, req ugly fix for Qt5 involving increasing font size 2020/12/10 Move focus to Search Field whenever Search Form is re-shown, issue #211 2021/01/22 When activating a note from the search form, jump to first match if Search Term is not empty 2021/01/23 A check box to choose Auto Refresh or not. 2021/02/11 Some debugs around Ctrl-Q, to be removed and make two listboxes respond to Ctrl-N 2021/02/14 Direct all key down events via Form's OnKeyDown handler Ctrl-N and Ctrl-Q 2021/07/05 UpDateList now only refreshes menu if item on top has changed 2021/08/02 Use Template when creating new note from Template. Sigh .... And don't update notelister (and menus) if its a Notebook thats been edited. 2021/09/25 Fix bug that prevented saving first note in a dir, introduced in July. Nasty. 2021/11/03 When deleteing a notebook, remove references to it from the notes. 2021/11/04 Changes to support new Notebook management model 2021/12/03 Moved checkAutoRefresh to Settings, replaced with SpeedSearchOtions and menu Added all code necessary for Searching for note while u type, NoteIndex 2022/04/18 Bug where searching notes in progressive mode and backspacing over search term failed 2022/08/27 Alterations to ListViewNotesColumnClick() and ListViewNotesData() to work in OwnerData mode. 2022/09/06 PressEnter Seach mode now OK as well, cleans up when Search form closes or hides. 2022/09/08 Two bugs that appear when no notes present 2022/09/08 Update Notes Found number on small splash screen #267 2022/09/13 Tweaks to manage the ListViewNotes sort indicators, must 'Bounce'. 2022/10/20 Added an Import menu item to Options. 2022/10/29 Auto remove Search Prompt from start of search term. 2022/12/31 EditSearch now uses TestHint. 2023/01/11 Qt5 - ListViewNotesKeyPress now forces keypress to EditSearch 2023/01/11 Added Windows to above, BUT Mac cannot do this. So, disable on Mac. 2023/03/17 Darken up Search Window in dark theme. } {$mode objfpc}{$H+} interface uses Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ActnList, ComCtrls, StdCtrls, ExtCtrls, Menus, Buttons, Note_Lister, lazLogger, ResourceStr; // These are choices for main popup menus. type TMenuTarget = (mtSep=1, mtNewNote, mtSearch, mtAbout=10, mtSync, mtSettings, mtMainHelp, mtHelp, mtQuit, mtRecent); // These are the possible kinds of main menu items type TMenuKind = (mkFileMenu, mkRecentMenu, mkHelpMenu, mkAllMenu); type { TSearchForm } TSearchForm = class(TForm) BitBtnMenu: TBitBtn; ButtonSearchOptions: TButton; ButtonClearSearch: TButton; ButtonClearFilters: TButton; EditSearch: TEdit; ListBoxNotebooks: TListBox; ListViewNotes: TListView; MenuEditNotebookTemplate: TMenuItem; MenuDeleteNotebook: TMenuItem; MenuCreateNoteBook: TMenuItem; MenuItemImportNote: TMenuItem; MenuItemCaseSensitive: TMenuItem; MenuItemSWYT: TMenuItem; MenuItemManageNBook: TMenuItem; MenuItem3: TMenuItem; MenuRenameNoteBook: TMenuItem; MenuNewNoteFromTemplate: TMenuItem; OpenDialogImport: TOpenDialog; Panel1: TPanel; Panel2: TPanel; PopupMenuSearchOptions: TPopupMenu; PopupMenuNotebook: TPopupMenu; Splitter1: TSplitter; StatusBar1: TStatusBar; SelectDirectoryDialog1: TSelectDirectoryDialog; procedure BitBtnMenuClick(Sender: TObject); procedure ButtonClearSearchClick(Sender: TObject); { If a search is underway, searches. Else, if we have an active notebook filter applied, reapply it. Failing both of the above, refreshes the Notes and Notebooks with data in Note_Lister. } procedure ButtonClearFiltersClick(Sender: TObject); procedure ButtonSearchOptionsClick(Sender: TObject); procedure ButtonSMenuClick(Sender: TObject); procedure EditSearchChange(Sender: TObject); procedure EditSearchEnter(Sender: TObject); procedure EditSearchKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); // called after OnShow. procedure FormActivate(Sender: TObject); procedure FormCloseQuery(Sender: TObject; var CanClose: boolean); procedure FormCreate(Sender: TObject); procedure FormDeactivate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure FormHide(Sender: TObject); procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure FormResize(Sender: TObject); procedure FormShow(Sender: TObject); procedure ListBoxNotebooksClick(Sender: TObject); procedure ListBoxNotebooksMouseUp(Sender: TObject; ButtonSMenu: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ListViewNotesColumnClick(Sender: TObject; Column: TListColumn ); procedure ListViewNotesData(Sender: TObject; Item: TListItem); procedure ListViewNotesDblClick(Sender: TObject); procedure ListViewNotesDrawItem(Sender: TCustomListView; AItem: TListItem; ARect: TRect; AState: TOwnerDrawState); procedure ListViewNotesKeyPress(Sender: TObject; var Key: char); procedure MenuDeleteNotebookClick(Sender: TObject); procedure MenuEditNotebookTemplateClick(Sender: TObject); procedure MenuCreateNoteBookClick(Sender: TObject); // procedure MenuItemAutoRefreshClick(Sender: TObject); procedure MenuItemCaseSensitiveClick(Sender: TObject); procedure MenuItemImportNoteClick(Sender: TObject); procedure MenuItemManageNBookClick(Sender: TObject); procedure MenuItemSWYTClick(Sender: TObject); procedure MenuRenameNoteBookClick(Sender: TObject); // Rather than opening an empty note we copy the template. // save it, index it and pass the filename to OpenNote( procedure MenuNewNoteFromTemplateClick(Sender: TObject); { Recieves 2 lists from Sync subsystem, one listing deleted notes ID, the other downloded note ID. Adjusts Note_Lister according and marks any note that is currently open as read only. Does not move files around. } procedure ProcessSyncUpdates(const DeletedList, DownList: TStringList); // A proc that is called when a note is added to repo by, eg, an import. // The procedure's address is passed, via tb_utils, to the CLI unit so it // knows to call this direct if its not nil. procedure IndexNewNote(const FFName: string; CheckTitleClash: boolean); private MoveFocusChar : char; SearchTextLength : integer; // Previous length of EditSearch text, tells us if term is growing or shrinking SearchActive : boolean; // We have searched for something after most recent SearchClear // NIndex : TNoteIndex; HelpList : TStringList; //NumbToRefresh : integer; // The number of notes to display if a delayed Refresh() is appropriate // NeedRefresh : boolean; // Indicates a delayed Refresh() could happen HelpNotes : TNoteLister; LVSortMode : TLVSortMode; // Sort direction for the ListViewNotes, OnData needs to know. procedure AddItemMenu(TheMenu: TPopupMenu; Item: string; mtTag: TMenuTarget; OC: TNotifyEvent; MenuKind: TMenuKind); // ListView, in OwnerData mode seems to need to get its SortIndicator bounced // after refreshing content. procedure BounceSortIndicator(Col: integer); procedure CreateMenus(); procedure DoSearchEnterPressed(); procedure FileMenuClicked(Sender: TObject); procedure InitialiseHelpFiles(); function MakeNoteFromTemplate(const Template: String): string; // clears then Inserts file items in all main menus, note also removes help items .... procedure MenuFileItems(AMenu: TPopupMenu); procedure MenuHelpItems(AMenu: TPopupMenu); // Builds a list of all the main Menus we have floating around at the moment. procedure MenuListBuilder(MList: TList); procedure RecentMenuClicked(Sender: TObject); // Gets called to refresh the ListViewNotes in cases were we may not do it immediatly // If ImmediateRefresh, we use the previously recorded NumbToRefresh and clear ButtonSMenu // Else re do a new search or clear depending on existing search parameters. procedure IndexAndRefresh(DisplayOnly: boolean = false); function RemoveFromHelpList(const FullHelpNoteFileName: string): boolean; procedure RemoveNBTag(NB: string); //procedure RefreshNoteAndNotebooks(); procedure ScaleListView(); { If there is an open note from the passed filename, it will be marked read Only, will accept a GUID, Filename or FullFileName inc path } procedure MarkNoteReadOnly(const FullFileName: string); //procedure ShowListIndicator(St: string); public PopupTBMainMenu : TPopupMenu; SelectedNotebook : integer; // Position in Notebook grid use has clicked, 0 means none. //AllowClose : boolean; // NoteLister : TNoteLister; NoteDirectory : string; { Public : Called from EditBox when it saves a new note. If that new note was created by a New Link request, its necessary to mark that text as a Link. Note int marks only the potential links near the cursor at that time. } procedure MarkLinkOnOpenNotes(); { Tells all open notes to save their contents. Used, eg before we run a sync to ensure recently changed content is considered by the (File based) sync engine.} procedure FlushOpenNotes(); { Makes a backup note with last three char of manin name being the PutInName that tells us where it came from, ttl - title opn - just opened. Does nothing if name not UUID length. Pass it a ID, Filename or FullFileName } procedure BackupNote(const NoteName, PutIntoName: string); // Public procedure to show the help note named (without path info) procedure ShowHelpNote(HelpNoteName: string); procedure UpdateStatusBar(I: integer; SyncSt: string); {Just a service provided to NoteBook.pas, refresh the list of notebooks after adding or removing one} procedure RefreshNotebooks(); // Fills in the Main TB popup menus. If AMenu is provided does an mkAllMenu on // that Menu, else applies WhichSection to all know Main TB Menus. procedure RefreshMenus(WhichSection: TMenuKind; AMenu: TPopupMenu=nil); function MoveWindowHere(WTitle: string): boolean; { Puts the names of recently used notes in the indicated menu, removes esisting ones first. } procedure MenuRecentItems(AMenu : TPopupMenu); { Call this so NoteLister no longer thinks of this as a Open note } procedure NoteClosing(const ID: AnsiString); { Updates the In Memory List with passed data. Either updates existing data or inserts new } procedure UpdateList(const Title, LastChange, FullFileName: ANSIString; TheForm : TForm); { Reads header in each note in notes directory, updating Search List and the recently used list under the TrayIcon. Downside is time it takes to index. use UpdateList() if you just have updates. ReRunSearch might be necessary, for TheMainNoteLister, if its a re-run.} function IndexNotes(ReRunSearch: boolean = False): integer; { Returns true when passed string is the title of an existing note } //function IsThisaTitle(const Term: ANSIString): boolean; { Gets called with a title and filename (clicking grid), with just a title (clicked a note link or recent menu item or Link ButtonSMenu) or nothing (new note). If its just Title but Title does not exist, its Link ButtonSMenu. DontBackUp says do not make a backup as we opne because we are in a Roll Back Cycle.} procedure OpenNote(NoteTitle: String; FullFileName: string = ''; TemplateIs: AnsiString=''; BackUp: boolean=True; InSearch: boolean=false; STerm : string=''); { Returns True if it put next Note Title into SearchTerm } //function NextNoteTitle(out SearchTerm : string) : boolean; { Initialises search of note titles, prior to calling NextNoteTitle() } // procedure StartSearch(); { Deletes the actual file then removes the indicated note from the internal data about notes, updates local manifest, refreshes Grid, may get note or template } procedure DeleteNote(const FullFileName : ANSIString); const MenuEmpty = '(empty)'; end; var SearchForm: TSearchForm; implementation {$R *.lfm} //{$define LVOWNERDRAW} // Ownerdraw of ListViewNotes gives us alternating colours but all sorts of problems // I'll try a release without it and, maybe, try agin later. And maybe not. uses MainUnit, // Opening form, manages startup and Menus EditBox, settings, // Manages settings. LCLType, // For the MessageBox LazFileUtils, // LazFileUtils needed for TrimFileName(), cross platform stuff sync, // because we need it to manhandle local manifest when a file is deleted process, // Linux, we call wmctrl to move note to current workspace LCLVersion, // used to enable, or not, sort indicators in lcl2.0.8 or later NoteBook, tb_utils, cli; // We call the ImportNote function there. { TSearchForm } { ------------- FUNCTIONS THAT PROVIDE SERVICES TO OTHER UNITS ------------ } procedure TSearchForm.ProcessSyncUpdates(const DeletedList, DownList : TStringList); // The lists arrive here with just the 36 char ID, the following functions must be OK with that ! // Does not get called with both lists empty var Index : integer; begin if TheMainNoteLister <> nil then begin for Index := 0 to DeletedList.Count -1 do begin // Deleted notes if TheMainNoteLister.IsATemplate(DeletedList.Strings[Index]) then begin TheMainNoteLister.DeleteNoteBookwithID(DeletedList.Strings[Index]); RefreshNotebooks(); end else begin MarkNoteReadOnly(DeletedList.Strings[Index]); TheMainNoteLister.DeleteNote(DeletedList.Strings[Index]); // dont call this, wont do Indexes end; end; for Index := 0 to DownList.Count -1 do begin // Downloaded notes MarkNoteReadOnly(DownList.Strings[Index]); if TheMainNoteLister.IsIDPresent(DownList.Strings[Index]) then begin TheMainNoteLister.DeleteNote(DownList.Strings[Index]); //debugln('We have tried to delete ' + DownList.Strings[Index]); end; RefreshNotebooks(); TheMainNoteLister.IndexThisNote(DownList.Strings[Index]); //debugln('We have tried to reindex ' + DownList.Strings[Index]); end; IndexAndRefresh(); // Reruns the current search with new data in NoteList TheMainNoteLister.BuildDateAllIndex(); // Must rebuild it before refreshing menus. RefreshMenus(mkRecentMenu); MainForm.UpdateNotesFound(TheMainNoteLister.NoteList.Count); { Visible T F T F Checked T T F F Refresh Yes n n n NeedRefresh n Yes Yes Yes EnableButt n n Yes n } // if Visible and Sett.AutoRefresh then // CheckAutoRefresh.checked then // Refresh() // else begin // if Visible then ButtonRefresh.Enabled := True // else NeedRefresh := True; // end; end; end; (* procedure TSearchForm.ButtonRefreshClick(Sender: TObject); begin DelayedRefresh(True); end; *) procedure TSearchForm.MarkLinkOnOpenNotes(); var AForm : TForm; begin if assigned(TheMainNoteLister) then begin AForm := TheMainNoteLister.FindFirstOpenNote(); while AForm <> Nil do begin TEditBoxForm(AForm).CheckForLinks(False); AForm := TheMainNoteLister.FindNextOpenNote(); end; end; end; procedure TSearchForm.FlushOpenNotes(); var AForm : TForm; begin if assigned(TheMainNoteLister) then begin AForm := TheMainNoteLister.FindFirstOpenNote(); while AForm <> Nil do begin if TEditBoxForm(AForm).dirty then TEditBoxForm(AForm).SaveTheNote(); AForm := TheMainNoteLister.FindNextOpenNote(); end; end; end; procedure TSearchForm.NoteClosing(const ID : AnsiString); begin if TheMainNoteLister <> nil then // else we are quitting the app ! if not TheMainNoteLister.ThisNoteIsOpen(ID, nil) then // maybe its a help note ? RemoveFromHelpList(ID); end; (* procedure TSearchForm.StartSearch(); // Call before using NextNoteTitle() to list Titles. begin // ToDo : not needed, Editbox now goes direct TheMainNoteLister.StartSearch(); // TitleIndex := 1; end; *) { Removes the indicated NoteBook tag from any note that has it } procedure TSearchForm.RemoveNBTag(NB : string); var STL : TStringList; // note: NoteLister.GetNotesInNoteBook does not need STL created or freed ! i : integer = 0; Dummy : TForm; begin if NB = '' then exit; if TheMainNoteLister.GetNotesInNoteBook(StL, NB) then while i < StL.Count do begin if TheMainNoteLister.IsThisNoteOpen(STL[i], Dummy) then continue; // don't bother to do open notes. // ToDo : test this RemoveNoteBookTag(Sett.NoteDirectory + STL[i], NB); inc(i) end; end; procedure TSearchForm.DeleteNote(const FullFileName: ANSIString); var NewName, ShortFileName : ANSIString; // LocalMan : TTomboyLocalManifest; LocalMan : TSync; begin // debugln('DeleteNote ' + FullFileName); ShortFileName := ExtractFileNameOnly(FullFileName); // an ID LocalMan := TSync.Create; LocalMan.DebugMode:=false; LocalMan.ConfigDir:= Sett.LocalConfig; LocalMan.NotesDir:= Sett.NoteDirectory; if not LocalMan.DeleteFromLocalManifest(copy(ShortFileName, 1, 36)) then showmessage('Error marking note delete in local manifest ' + LocalMan.ErrorString); LocalMan.Free; if TheMainNoteLister.IsATemplate(ShortFileName) then begin // this does not remove notebook tag from any notes that were members of this note. // if the note is Open, thats OK, it will be saved correctly on exit. RemoveNBTag(TheMainNoteLister.GetNotebookName(ShortFileName)); // remove ref to the notebook from all notes TheMainNoteLister.DeleteNoteBookwithID(ShortFileName); DeleteFileUTF8(FullFileName); // ButtonClearFiltersClick(self); RefreshNoteBooks(); end else begin TheMainNoteLister.DeleteNote(ShortFileName); // Remove from NoteList NewName := Sett.NoteDirectory + 'Backup' + PathDelim + ShortFileName + '.note'; if not DirectoryExists(Sett.NoteDirectory + 'Backup') then if not CreateDirUTF8(Sett.NoteDirectory + 'Backup') then DebugLn('Failed to make Backup dir, ' + Sett.NoteDirectory + 'Backup'); if FileExistsUTF8(NewName) then DeleteFileUTF8(NewName); if not RenameFileUTF8(FullFileName, NewName) then begin DebugLn('Failed to move ' + FullFileName + ' to ' + NewName); showmessage('TSearchForm.DeleteNote - failed to rename to ' + NewName); end; end; IndexAndRefresh(False); // ToDo : if Delete updated Index, could be DisplayOnly TheMainNoteLister.BuildDateAllIndex(); // Must rebuild it before refreshing menus. RefreshMenus(mkRecentMenu); MainForm.UpdateNotesFound(TheMainNoteLister.NoteList.Count); end; (*function TSearchForm.NextNoteTitle(out SearchTerm: string): boolean; begin Result := TheMainNoteLister.NextNoteTitle(SearchTerm); end; *) {function TSearchForm.IsThisaTitle(const Term : ANSIString) : boolean; begin Result := TheMainNoteLister.IsThisATitle(Term); end; } procedure TSearchForm.RefreshNotebooks(); var Index : integer; begin Index := ListBoxNotebooks.ItemIndex; TheMainNoteLister.LoadListNotebooks(ListBoxNotebooks.Items, ButtonClearFilters.Enabled); if Index > -1 then begin ListBoxNotebooks.ItemIndex := Index; ListBoxNotebooksClick(self); end; end; procedure TSearchForm.UpdateStatusBar(I : integer; SyncSt: string); begin //StatusBar1.SimpleText:= SyncSt; StatusBar1.Panels.Items[I].Text := SyncSt; end; procedure TSearchForm.UpdateList(const Title, LastChange, FullFileName : ANSIString; TheForm : TForm ); var // T1, T2, T3, T4 : qword; NeedUpdateMenu : boolean = False; // Updating the menu can be a bit slow. //NeedUpdateDisplay : boolean = false; // Only set if Title has changed. i : integer; ReRunSearch : boolean = false; //STL : TStringList; //NoteBook : string; begin { Called when a note is (soon to be saved) saved, date is always new, Title may have changed, note may be a new one. We always send date to NoteList, maybe update menu, maybe rerun the existing search, maybe just update display. In fact, we update the display unless note is not shown in ListView. } // T1 := gettickcount64(); if TheMainNoteLister = Nil then exit; // we are quitting the app ! // We don't do any of this if the its a notebook. if TheMainNoteLister.IsATemplate(ExtractFileNameOnly(FullFileName)) then exit; // do we need to update menus ? Its time consuming, if this is already top entry, leave alone i := 0; while i < PopupTBMainMenu.Items.Count do begin if PopupTBMainMenu.Items[i].Tag = ord(mtRecent) then begin // Find first Recent Menu item if PopupTBMainMenu.Items[i].Caption <> Title then NeedUpdateMenu := True; break; // jump out after testing first recent end; inc(i); end; if i = PopupTBMainMenu.Items.Count then NeedUpdateMenu := True; // dropped right through without a mtRecent // T2 := gettickcount64(); if TheMainNoteLister.AlterOrAddNote(ReRunSearch, FullFileName, LastChange, Title) then begin if ReRunSearch then begin // If neither a search term nor Notebook is set, just call ClearSearch, its fast if (((EditSearch.Text = '') or (EditSearch.Text = rsMenuSearch)) and (ListBoxNoteBooks.ItemIndex < 0)) then begin ListViewNotes.Items.clear; // stops an annoying GTK2 message ListViewNotes.Items.Count := TheMainNoteLister.ClearSearch() end else begin IndexAndRefresh(False); end; end else // Just need to display, Indexes have been adjusted IndexAndRefresh(True); end; // T3 := gettickcount64(); TheMainNoteLister.ThisNoteIsOpen(FullFileName, TheForm); if NeedUpDateMenu then RefreshMenus(mkRecentMenu); MainForm.UpdateNotesFound(TheMainNoteLister.NoteList.Count); { T4 := gettickcount64(); debugln('SearchUnit.UpdateList TestMenu=' + inttostr(T2 - T1) + 'mS AlterAdd=' + inttostr(T3 - T2) + 'mS Menu=' + inttostr(T4 - T3) + 'mS Menu=' + booltostr(NeedUpdateMenu, True)); } { Timing, 2K notes, Dell, release mode. August 2022 Change Content 1mS Change Title 20mS mostly AlterAdd but inc 5-7mS rewriting menu AlterAdd is mostly call to SearchClear (Sort) If there is a searchTerm, NewSearch is called, if not, ClearSearch() - both involve much longer Sort than when iniially run. Build is quick, ~1mS but each Sort is ~11mS (nominally 10x longer than first call). Still, updating Menu is a problem } // Must do some refresh() stuff here. end; // ---------------------------------------------------------------------------- // --------------- H E L P N O T E S ------------------------------------- procedure TSearchForm.InitialiseHelpFiles(); // Todo : this uses about 300K, 3% of extra memory, better to code up a simpler model ? begin if HelpNotes <> nil then freeandnil(HelpNotes); HelpNotes := TNoteLister.Create; // freed in OnClose event. HelpNotes.DebugMode := Application.HasOption('debug-index'); // HelpNotes.WorkingDir:= MainForm.ActualHelpNotesPath; HelpNotes.WorkingDir:= Sett.HelpNotesPath + Sett.HelpNotesLang + PathDelim; HelpNotes.IndexNotes(true); end; function TSearchForm.RemoveFromHelpList(const FullHelpNoteFileName : string) : boolean; var Index : integer; begin Result := False; //debugln('Looking for help note ' + extractFileName(fullHelpNoteFileName)); if HelpList <> Nil then if HelpList.Find(extractFileName(FullHelpNoteFileName), Index) then begin //debugln('Found help note ' + extractFileName(fullHelpNoteFileName)); HelpList.Delete(Index); Result := True; end; end; procedure TSearchForm.ShowHelpNote(HelpNoteName: string); var EBox : TEditBoxForm; TheForm : TForm; Index : integer; begin if FileExists(Sett.HelpNotesPath + Sett.HelpNotesLang + PathDelim + HelpNoteName) then begin If HelpList = nil then begin HelpList := TStringList.Create; HelpList.Sorted:=True; end else begin if HelpList.Find(HelpNoteName, Index) then begin // we now try to remove entries from HelpList when a help note is closed. // This is far prettier when running under debugger, user does not care. try TheForm := TEditBoxForm(HelpList.Objects[Index]); debugln('Attempting a reshow of ' + HelpNoteName); TheForm.Show; SearchForm.MoveWindowHere(TheForm.Caption); TheForm.EnsureVisible(true); exit; except on E: Exception do {showmessage(E.Message)}; // If user had this help page open but then closed it entry is still in // list so we catch the exception, ignore it and open a new note. // its pretty ugly under debugger but user does not see this. end; end; end; // If we did not find it in the list and exit, above, we will make a new one. EBox := TEditBoxForm.Create(Application); EBox.SetReadOnly(False); EBox.SearchedTerm := ''; EBox.NoteTitle:= ''; EBox.NoteFileName := Sett.HelpNotesPath + Sett.HelpNotesLang + PathDelim + HelpNoteName; Ebox.TemplateIs := ''; EBox.Show; EBox.Dirty := False; HelpList.AddObject(HelpNoteName, EBox); EBox.Top := HelpList.Count * 10; EBox.Left := HelpList.Count * 10; EBox.Width := Screen.Width div 2; // Set sensible sizes. EBox.Height := Screen.Height div 2; end else showmessage('Unable to find ' + Sett.HelpNotesPath + Sett.HelpNotesLang + PathDelim + HelpNoteName); end; // --------------------------------------------------------------------------- // ------------- M E N U F U N C T I O N S ------------------------------- // --------------------------------------------------------------------------- { Menus are built and populated at end of CreateForm. } procedure TSearchForm.CreateMenus(); begin InitialiseHelpFiles(); PopupTBMainMenu := TPopupMenu.Create(self); // LCL will dispose because of 'self' BitBtnMenu.PopupMenu := PopupTBMainMenu; MainForm.MainTBMenu := TPopupMenu.Create(self); MainForm.ButtMenu.PopupMenu := MainForm.MainTBMenu; // Add any other 'fixed' menu here. end; procedure TSearchForm.MenuListBuilder(MList : TList); var AForm : TForm; begin if assigned(TheMainNoteLister) then begin AForm := TheMainNoteLister.FindFirstOpenNote(); while AForm <> Nil do begin MList.Add(TEditBoxForm(AForm).PopupMainTBMenu); AForm := TheMainNoteLister.FindNextOpenNote(); end; end; if assigned(PopupTBMainMenu) then MList.Add(PopupTBMainMenu); if assigned(MainForm.MainTBMenu) then MList.Add(MainForm.MainTBMenu); if (MainForm.UseTrayMenu) and assigned(MainForm.PopupMenuTray) then MList.Add(MainForm.PopupMenuTray); if assigned(Sett.PMenuMain) then MList.Add(Sett.PMenuMain); end; procedure TSearchForm.RefreshMenus(WhichSection : TMenuKind; AMenu : TPopupMenu = nil); var MList : TList; I : integer; // T1, T2, T3, T4, T5, T6 : qword; begin if (WhichSection = mkRecentMenu) and (PopupTBMainMenu.Items.Count = 0) then exit; // This is a call during startup, File and Help are not there yet, messes with Qt5 //debugln('In RefreshMenus'); if AMenu <> Nil then begin MenuFileItems(AMenu); MenuHelpItems(AMenu); MenuRecentItems(AMenu); exit(); end; MList := TList.Create; MenuListBuilder(MList); //T1 := gettickcount64(); case WhichSection of mkAllMenu : for I := 0 to MList.Count - 1 do begin MenuFileItems(TPopupMenu(MList[i])); MenuHelpItems(TPopupMenu(MList[i])); MenuRecentItems(TPopupMenu(MList[i])); end; mkFileMenu : for I := 0 to MList.Count - 1 do MenuFileItems(TPopupMenu(MList[i])); mkRecentMenu : for I := 0 to MList.Count - 1 do MenuRecentItems(TPopupMenu(MList[i])); mkHelpMenu : for I := 0 to MList.Count - 1 do begin InitialiseHelpFiles(); MenuHelpItems(TPopupMenu(MList[i])); end; end; MList.Free; end; procedure TSearchForm.AddItemMenu(TheMenu : TPopupMenu; Item : string; mtTag : TMenuTarget; OC : TNotifyEvent; MenuKind : TMenuKind); var MenuItem : TMenuItem; procedure AddHelpItem(); var X : Integer = 0; begin while X < TheMenu.Items.Count do begin if TheMenu.Items[X].Tag = ord(mtMainHelp) then begin TheMenu.Items[X].Add(MenuItem); exit; end; inc(X); end; end; begin if Item = '-' then begin TheMenu.Items.AddSeparator; TheMenu.Items.AddSeparator; exit(); end; MenuItem := TMenuItem.Create(Self); if mtTag = mtQuit then {$ifdef DARWIN} MenuItem.ShortCut:= KeyToShortCut(VK_Q, [ssMeta]); {$else} MenuItem.ShortCut:= KeyToShortCut(VK_Q, [ssCtrl]); {$endif} MenuItem.Tag := ord(mtTag); // for 'File' entries, this identifies the function to perform. MenuItem.Caption := Item; MenuItem.OnClick := OC; case MenuKind of mkFileMenu : TheMenu.Items.Insert(0, MenuItem); mkRecentMenu : TheMenu.Items.Add(MenuItem); mkHelpMenu : AddHelpItem(); end; end; procedure TSearchForm.MenuFileItems(AMenu : TPopupMenu); var i : integer = 0; begin while i < AMenu.Items.Count do begin // Find the seperator if (AMenu.Items[i]).Caption = '-' then break; inc(i); end; dec(i); // cos we want to leave the '-' while (i >= 0) do begin // Remove File Type entries AMenu.Items.Delete(i); // Because it removes Help, removes all the individual help items too. dec(i); end; if AMenu.Items.Count = 0 then // If menu empty, put in seperator AddItemMenu(AMenu, '-', mtSep, nil, mkFileMenu); AddItemMenu(AMenu, rsMenuQuit, mtQuit, @FileMenuClicked, mkFileMenu); AddItemMenu(AMenu, rsMenuHelp, mtMainHelp, nil, mkFileMenu); AddItemMenu(AMenu, rsMenuSettings, mtSettings, @FileMenuClicked, mkFileMenu); AddItemMenu(AMenu, rsMenuSync, mtSync, @FileMenuClicked, mkFileMenu); AddItemMenu(AMenu, rsMenuAbout, mtAbout, @FileMenuClicked, mkFileMenu); AddItemMenu(AMenu, rsMenuSearch, mtSearch, @FileMenuClicked, mkFileMenu); AddItemMenu(AMenu, rsMenuNewNote, mtNewNote, @FileMenuClicked, mkFileMenu); // Note items are in reverse order because we Insert at the top. end; procedure TSearchForm.MenuRecentItems(AMenu : TPopupMenu); var i : integer = 1; //T1, T2, T3, T4 : dword; P : Note_Lister.PNote; // St : string; begin //T1 := gettickcount64(); // debugln('In MenuRecentItems ' + AMenu.Name); i := AMenu.Items.Count; while i > 0 do begin // Remove any existing entries first dec(i); if TMenuItem(AMenu.Items[i]).Tag = ord(mtRecent) then AMenu.Items.Delete(i); end; //T2 := gettickcount64(); // We must iterate over the NoteLister's DateSortList getting the ten most // recent notes. for i := 0 to 9 do begin // P := TheMainNoteLister.GetNote(i, smAllRecentUp); P := TheMainNoteLister.GetNote(i, smAllRecentUp); if P <> nil then AddItemMenu(AMenu, P^.Title, mtRecent, @RecentMenuClicked, mkRecentMenu) else break; end; end; procedure TSearchForm.MenuHelpItems(AMenu : TPopupMenu); var NoteTitle : string = ''; Count : integer; begin Count := AMenu.Items.Count; while Count > 0 do begin // Remove any existing entries first dec(Count); if TMenuItem(AMenu.Items[Count]).Tag = ord(mtMainHelp) then begin AMenu.Items[Count].Clear; break; end; end; if HelpNotes = nil then exit; HelpNotes.StartSearch(); while HelpNotes.NextNoteTitle(NoteTitle) do // ToDo : go direct to HelpNotes.NoteList[i], faster ? AddItemMenu(AMenu, NoteTitle, mtHelp, @FileMenuClicked, mkHelpMenu); end; procedure TSearchForm.FileMenuClicked(Sender : TObject); var FileName : string; //Tick, Tock : qword; begin case TMenuTarget(TMenuItem(Sender).Tag) of mtSep, mtRecent : showmessage('Oh, that is bad, should not happen'); mtNewNote : if (Sett.NoteDirectory = '') then ShowMessage(rsSetupNotesDirFirst) else OpenNote(''); mtSearch : if Sett.NoteDirectory = '' then showmessage(rsSetupNotesDirFirst) else begin MoveWindowHere(Caption); //Tick := Gettickcount64(); EnsureVisible(true); //Tock := Gettickcount64(); Show; //debugln('SearchForm - FileMenuClicked ' + dbgs(Tock - Tick) + 'ms ' + dbgs(GetTickCount64() - Tock) + 'mS'); end; mtAbout : MainForm.ShowAbout(); mtSync : if Sett.ValidSync then Sett.Synchronise() else begin showmessage(rsSetupSyncFirst); Sett.PageControl1.ActivePage := Sett.TabSync; Sett.EnsureVisible(true); Sett.Show; end; mtSettings : begin MoveWindowHere(Sett.Caption); Sett.EnsureVisible(true); Sett.Show; end; mtHelp : begin if HelpNotes.FileNameForTitle(TMenuItem(Sender).Caption, FileName) then {MainForm.}ShowHelpNote(FileName) else showMessage(rsCannotFindNote + TMenuItem(Sender).Caption); end; mtQuit : MainForm.close; end; end; procedure TSearchForm.RecentMenuClicked(Sender: TObject); begin if TMenuItem(Sender).Caption <> SearchForm.MenuEmpty then SearchForm.OpenNote(TMenuItem(Sender).Caption); end; { Will re-run the current search on the assumption that NoteList data has changed. Normally thats a ClearSearch() or NewSearch(). However, if DisplayOnly, the Date Index has been updated and thats all needed. So, its then a display update. } procedure TSearchForm.IndexAndRefresh(DisplayOnly : boolean = false); var NB, STerm : string; begin If DisplayOnly then begin ListViewNotes.Clear; ListViewNotes.Items.Count := TheMainNoteLister.NoteIndexCount() end else begin if EditSearch.text = rsMenuSearch then STerm := '' else STerm := EditSearch.text; if ListBoxNoteBooks.ItemIndex < 0 then NB := '' else NB := ListBoxNotebooks.Items[ListBoxNoteBooks.ItemIndex]; ListViewNotes.Items.Count := 0; if STerm.IsEmpty and NB.IsEmpty then ListViewNotes.Items.Count := TheMainNoteLister.ClearSearch() else ListViewNotes.Items.Count := TheMainNoteLister.NewSearch(STerm, NB); end; end; // --------------- S E A R C H I N G ------------------------------------------- (* procedure TSearchForm.EditSearchExit(Sender: TObject); // ToDo : maybe we don't need this ? begin exit; { if (NIndex <> nil) and (not NIndex.Busy) then begin NIndex.free; NIndex := nil; //writeln('TSearchForm.Edit1Exit - Edit1 exit, killing Index'); end; if EditSearch.Text = '' then begin EditSearch.Hint:=rsSearchHint; EditSearch.Text := rsMenuSearch; EditSearch.SelStart := 1; EditSearch.SelLength := length(EditSearch.Text); end; } end; *) procedure TSearchForm.EditSearchKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); begin // Must do this here to stop LCL from selecting the text on VK_RETURN if Key = VK_RETURN then begin Key := 0; DoSearchEnterPressed(); end; end; { Situations where this is called - * No NoteBook and blank edit - ClearSearch * No NoteBook and 1 char in edit - do nothing * No NoteBook and > 1 char in edit, increasing - if ActiveSearch, RefineSearch, else NewSearch * No NoteBook and > 1 char in edit, decreasing - NewSearch * NoteBook and blank edit - NewSearch with NoteBook * NoteBook and 1 char in edit - do nothing * NoteBook and > 1 char in edit, increasing - - if ActiveSearch, RefineSearch, else NewSearch with NoteBook * NoteBook and > 1 char in edit, decreasing - NewSearch with NoteBook } // Only used in Progressive Search mode, SWYT procedure TSearchForm.EditSearchChange(Sender: TObject); var NoteBook : string; STL : TStringList; Found : integer; //Apoint : TPoint; //AStr : string; //T1, T2, T3 : qword; // Returns the length of the char that b is first byte of { function LengthUTF8Char(b : byte) : integer; begin case b of 0..191 : Result := 1; 192..223 : Result := 2; 224..239 : Result := 3; 240..247 : Result := 4; end; end; } begin { AStr := EditSearch.Text; // Remove the search prompt if its first part of Text if (Astr.Length > rsMenuSearch.Length) and (AStr.StartsWith(rsMenuSearch)) then begin EditSearch.Text := copy(EditSearch.Text, Length(rsMenuSearch)+1, 10); APoint.X := 1; APoint.Y := 0; EditSearch.CaretPos := APoint; end; } if (EditSearch.Text <> '') and (EditSearch.Text <> rsMenuSearch) then ButtonClearSearch.Enabled := True; if (not Sett.AutoSearchUpdate) or (not visible) or (length(EditSearch.Text)=1) then exit; STL := TStringList.Create; try if length(EditSearch.text) = 1 then exit; // Nothing to see here folks // debugln('TSearchForm.EditSearchChange Notebooks.ItemIndex = ' + inttostr(ListBoxNoteBooks.ItemIndex)); if ListBoxNoteBooks.ItemIndex > -1 then // An notebook selected NoteBook := ListBoxNotebooks.Items[ListBoxNoteBooks.ItemIndex] else NoteBook := ''; if not ((EditSearch.Text = '') or (EditSearch.Text = rsMenuSearch)) then // else we pass an empty list. if Sett.SearchCaseSensitive then STL.AddDelimitedtext(EditSearch.Text, ' ', false) else STL.AddDelimitedtext(lowercase(EditSearch.Text), ' ', false); { if (EditSearch.text = '') then begin // ie backspacing // not needed for TextHint model EditSearch.text := rsMenuSearch; EditSearch.SetFocus; EditSearch.SelectAll; if ListBoxNoteBooks.ItemIndex > -1 then Found := TheMainNoteLister.NewSearch(STL, NoteBook) else Found := TheMainNoteLister.ClearSearch(); exit; end; } if (SearchTextLength > length(EditSearch.text)) then begin // ie backspacing, decreasing Found := TheMainNoteLister.NewSearch(STL, NoteBook); SearchActive := True; end else begin // must have added a char. if SearchActive then Found := TheMainNoteLister.RefineSearch(STL) else begin // debugln('TSearchForm.EditSearchChange NEWSEARCH CALLED'); Found := TheMainNoteLister.NewSearch(STL, NoteBook); SearchActive := True; end; end; finally STL.Free; SearchTextLength := length(EditSearch.Text); if length(EditSearch.Text) = 1 then SearchTextLength := 1 else begin //T1 := GetTickCount64(); ListViewNotes.BeginUpdate; ListViewNotes.Items.Count := 0; // Fixes a GTK warning .... ListViewNotes.Items.Count := Found; ListViewNotes.EndUpdate; //T2 := GetTickCount64(); UpdateStatusBar(0, inttostr(Found) + ' ' + rsNotes); end; //debugln('TSearchForm.EditSearchChange() LV Refresh =' + inttostr(T2-T1) + 'mS and '); end; end; procedure TSearchForm.DoSearchEnterPressed(); var // T1, T2, TS3, TS4 : qword; NoteBook : string; STL : TStringList; // At startup, 2K notes, RSS=41.8 Meg, do a search and jumps to 50.5meg begin // T1 := gettickcount64(); if Sett.AutoSearchUpdate then exit; // we don't do that here. STL := TStringList.Create; try if length(EditSearch.text) = 1 then exit; // Nothing to see here folks if ListBoxNoteBooks.ItemIndex > -1 then NoteBook := ListBoxNotebooks.Items[ListBoxNoteBooks.ItemIndex] else NoteBook := ''; if not ((EditSearch.Text = '') or (EditSearch.Text = rsMenuSearch)) then // else we pass an empty list. if Sett.SearchCaseSensitive then STL.AddDelimitedtext(EditSearch.Text, ' ', false) else STL.AddDelimitedtext(lowercase(EditSearch.Text), ' ', false); // if (STL.Count > 0) or (Notebook <> '') then begin TheMainNoteLister.LoadContentForPressEnter(); // Loading 2K notes, 8.6Meg, RSS 43Meg to 51Meg ListViewNotes.Clear; ListViewNotes.Items.Count := TheMainNoteLister.NewSearch(STL, NoteBook); // In SWYT, 52Meg BUT v.34c = 42meg UpdateStatusBar(0, inttostr(ListViewNotes.Items.Count) + ' ' + rsNotes); // end; finally STL.free; end; //T2 := gettickcount64(); //debugln('TSearchForm.DoSearchEnterPressed ' + inttostr(T2-T1) + 'mS'); (* exit; // ------------------------------------------------------------------------- if (EditSearch.Text = '') then ButtonClearFiltersClick(self); // ToDo : why, won't it clear a selected Notebook ? if (EditSearch.Text <> rsMenuSearch) and (EditSearch.Text <> '') then begin ButtonClearFilters.Enabled := True; //TS1:=gettickcount64(); NoteLister.SearchNotes(EditSearch.Text); // observes sett.checkCaseSensitive // OK, this is not going to work...... NoteLister.LoadListNotebooks(ListBoxNotebooks.Items, True); *) { STL.AddDelimitedtext(EditSearch.Text, ' ', false) - easier than NoteLister' buildsearchterm() this just needs to call NewSearch and poke results into ListVeiwNotes.items.count. NoteLister.SearchNotes( should (maybe already does) ret number of notes found, save to Found. It needs to be changed to build a new Index, similar to existing ones. Somehow teach the ListViewNotes OnData event to get its data from the above new Index. Call ListViewNotes.Intems.Count := Found; } // end; end; (* procedure TSearchForm.EditSearchEnter(Sender: TObject); // ToDo : not needed for TextHint model // ToDo : this should select the word, 'Search' if user clicks in field but does not ?? begin exit; if EditSearch.Text = rsMenuSearch then begin EditSearch.SelectAll; end; end; *) procedure TSearchForm.FormDeactivate(Sender: TObject); begin if not Sett.AutoSearchUpdate then TheMainNoteLister.UnLoadContent(); // We assume its necessary, probably and fast anyway end; procedure TSearchForm.FormHide(Sender: TObject); begin if not Sett.AutoSearchUpdate then TheMainNoteLister.UnLoadContent(); // We assume its necessary, probably and fast anyway end; // --------------------- F O R M C O N T R O L S ---------------------------- procedure TSearchForm.FormActivate(Sender: TObject); //var tick : qword; begin // {$ifdef LCLCOCOA} EditSearch.SetFocus; // On Mac, we cannot do "jump to EditSearch on typing" ListViewNotes.SetFocus; end; procedure TSearchForm.FormCloseQuery(Sender: TObject; var CanClose: boolean); begin CanClose := False; hide(); end; procedure TSearchForm.IndexNewNote(const FFName: string; CheckTitleClash : boolean); var ExistingFFName : string; begin if CheckTitleClash and // Don't test if import initiated by CLI TheMainNoteLister.FileNameForTitle(GetTitleFromFFN(Sett.NoteDirectory+FFName, False), ExistingFFName) then if mrYes = QuestionDlg('Note Exists', 'Overwrite Note with same name ?', mtConfirmation, [mrYes, mrNo], 0) then DeleteNote(Sett.NoteDirectory+ExistingFFName) // Thats the existing one, user happy to replace else begin // If user responds 'No', then import is cancelled DeleteFileUTF8(Sett.NoteDirectory+FFName); // The newly created one, not yet indexed. exit; end; RefreshNotebooks(); TheMainNoteLister.IndexThisNote(FFName); // Add it to NoteLister IndexAndRefresh(); // Reruns the current search with new data in NoteList TheMainNoteLister.BuildDateAllIndex(); // Must rebuild it before refreshing menus. RefreshMenus(mkRecentMenu); MainForm.UpdateNotesFound(TheMainNoteLister.NoteList.Count); end; function TSearchForm.IndexNotes(ReRunSearch : boolean=False) : integer; // Calling IndexAndRefresh(); after IndexNotes() seems to fix it ..... begin // Gets called from other units .... if TheMainNoteLister <> Nil then freeandnil(TheMainNoteLister); TheMainNoteLister := TNoteLister.Create; TheMainNoteLister.DebugMode := Application.HasOption('debug-index'); TheMainNoteLister.WorkingDir:=Sett.NoteDirectory; Result := TheMainNoteLister.IndexNotes(); UpdateStatusBar(0, inttostr(Result) + ' ' + rsNotes); RefreshMenus(mkRecentMenu); MainForm.UpdateNotesFound(Result); // Says how many notes found and runs over checklist. Sett.StartAutoSyncAndSnap(); If RerunSearch then begin // Reruns the current search with new data in NoteList it is IndexAndRefresh(); // often necessary if we are re-running, eg after change to note repo RefreshNotebooks(); end; end; procedure TSearchForm.FormCreate(Sender: TObject); //var Tick : qword; {$ifdef LCLQT5}{$ifdef LVOWNERDRAW} var fd: TFontData;{$endif} {$endif} begin {$ifdef LCLQT5} ListBoxNotebooks.TabStop := false; // ToDo : ugly fix for Qt5 "list item half selected" issue. {$endif} SearchTextLength := 0; LVSortMode := smRecentUp; // reflects initial state of ListViewNotes. HelpList := Nil; //Tick := GetTickCount64(); Caption := 'tomboy-ng Search'; TheMainNoteLister := nil; // Thats the one in the Note_Lister unit ! if (SingleNoteFileName <> '') then exit; MoveFocusChar := char(0); // if zero, inactive, if active, it first char in EditSearch; { ListView Settings } // make extra column in Object Inspector ListViewNotes.ViewStyle:= vsReport; ListViewNotes.AutoSort := False; ListViewNotes.OwnerData := True; ListViewNotes.Column[0].Caption := rsName; ListViewNotes.Column[1].Caption := rsLastChange; ListViewNotes.AutoSortIndicator := False; // ListViewNotes.AutoSortIndicator := false; ListViewNotes.Column[1].SortIndicator := siAscending; ListViewNotes.AutoWidthLastColumn:= True; // ToDo : but Qt5 in OwnerData mode demands columns of extra data, eg Filename ListViewNotes.ReadOnly := True; CreateMenus(); // We must build an initial menu BEFORE indexing notes... IndexNotes(); // Messy but IndexNotes calls Refresh Menu and thats necessary ListViewNotes.Items.clear; ListViewNotes.Items.Count := TheMainNoteLister.ClearSearch(); // Builds NoteLister's Index files. TheMainNoteLister.LoadListNotebooks(ListBoxNotebooks.Items, ButtonClearFilters.Enabled); EditSearch.Hint:=rsSearchHint; EditSearch.TextHint := rsMenuSearch; ButtonClearSearch.Enabled := False; EditSearch.SelStart := 1; EditSearch.SelLength := length(EditSearch.Text); RefreshMenus(mkAllMenu); // IndexNotes->UseList has already called RefreshMenus(mkRecentMenu) and Qt5 does not like it. if Mainform.UseTrayMenu then try MainForm.TrayIcon.Show; // Gnome does not like showing it before menu is populated except on E: EAccessViolation do begin // this appears to be a problem on 32bit linux. see https://gitlab.com/freepascal.org/lazarus/lazarus/-/issues/40629 debugln('ERROR : ' + E.Message); debugln('TSearchForm.FormCreate - AV in libayatana, try forcing Traditional System Tray.'); // debugln('Try restarting the app with "--useappind=no" on command line'); showmessage('ERROR see help note "System Tray on Linux"'); end; end; MenuItemCaseSensitive.checked := Sett.SearchCaseSensitive; MenuItemSWYT.checked := Sett.AutoSearchUpdate; MenuItemImportNote.Hint := rsHelpImportFile; // ToDo : OK, where is ShowHint ? {$ifdef LVOWNERDRAW} ListViewNotes.OwnerDraw:= True; {$ifdef LCLQT5} // This because when ownerdrawn, we loose spacing between rows in Qt5, ugly workaround. fd := GetFontData( SearchForm.Font.Handle ); ListViewNotes.Font.Height := round((fd.Height * 72 / SearchForm.Font.PixelsPerInch)) + 4; {$endif} {$endif} TheReindexProc := @IndexNewNote; end; procedure TSearchForm.FormShow(Sender: TObject); var Butt : TButton; begin Left := Placement + random(Placement*2); Top := Placement + random(Placement * 2); if Sett.DarkThemeSwitch then begin // We are not relying on OS to set dark theme, it was --dark-theme Color := Sett.AltColour; // black is 000000, white FFFFFF font.Color := Sett.TextColour; // Sets children font colour too ListBoxNotebooks.Color := Sett.BackGndColour; EditSearch.Color := Sett.AltColour; splitter1.Color:= clnavy; for Butt in [ButtonClearFilters, BitBtnMenu, ButtonSearchOptions, ButtonClearSearch ] do Butt.Color := Sett.AltColour; // Does work for Qt5, not for GTK2 (but not needed), Windows ? end; ListViewNotes.Color := ListBoxNoteBooks.Color; ListBoxNotebooks.Hint := rsNotebookOptionRight; if (ListViewNotes.Column[0].SortIndicator = siNone) then begin BounceSortIndicator(1); end; {$ifdef LCLCOCOA} BitBtnMenu.Refresh; ListBoxNotebooks.Hint := rsNotebookOptionCtrl; // EditSearch.SetFocus; // Cocoa issue, 'cos we cannot make the "on type, jump to EditSearch" work on Mac {$endif} ListViewNotes.SetFocus; // {$endif} if ListViewNotes.Items.Count > 0 then ListViewNotes.ItemIndex := 0; end; procedure TSearchForm.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin if [{$ifdef DARWIN}ssMeta{$else}ssCtrl{$endif}] = Shift then begin if key = ord('N') then begin OpenNote(''); Key := 0; exit(); end; if key = VK_Q then begin // debugln('TSearchForm.FormKeyDown - Quitting because of a Ctrl-Q'); MainForm.Close(); end; end; end; procedure TSearchForm.FormResize(Sender: TObject); begin ScaleListView(); end; procedure TSearchForm.FormDestroy(Sender: TObject); begin FreeAndNil(TheMainNoteLister); FreeAndNil(HelpNotes); FreeAndNil(HelpList); end; procedure TSearchForm.MarkNoteReadOnly(const FullFileName: string); var TheForm : TForm; begin if TheMainNoteLister = nil then exit; if TheMainNoteLister.IsThisNoteOpen(FullFileName, TheForm) then begin // if user opened and then closed, we won't know we cannot access try TEditBoxForm(TheForm).SetReadOnly(); exit(); except on EAccessViolation do DebugLn('Tried to mark a closed note as readOnly, that is OK'); end; end; end; function TSearchForm.MoveWindowHere(WTitle: string): boolean; {$ifdef LINUX} var AProcess: TProcess; List : TStringList = nil; {$endif} begin Result := False; {$IFDEF LINUX} // ToDo : Apparently, Windows now has something like Workspaces, implement ..... //debugln('In MoveWindowHere with ', WTitle); AProcess := TProcess.Create(nil); AProcess.Executable:= 'wmctrl'; AProcess.Parameters.Add('-R' + WTitle); AProcess.Options := AProcess.Options + [poWaitOnExit, poUsePipes]; try AProcess.Execute; Result := (AProcess.ExitStatus = 0); // says at least one packet got back except on E: EProcess do debugln('Is wmctrl available ? Cannot move ' + WTitle); end; List := TStringList.Create; List.LoadFromStream(AProcess.Output); // just to clear it away. //debugln('Process List ' + List.Text); List.Free; AProcess.Free; {$endif} end; procedure TSearchForm.OpenNote(NoteTitle: String; FullFileName: string; TemplateIs: AnsiString; BackUp: boolean; InSearch: boolean; STerm : string); // Everything except the first parameter is optional, take care ! // Might be called with no Title (NewNote) or a Title with or without a Filename // When called from EditBox, we may pass a Notebook Name, if its a new note that // notebook will be associated with the new note. Otherwise, ANY request for a new // note while a notebook is selected in SeachForm will assign the notebook to note. // If we choose NewNoteFromTemplate TemplateIs is NOT set because we create the note // and pass its filename into here. It already has its template associated. var EBox : TEditBoxForm; NoteFileName : string; TheForm : TForm; begin NoteFileName := FullFileName; if (NoteTitle <> '') then begin if FullFileName = '' then Begin if TheMainNoteLister.FileNameForTitle(NoteTitle, NoteFileName) then NoteFileName := Sett.NoteDirectory + NoteFileName else NoteFileName := ''; end else NoteFileName := FullFileName; // if we have a Title and a Filename, it might be open aleady if TheMainNoteLister.IsThisNoteOpen(NoteFileName, TheForm) then begin // Note is already open // if user opened and then closed, we won't know we cannot re-show try TheForm.Show; MoveWindowHere(TheForm.Caption); TheForm.EnsureVisible(true); if (NoteFileName <> '') and (NoteTitle <> '') and (InSearch) then if STerm = '' then TEditBoxForm(TheForm).NewFind(EditSearch.Text) else TEditBoxForm(TheForm).NewFind(STerm); // ToDo : this does not select the target note's link correctly. (BackLink mode ?) exit(); except on EAccessViolation do DebugLn('Tried to re show a closed note, that is OK'); end; // We catch the exception and proceed .... but it should never happen. end; end; // if to here, we need open a new window. If Filename blank, its a new note // If we already have a template (ie notebook) then ignore the SearchForm notebook selection if (TemplateIs = '') and (NoteFileName = '') and (NoteTitle ='') and (ListBoxNotebooks.ItemIndex > -1) then // a new note with notebook selected. TemplateIs := ListBoxNotebooks.Items[ListBoxNotebooks.ItemIndex]; EBox := TEditBoxForm.Create(Application); EBox.SearchedTerm := ''; // We will do this search after the note has settled dowm if (NoteFileName <> '') and (NoteTitle <> '') and (InSearch) then if STerm = '' then EBox.SearchedTerm := EditSearch.Text else EBox.SearchedTerm := Sterm; EBox.NoteTitle:= NoteTitle; EBox.NoteFileName := NoteFileName; Ebox.TemplateIs := TemplateIs; EBox.Show; // if we have a NoteFileName at this stage, we just opened an existing note. { if (NoteFileName <> '') and (NoteTitle <> '') and (InSearch) then if STerm = '' then EBox.NewFind(EditSearch.Text) else EBox.NewFind(Sterm); } if (NoteFileName <> '') and BackUp then BackupNote(NoteFileName, 'opn'); EBox.Dirty := False; TheMainNoteLister.ThisNoteIsOpen(NoteFileName, EBox); end; // ----------------------------- ListView Things ------------------------------- { ListView Settings - Are set in CreateForm. AutoSort, AutoSortIndicator, AutoWidthLastColumn all true Make two columns, name them, leave autwith off, ReadOnly, RowSelect true ScrollBars ssAutoVertical, ViewStyle vsReport. Note that AutoSortIndicator and SortIndicator are not available in LCL2.0.6 and earlier So, don't set them in the form, leave at default settings and set them in a } {if lcl > 2.0.6} { structure. Note, the IDE gets this wrong and greys lines out it should not. } procedure TSearchForm.ListViewNotesColumnClick(Sender: TObject; Column: TListColumn); begin (* case Column.SortIndicator of siNone : debugln(' Column is siNone - ' + Column.Caption); siDescending : debugln(' Column is siDescending - ' + Column.Caption); siAscending : debugln(' Column is siAscending - ' + Column.Caption); end; *) if Column.Caption = rsName then case Column.SortIndicator of siNone, siDescending : begin LVSortMode := smAATitleUp; // Ascending pointing down, AA at top Column.SortIndicator := siAscending; end; siAscending : begin LVSortMode := smAATitleDown; // Descending pointing up, ZZ at top Column.SortIndicator := siDescending; end; end else case Column.SortIndicator of siDescending : begin // The None case is dealt with in create and show LVSortMode := smRecentUp; // Ascending pointing down, Recent at top Column.SortIndicator := siAscending; end; siAscending : begin LVSortMode := smRecentDown; // Decending pointing up, Oldest at top Column.SortIndicator := siDescending; end; end; ListViewNotes.Items.Count := 0; ListViewNotes.Items.Count := TheMainNoteLister.NoteIndexCount(); // Does not rebuild Indexes, just display them again BounceSortIndicator(column.Index); // To refresh the sortIndicator end; procedure TSearchForm.BounceSortIndicator(Col : integer); begin if ListViewNotes.Column[Col].SortIndicator = siDescending then begin ListViewNotes.Column[col].SortIndicator := siAscending; ListViewNotes.Column[col].SortIndicator := siDescending; end else begin ListViewNotes.Column[col].SortIndicator := siDescending; ListViewNotes.Column[col].SortIndicator := siAscending; end; end; procedure TSearchForm.ListViewNotesData(Sender: TObject; Item: TListItem); var P : Note_Lister.PNote; St : string; //T1, T2, T3, T4, T5 : qword; begin //T1 := GetTickCount64(); // Will get all the entries from note list that are mentioned in the appropriate // index (determined by the regional LVSortMode, set by click of column headers) P := TheMainNoteLister.GetNote(Item.Index, LVSortMode); //debugln('TSearchForm.ListViewNotesData calling item ' + inttostr(Item.Index) + ' ' + P^.LastChange); if P <> nil then begin // note that QT5 requires both extra columns be created. Item.Caption := P^.Title; St := copy(P^.LastChange, 1, 16); if St[11] = 'T' then St[11] := ' '; // Item.SubItems.Add(P^.LastChange); Item.SubItems.Add(St); Item.SubItems.Add(P^.ID); //debugln('TSearchForm.ListViewNotesData calling item ' + Item.SubItems.Text); end else Item.Caption := 'ERROR'; //T2 := GetTickCount64(); //debugln('TSearchForm.ListViewNotesData() ' + inttostr(T2-T1) + 'mS '); { While in GTK2, LV asks about all rows in data set its still unmeasurable with 2000 lines } end; procedure TSearchForm.ListViewNotesDblClick(Sender: TObject); var NoteTitle : ANSIstring; FullFileName : string; begin if ListViewNotes.Selected = nil then exit; // White space below notes .... NoteTitle := ListViewNotes.Selected.Caption; FullFileName := Sett.NoteDirectory + ListViewNotes.Selected.SubItems[1]; if not FileExistsUTF8(FullFileName) then begin showmessage('Cannot open ' + FullFileName); exit(); end; if length(NoteTitle) > 0 then OpenNote(NoteTitle, FullFileName, '', True, ((EditSearch.Text <> '') and (EditSearch.Text <> rsMenuSearch) and Visible)); end; procedure TSearchForm.ListViewNotesDrawItem(Sender: TCustomListView; AItem: TListItem; ARect: TRect; AState: TOwnerDrawState); begin // Note this only works for TListView if ViewStyle is vsReport // (and obviously, we are in ownerdraw mode). {$ifdef LVOWNERDRAW} if Odd(AItem.Index) then ListViewNotes.Canvas.Brush.Color := Sett.AltColour; ListViewNotes.Canvas.FillRect(ARect); {$ifdef LCLQT5} // Note we have increased the font height for Qt5 in OnCreate() ListViewNotes.Canvas.TextRect(ARect, 2, ARect.Top, AItem.Caption); // Title column ListViewNotes.Canvas.TextRect(ARect, ListViewNotes.Column[0].Width + 2 // LCD Column , ARect.Top, AItem.SubItems[0]); {$else} ListViewNotes.Canvas.TextRect(ARect, 2, ARect.Top+2, AItem.Caption); // Title column ListViewNotes.Canvas.TextRect(ARect, ListViewNotes.Column[0].Width + 2 // LCD Column , ARect.Top+2, AItem.SubItems[0]); {$endif} {$endif} end; procedure TSearchForm.EditSearchEnter(Sender: TObject); begin if MoveFocusChar <> char(0) then begin // listview or listbox put something in there, use it EditSearch.Caption := EditSearch.Caption + MoveFocusChar; MoveFocusChar := char(0); EditSearch.SelStart := length(EditSearch.Caption); // Windows, Mac needs this, does no harm. EditSearch.SelLength := 0; end; end; procedure TSearchForm.ListViewNotesKeyPress(Sender: TObject; var Key: char); // Also services ListBoxNotebooks begin if Key = char(ord(VK_RETURN)) then ListViewNotesDblClick(Sender) else begin MoveFocusChar := Key; EditSearch.SetFocus(); end; Key := char(0); { Note, the above is to ensure the char typed that triggers move of focus to EditSearch is not lost. GTK2 does not loose it but easier to do it for all. } end; procedure TSearchForm.ScaleListView(); var Col1Width : integer; begin {$ifdef LCLQT5 } Col1width := listviewnotes.Canvas.Font.GetTextWidth('2020-06-02 12:30:00000'); // 00 allow for apparent error in scroll with {$else} Col1width := listviewnotes.Canvas.Font.GetTextWidth('2020-06-02 12:30:000'); {$endif} ListViewNotes.Column[1].Width := Col1width; if ListViewNotes.ClientWidth > 100 then ListViewNotes.Column[0].Width := ListViewNotes.ClientWidth - Col1width; (* debugln('TSearchForm.ScaleListView Clientwidth=' + inttostr(ListViewNotes.ClientWidth) +#10 + ' Col-0=' + inttostr(ListViewNotes.Column[0].Width)+#10 + ' Col-1=' + inttostr(ListViewNotes.Column[1].Width)+#10 + ' Col-2=' + inttostr(ListViewNotes.Column[2].Width)+#10 + ' Text W=' + inttostr(listviewnotes.Canvas.Font.GetTextWidth('2020-06-02 12:30:000'))+#10 + ' Text QT5=' + inttostr(listviewnotes.Canvas.Font.GetTextWidth('2020-06-02 12:30:00000'))); *) end; procedure TSearchForm.BackupNote(const NoteName, PutIntoName : string); var NewName : string; OldName : string; begin NewName := ExtractFileNameOnly(NoteName); OldName := Sett.NoteDirectory + NewName + '.note'; if not FileExistsUTF8(OldName) then exit; // Its a new, as yet unsave note if length(NewName) <> 36 then exit; // We only do notes with UUID names // We remove last four char from ID and replace with eg, -opn or -ttl. This has // some loss of entropy, acceptable and allows use of existing Backup recovery. NewName := Sett.NoteDirectory + 'Backup' + PathDelim + copy(NewName, 1, 32) + '-' + PutIntoName + '.note'; // We assume here that Sett unit has checked and created a Backup dir is necessary. if FileExistsUTF8(NewName) then if not DeleteFile(NewName) then debugln('ERROR, failed to delete ' + NewName); {debugln('File exists = ' + booltostr(, True)); debugln('Dir exits = ' + booltostr(DirectoryExists(Sett.NoteDirectory + 'Backup'), True)); } if not CopyFile(OldName, NewName) then debugln('ERROR, failed to copy : ' + #10 + OldName + #10 + NewName); //debugln('SearchForm : BackupNote ' + #10 + OldName + #10 + NewName); end; { ----------------- NOTEBOOK STUFF -------------------- } // This ButtonSMenu clears both search term (if any) and restores all notebooks and // displays all available notes. procedure TSearchForm.ButtonClearFiltersClick(Sender: TObject); begin ButtonClearFilters.Enabled := False; ListBoxNotebooks.ItemIndex := -1; EditSearch.Hint:=rsSearchHint; if Sett.AutoSearchUpdate then begin // Search While You Type ListViewNotes.clear; if (EditSearch.Text = '') or (EditSearch.Text = rsMenuSearch) then // ie, no search term ListViewNotes.Items.Count := TheMainNoteLister.ClearSearch() else ListViewNotes.Items.Count := TheMainNoteLister.NewSearch(EditSearch.Text, ''); end else DoSearchEnterPressed(); UpdateStatusBar(0, inttostr(ListViewNotes.Items.Count) + ' ' + rsNotes); end; procedure TSearchForm.ListBoxNotebooksClick(Sender: TObject); var STL : TStringList; begin if ListBoxNotebooks.ItemIndex >= 0 then begin // debugln('TSearchForm.ListBoxNotebooksClick - ' + inttostr(ListBoxNotebooks.ItemIndex)); ButtonClearFilters.Enabled := True; // ButtonRefreshClick(self); // ToDo : wots that doing ? STL := TStringList.Create; if not ((EditSearch.Text = '') or (EditSearch.Text = rsMenuSearch)) then STL.AddDelimitedtext(EditSearch.Text, ' ', false); // else we pass an empty list. ListViewNotes.Clear; ListViewNotes.Items.Count := TheMainNoteLister.NewSearch(STL, ListBoxNotebooks.Items[ListBoxNotebooks.ItemIndex]); STL.Free; UpdateStatusBar(0, inttostr(ListViewNotes.Items.Count) + ' ' + rsNotes); end; end; // Popup a menu when rightclick a notebook procedure TSearchForm.ListBoxNotebooksMouseUp(Sender: TObject; ButtonSMenu: TMouseButton; Shift: TShiftState; X, Y: Integer); var HaveItem : boolean; begin // debugln('TSearchForm.ListBoxNotebooksMouseDown - Selected in listboxnotebook ' + dbgs(ListBoxNotebooks.ItemIndex)); if {$ifdef DARWIN} (ssCtrl in Shift) {$ELSE} (ButtonSMenu = mbRight) {$ENDIF} then begin HaveItem := (ListBoxNotebooks.ItemIndex > -1); PopupMenuNotebook.Items[0].Enabled := HaveItem; PopupMenuNotebook.Items[1].Enabled := HaveItem; PopupMenuNotebook.Items[2].Enabled := HaveItem; PopupMenuNotebook.Items[3].Enabled := HaveItem; PopupMenuNotebook.Items[4].Enabled := HaveItem; PopupMenuNotebook.Popup; end; end; procedure TSearchForm.ButtonSMenuClick(Sender: TObject); begin PopupTBMainMenu.popup; end; procedure TSearchForm.MenuEditNotebookTemplateClick(Sender: TObject); var NotebookID : ANSIString; begin NotebookID := TheMainNoteLister.NotebookTemplateID(ListBoxNotebooks.Items[ListBoxNotebooks.ItemIndex]); if NotebookID = '' then //showmessage('Error, cannot open template for ' + StringGridNotebooks.Cells[0, StringGridNotebooks.Row]) showmessage('Error, cannot open template for ' + ListBoxNotebooks.Items[ListBoxNoteBooks.ItemIndex]) else OpenNote(ListBoxNotebooks.Items[ListBoxNoteBooks.ItemIndex] + ' Template', Sett.NoteDirectory + NotebookID); end; procedure TSearchForm.MenuCreateNoteBookClick(Sender: TObject); var NotebookPick : TNotebookPick; NewNoteBookName : string = ''; i : integer = 0; begin NotebookPick := TNotebookPick.Create(Application); NotebookPick.TheMode := nbMakeNewNoteBook; NotebookPick.FullFileName := ''; NotebookPick.Title := ''; NotebookPick.ChangeMode := False; NotebookPick.Top := Top; NotebookPick.Left := Left; if mrOK = NotebookPick.ShowModal then NewNotebookName := NotebookPick.NBName; NotebookPick.Free; ButtonClearFilters.Click; if NewNoteBookName <> '' then begin while i < ListBoxNoteBooks.Count do begin if ListBoxNoteBooks.Items[i] = NewNoteBookName then break else inc(i); end; if i < ListBoxNoteBooks.Count then begin ListBoxNoteBooks.ItemIndex := i; ListBoxNoteBooks.click; end else debugln('TSearchForm.MenuCreateNoteBookClick - failed to find the new NotebookName'); end; end; // ---------------------- S E A R C H O P T I O N S -------------------------- procedure TSearchForm.MenuItemCaseSensitiveClick(Sender: TObject); begin MenuItemCaseSensitive.Checked := not MenuItemCaseSensitive.Checked; Sett.SearchCaseSensitive := MenuItemCaseSensitive.Checked; end; procedure TSearchForm.MenuItemImportNoteClick(Sender: TObject); begin {$ifdef UNIX} OpenDialogImport.InitialDir := GetEnvironmentVariable('HOME'); {$endif} {$ifdef WINDOWS} OpenDialogImport.InitialDir := GetEnvironmentVariable('HOMEPATH'); {$endif} OpenDialogImport.Filter := 'Text|*.txt|Markdown|*.md|Note|*.note'; OpenDialogImport.Title := rsHelpImportFile; if OpenDialogImport.Execute then begin if TrimFilename(OpenDialogImport.FileName).EndsWith('.note') then import_note(TrimFilename(OpenDialogImport.FileName)) else if TrimFilename(OpenDialogImport.FileName).EndsWith('.md') then Import_Text_MD_File(True, TrimFilename(OpenDialogImport.FileName)) else if TrimFilename(OpenDialogImport.FileName).EndsWith('.txt') then Import_Text_MD_File(False, TrimFilename(OpenDialogImport.FileName)) else showmessage('Cannot import TrimFilename(OpenDialogLibrary.FileName)'); end; end; procedure TSearchForm.ButtonSearchOptionsClick(Sender: TObject); begin PopupMenuSearchOptions.PopUp; end; procedure TSearchForm.MenuItemSWYTClick(Sender: TObject); begin MenuItemSWYT.Checked := not MenuItemSWYT.Checked; Sett.AutoSearchUpdate := MenuItemSWYT.Checked; TheMainNoteLister.IndexNotes(); end; procedure TSearchForm.ButtonClearSearchClick(Sender: TObject); begin EditSearch.text := ''; //rsMenuSearch; //EditSearch.SetFocus; ListViewNotes.SetFocus; EditSearch.SelectAll; if Sett.AutoSearchUpdate then begin // Search While You Type ListViewNotes.Clear; if ListBoxNoteBooks.ItemIndex < 0 then // ie, no Notebook selected ListViewNotes.Items.Count := TheMainNoteLister.ClearSearch() else ListViewNotes.Items.Count := TheMainNoteLister.NewSearch('', ListBoxNotebooks.Items[ListBoxNoteBooks.ItemIndex]); end else DoSearchEnterPressed(); SearchActive := False; UpdateStatusBar(0, inttostr(ListViewNotes.Items.Count) + ' ' + rsNotes); ButtonClearSearch.Enabled := false; end; procedure TSearchForm.BitBtnMenuClick(Sender: TObject); begin PopupTBMainMenu.popup; end; // ---------------- procedure TSearchForm.MenuItemManageNBookClick(Sender: TObject); var NotebookPick : TNotebookPick; begin NotebookPick := TNotebookPick.Create(Application); NotebookPick.TheMode := nbSetNotesInNoteBook; NotebookPick.FullFileName := ''; NotebookPick.Title := ''; NotebookPick.NBName := ListBoxNotebooks.Items[ListBoxNoteBooks.ItemIndex]; NotebookPick.ChangeMode := False; NotebookPick.Top := Top; NotebookPick.Left := Left; // if mrOK = NotebookPick.ShowModal then MarkDirty(); NotebookPick.ShowModal; NotebookPick.Free; ListBoxNotebooksClick(Sender); // ButtonClearFilters.Click; // ToDo : this should select the new Notebook if one made end; procedure TSearchForm.MenuRenameNoteBookClick(Sender: TObject); var NotebookPick : TNotebookPick; begin NotebookPick := TNotebookPick.Create(Application); NotebookPick.TheMode := nbChangeName; try NotebookPick.Title := ListBoxNotebooks.Items[ListBoxNoteBooks.ItemIndex]; NotebookPick.ChangeMode := True; NotebookPick.Top := Top; NotebookPick.Left := Left; if mrOK = NotebookPick.ShowModal then ButtonClearFilters.Click; finally NotebookPick.Free; end; end; procedure TSearchForm.MenuDeleteNotebookClick(Sender: TObject); begin if IDYES = Application.MessageBox('Delete this Notebook', PChar(ListBoxNotebooks.Items[ListBoxNoteBooks.ItemIndex]), MB_ICONQUESTION + MB_YESNO) then DeleteNote(Sett.NoteDirectory + TheMainNoteLister.NotebookTemplateID(ListBoxNotebooks.Items[ListBoxNoteBooks.ItemIndex])); end; procedure TSearchForm.MenuNewNoteFromTemplateClick(Sender: TObject); begin OpenNote( MakeNoteFromTemplate(Sett.NoteDirectory + TheMainNoteLister.NotebookTemplateID(ListBoxNotebooks.Items[ListBoxNoteBooks.ItemIndex])), '', ''); end; // Copy Template to a new name removing the <tag>system:template</tag> and setting a Title function TSearchForm.MakeNoteFromTemplate(const Template : String) : string; var InFile, OutFile: TextFile; InString : String; //Start, Finish : integer; GUID : TGUID; RandBit, NewGUID : string; begin Result := ''; CreateGUID(GUID); NewGUID := copy(GUIDToString(GUID), 2, 36); RandBit := copy(NewGUID, 1, 4); // To add to template name initially AssignFile(InFile, Template); AssignFile(OutFile, Sett.NoteDirectory + NewGUID + '.note'); try try Reset(InFile); Rewrite(OutFile); while not eof(InFile) do begin readln(InFile, InString); if (Pos('<tag>system:template</tag>', InString) > 0) then // skip line continue; if (Pos('<title>', InString) > 0) then InString := InString.Replace('Template', RandBit, [rfReplaceAll]); // Now, this might be the same line as above. <note-content version="0.3"> // but it might be 0.1 or 0.2 even. Possible (in gnote) that this line // also contains note content, bad if it has the word 'Template' .... if (Pos('<note-content version="', InString) > 0) then InString := InString.Replace('Template', RandBit, [rfReplaceAll]); writeln(OutFile, InString); end; finally CloseFile(OutFile); CloseFile(InFile); end; TheMainNoteLister.IndexThisNote(NewGUID); result := GetTitleFromFFN(Sett.NoteDirectory + NewGUID + '.note', false); except on E: EInOutError do begin debugln('File handling error occurred making new note from template. Details: ' + E.Message); exit(''); end; end; end; end. ��tomboy-ng_0.39-1/source/fpttf.pp��������������������������������������������������������������������0000644�0001750�0001750�00000051441�14551457644�016430� 0����������������������������������������������������������������������������������������������������ustar �dbannon�������������������������dbannon����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������{ This file is part of the Free Component Library (FCL) Copyright (c) 2015 by Graeme Geldenhuys Description: This is a homegrown font cache. The fpReport reports can reference a font by its name. The job of the font cache is to look through its cached fonts to match the font name, and which *.ttf file it relates too. The reporting code can then extract font details correctly (eg: font width, height etc). See the file COPYING.FPC, included in the FPC distribution, for details about the copyright. Library GNU General Public License (with exception). This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. **********************************************************************} unit fpTTF; {$mode objfpc}{$H+} {.$define ttfdebug} interface uses Classes, SysUtils, contnrs, fpparsettf; type TTrueTypeFontStyle = (fsRegular, fsItalic, fsBold, fsCondensed, fsExtraLight, fsLight, fsSemibold, fsMedium, fsBlack, fsFixedWidth); TTrueTypeFontStyles = set of TTrueTypeFontStyle; { Forward declaration } TFPFontCacheList = class; TFPFontCacheItem = class(TObject) private FFamilyName: String; FFileName: String; FStyleFlags: TTrueTypeFontStyles; FFileInfo: TTFFileInfo; FOwner: TFPFontCacheList; // reference to FontCacheList that owns this instance FPostScriptName: string; FHumanFriendlyName: string; // aka FullName procedure DoLoadFileInfo; procedure LoadFileInfo; procedure BuildFontCacheItem; procedure SetStyleIfExists(var AText: string; var AStyleFlags: TTrueTypeFontStyles; const AStyleName: String; const AStyle: TTrueTypeFontStyle); function GetIsBold: boolean; function GetIsFixedWidth: boolean; function GetIsItalic: boolean; function GetIsRegular: boolean; function GetFamilyName: String; function GetPostScriptName: string; function GetHumanFriendlyName: string; function GetFileInfo: TTFFileInfo; public constructor Create(const AFilename: String); destructor Destroy; override; { Result is in pixels } function TextWidth(const AStr: utf8string; const APointSize: single): single; { Result is in pixels } function TextHeight(const AText: utf8string; const APointSize: single; out ADescender: single): single; property FileName: String read FFileName; property FamilyName: String read GetFamilyName; property PostScriptName: string read GetPostScriptName; property HumanFriendlyName: string read GetHumanFriendlyName; property FontData: TTFFileInfo read GetFileInfo; { A bitmasked value describing the full font style } property StyleFlags: TTrueTypeFontStyles read FStyleFlags; { IsXXX properties are convenience properties, internally querying StyleFlags. } property IsFixedWidth: boolean read GetIsFixedWidth; property IsRegular: boolean read GetIsRegular; property IsItalic: boolean read GetIsItalic; property IsBold: boolean read GetIsBold; end; TFPFontCacheItemArray = Array of TFPFontCacheItem; { TFPFontCacheList } EFontNotFound = Class(Exception); TFPFontCacheList = class(TObject) private FBuildFontCacheIgnoresErrors: Boolean; FList: TObjectList; FSearchPath: TStringList; FDPI: integer; procedure SearchForFonts(const AFontPath: String); procedure SetDPI(AValue: integer); { Set any / or \ path delimiters to the OS specific delimiter } procedure FixPathDelimiters; protected function DoFindPostScriptFontName(const AFontName: string; ABold: boolean; AItalic: boolean; Out aBaseFont : TFPFontCacheItem): String; function GetCount: integer; virtual; function GetItem(AIndex: Integer): TFPFontCacheItem; virtual; procedure SetItem(AIndex: Integer; AValue: TFPFontCacheItem); virtual; public constructor Create; destructor Destroy; override; procedure BuildFontCache; function Add(const AObject: TFPFontCacheItem): integer; procedure AssignFontList(const AStrings: TStrings); procedure Clear; procedure LoadFromFile(const AFilename: string); procedure ReadStandardFonts; property Count: integer read GetCount; function IndexOf(const AObject: TFPFontCacheItem): integer; // Find postscript font name based on fontname and attributes function FindPostScriptFontName(const AFontName: string; ABold: boolean; AItalic: boolean): String; // Same as Find, but raise exception when not found. function GetPostScriptFontName(const AFontName: string; ABold: boolean; AItalic: boolean): String; function Find(const AFontCacheItem: TFPFontCacheItem): integer; overload; function Find(const AFamilyName: string; ABold: boolean; AItalic: boolean): TFPFontCacheItem; overload; function Find(const APostScriptName: string): TFPFontCacheItem; overload; function FindHumanFriendly(const AName: string ): TFPFontCacheItem; overload; function FindFamily(const AFamilyName: string ): TFPFontCacheItemArray; overload; function FindFont(const AName: string): TFPFontCacheItem; overload; { not used: utility function doing a conversion for us. } function PointSizeInPixels(const APointSize: single): single; property Items[AIndex: Integer]: TFPFontCacheItem read GetItem write SetItem; default; property SearchPath: TStringList read FSearchPath; property DPI: integer read FDPI write SetDPI; Property BuildFontCacheIgnoresErrors : Boolean Read FBuildFontCacheIgnoresErrors Write FBuildFontCacheIgnoresErrors; end; function gTTFontCache: TFPFontCacheList; implementation uses DOM ,XMLRead {$ifdef mswindows} ,Windows, // for SHGetFolderPath API call used by gTTFontCache.ReadStandardFonts() method Shlobj,activex {$endif} ; resourcestring rsNoSearchPathDefined = 'No search path was defined'; rsNoFontFileName = 'The FileName property is empty, so we can''t load font data.'; rsMissingFontFile = 'The font file <%s> can''t be found.'; SErrFontNotFound = 'The font <%s> can''t be found'; var uFontCacheList: TFPFontCacheList; function gTTFontCache: TFPFontCacheList; begin if not Assigned(uFontCacheList) then begin uFontCacheList := TFPFontCacheList.Create; end; Result := uFontCacheList; end; { TFPFontCacheItem } procedure TFPFontCacheItem.DoLoadFileInfo; begin if not Assigned(FFileInfo) then LoadFileInfo; end; procedure TFPFontCacheItem.LoadFileInfo; begin if FileExists(FFilename) then begin FFileInfo := TTFFileInfo.Create; FFileInfo.LoadFromFile(FFilename); BuildFontCacheItem; end else raise ETTF.CreateFmt(rsMissingFontFile, [FFilename]); end; function TFPFontCacheItem.GetIsBold: boolean; begin DoLoadFileInfo; Result := fsBold in FStyleFlags; end; function TFPFontCacheItem.GetIsFixedWidth: boolean; begin DoLoadFileInfo; Result := fsFixedWidth in FStyleFlags; end; function TFPFontCacheItem.GetIsItalic: boolean; begin DoLoadFileInfo; Result := fsItalic in FStyleFlags; end; function TFPFontCacheItem.GetIsRegular: boolean; begin DoLoadFileInfo; Result := fsRegular in FStyleFlags; end; function TFPFontCacheItem.GetFamilyName: String; begin DoLoadFileInfo; Result := FFamilyName; end; function TFPFontCacheItem.GetPostScriptName: string; begin DoLoadFileInfo; Result := FPostScriptName; end; function TFPFontCacheItem.GetHumanFriendlyName: string; begin DoLoadFileInfo; Result := FHumanFriendlyName; end; function TFPFontCacheItem.GetFileInfo: TTFFileInfo; begin DoLoadFileInfo; Result := FFileInfo; end; procedure TFPFontCacheItem.BuildFontCacheItem; var s: string; begin s := FFileInfo.PostScriptName; FPostScriptName := s; FFamilyName := FFileInfo.FamilyName; if Pos(s, FFamilyName) = 1 then Delete(s, 1, Length(FFamilyName)); FHumanFriendlyName := FFileInfo.HumanFriendlyName; FStyleFlags := [fsRegular]; // extract simple styles first if FFileInfo.PostScript.isFixedPitch > 0 then FStyleFlags := [fsFixedWidth]; // this should overwrite Regular style if FFileInfo.PostScript.ItalicAngle <> 0 then FStyleFlags := FStyleFlags + [fsItalic]; // Now to more complex styles stored in StyleName field. eg: 'Condensed Medium' SetStyleIfExists(s, FStyleFlags, 'Bold', fsBold); SetStyleIfExists(s, FStyleFlags, 'Condensed', fsCondensed); SetStyleIfExists(s, FStyleFlags, 'ExtraLight', fsExtraLight); SetStyleIfExists(s, FStyleFlags, 'Light', fsLight); SetStyleIfExists(s, FStyleFlags, 'Semibold', fsSemibold); SetStyleIfExists(s, FStyleFlags, 'Medium', fsMedium); SetStyleIfExists(s, FStyleFlags, 'Black', fsBlack); SetStyleIfExists(s, FStyleFlags, 'Oblique', fsItalic); end; procedure TFPFontCacheItem.SetStyleIfExists(var AText: string; var AStyleFlags: TTrueTypeFontStyles; const AStyleName: String; const AStyle: TTrueTypeFontStyle); var i: integer; begin i := Pos(AStyleName, AText); if i > 0 then begin AStyleFlags := AStyleFlags + [AStyle]; Delete(AText, i, Length(AStyleName)); end; end; constructor TFPFontCacheItem.Create(const AFilename: String); begin inherited Create; FFileName := AFilename; FStyleFlags := [fsRegular]; if AFileName = '' then raise ETTF.Create(rsNoFontFileName); end; destructor TFPFontCacheItem.Destroy; begin FFileInfo.Free; inherited Destroy; end; { TextWidth returns with width of the text. If APointSize = 0.0, then it returns the text width in Font Units. If APointSize > 0 then it returns the text width in Pixels. } function TFPFontCacheItem.TextWidth(const AStr: utf8string; const APointSize: single): single; { From Microsoft's Typography website: Converting FUnits (font units) to pixels Values in the em square are converted to values in the pixel coordinate system by multiplying them by a scale. This scale is: pointSize * resolution / ( 72 points per inch * units_per_em ) where pointSize is the size at which the glyph is to be displayed, and resolution is the resolution of the output device. The 72 in the denominator reflects the number of points per inch. For example, assume that a glyph feature is 550 FUnits in length on a 72 dpi screen at 18 point. There are 2048 units per em. The following calculation reveals that the feature is 4.83 pixels long. 550 * 18 * 72 / ( 72 * 2048 ) = 4.83 } var i: integer; lWidth: integer; lGIndex: integer; us: UnicodeString; {$IFDEF ttfdebug} sl: TStringList; s: string; {$ENDIF} begin DoLoadFileInfo; Result := 0; if Length(AStr) = 0 then Exit; if not Assigned(FFileInfo) then Exit; {$IFDEF ttfdebug} sl := TStringList.Create; s := ''; for i := 0 to 255 do begin lGIndex := FFileInfo.GetGlyphIndex(i); lWidth := FFileInfo.GetAdvanceWidth(lGIndex); s := s + ',' + IntToStr(lWidth); end; sl.Add(s); sl.Add('UnitsPerEm = ' + IntToStr(FFileInfo.Head.UnitsPerEm)); sl.SaveToFile(GetTempDir(True) + FFileInfo.PostScriptName + '.txt'); sl.Free; {$ENDIF} lWidth := 0; us := UTF8Decode(AStr); for i := 1 to Length(us) do begin lGIndex := FFileInfo.GetGlyphIndex(Word(us[i])); lWidth := lWidth + FFileInfo.GetAdvanceWidth(lGIndex); end; if APointSize = 0.0 then Result := lWidth else begin { Converting Font Units to Pixels. The formula is: pixels = glyph_units * pointSize * resolution / ( 72 points per inch * THead.UnitsPerEm ) } Result := lWidth * APointSize * FOwner.DPI / (72 * FFileInfo.Head.UnitsPerEm); end; end; function TFPFontCacheItem.TextHeight(const AText: utf8string; const APointSize: single; out ADescender: single): single; begin DoLoadFileInfo; { Both lHeight and lDescenderHeight are in pixels } Result := FFileInfo.CapHeight * APointSize * gTTFontCache.DPI / (72 * FFileInfo.Head.UnitsPerEm); ADescender := Abs(FFileInfo.Descender) * APointSize * gTTFontCache.DPI / (72 * FFileInfo.Head.UnitsPerEm); end; { TFPFontCacheList } procedure TFPFontCacheList.SearchForFonts(const AFontPath: String); var sr: TSearchRec; lFont: TFPFontCacheItem; s: String; begin if SysUtils.FindFirst(AFontPath + AllFilesMask, faAnyFile, sr) = 0 then begin repeat // check if special files to skip if (sr.Name = '.') or (sr.Name = '..') or (sr.Name = '') then Continue; // We got something, so lets continue s := sr.Name; if (sr.Attr and faDirectory) <> 0 then // found a directory SearchForFonts(IncludeTrailingPathDelimiter(AFontPath + s)) else begin // we have a file if (lowercase(ExtractFileExt(s)) = '.ttf') {or // DRB (lowercase(ExtractFileExt(s)) = '.otf')} then begin try lFont := TFPFontCacheItem.Create(AFontPath + s); Add(lFont); except if not FBuildFontCacheIgnoresErrors then Raise; end; end; end; until SysUtils.FindNext(sr) <> 0; end; SysUtils.FindClose(sr); end; procedure TFPFontCacheList.SetDPI(AValue: integer); begin if FDPI = AValue then Exit; FDPI := AValue; end; procedure TFPFontCacheList.FixPathDelimiters; var i: integer; begin for i := 0 to FSearchPath.Count-1 do FSearchPath[i] := SetDirSeparators(FSearchPath[i]); end; function TFPFontCacheList.GetCount: integer; begin Result := FList.Count; end; function TFPFontCacheList.GetItem(AIndex: Integer): TFPFontCacheItem; begin Result := TFPFontCacheItem(FList.Items[AIndex]); end; procedure TFPFontCacheList.SetItem(AIndex: Integer; AValue: TFPFontCacheItem); begin FList.Items[AIndex] := AValue; end; constructor TFPFontCacheList.Create; begin inherited Create; FList := TObjectList.Create; FSearchPath := TStringList.Create; FDPI := 96; // The default is the most common dpi used end; destructor TFPFontCacheList.Destroy; begin FList.Free; FSearchPath.Free; inherited Destroy; end; procedure TFPFontCacheList.BuildFontCache; var lPath: String; i: integer; begin if FSearchPath.Count < 1 then raise ETTF.Create(rsNoSearchPathDefined); FixPathDelimiters; for i := 0 to FSearchPath.Count-1 do begin lPath := FSearchPath[i]; if DirectoryExists(lPath) then SearchForFonts(IncludeTrailingPathDelimiter(lPath)); end; end; function TFPFontCacheList.Add(const AObject: TFPFontCacheItem): integer; begin Result := FList.Add(AObject); AObject.FOwner := self; end; procedure TFPFontCacheList.AssignFontList(const AStrings: TStrings); var i: integer; begin if not Assigned(AStrings) then Exit; AStrings.Clear; for i := 0 to FList.Count-1 do AStrings.Add(TFPFontCacheItem(FList.Items[i]).PostScriptName); end; procedure TFPFontCacheList.Clear; begin FList.Clear; end; procedure TFPFontCacheList.LoadFromFile(const AFilename: string); var sl: TStringList; i: integer; begin sl := TStringList.Create; try sl.LoadFromFile(AFilename); for i := 0 to sl.Count-1 do Add(TFPFontCacheItem.Create(sl[i])); finally sl.Free; end; end; { This is operating system dependent. Our default implementation only supports Linux, FreeBSD, Windows and OSX. On other platforms, no fonts will be loaded, until a implementation is created. NOTE: This is definitely not a perfect solution, especially due to the inconsistent implementations and locations of files under various Linux distros. But it's the best we can do for now. } procedure TFPFontCacheList.ReadStandardFonts; {$ifdef linux} {$define HasFontsConf} const cFontsConf = '/etc/fonts/fonts.conf'; {$endif} {$ifdef freebsd} {$define HasFontsConf} const cFontsConf = '/usr/local/etc/fonts/fonts.conf'; {$endif} {$ifdef mswindows} function GetWinFontsDir: string; var {$if FPC_FULLVERSION < 30400} w : Array[0..MaxPathLen] of Char; {$ELSE} w : pwidechar; {$ENDIF} begin {$if FPC_FULLVERSION < 30400} SHGetSpecialFolderPath(0,w,CSIDL_FONTS,false); {$else} SHGetKnownFolderPath(FOLDERID_Fonts,0,0,w); {$endif} Result := w; {$if FPC_FULLVERSION > 30400} CoTaskMemFree(w); {$endif} end; {$endif} {$ifdef HasFontsConf} var doc: TXMLDocument; lChild: TDOMNode; lDir: string; {$endif} begin {$ifdef HasFontsConf} // Linux & FreeBSD ReadXMLFile(doc, cFontsConf); try lChild := doc.DocumentElement.FirstChild; while Assigned(lChild) do begin if lChild.NodeName = 'dir' then begin if lChild.FirstChild.NodeValue = '~/.fonts' then lDir := ExpandFilename(lChild.FirstChild.NodeValue) else lDir := lChild.FirstChild.NodeValue; SearchPath.Add(lDir); // writeln(lDir); end; lChild := lChild.NextSibling; end; finally doc.Free; end; {$endif} {$ifdef mswindows} SearchPath.Add(GetWinFontsDir); {$endif} {$ifdef darwin} // OSX { As per Apple Support page: https://support.apple.com/en-us/HT201722 } SearchPath.Add('/System/Library/Fonts/'); SearchPath.Add('/Library/Fonts/'); SearchPath.Add(ExpandFilename('~/Library/Fonts/')); {$endif} BuildFontCache; end; function TFPFontCacheList.IndexOf(const AObject: TFPFontCacheItem): integer; begin Result := FList.IndexOf(AObject); end; function TFPFontCacheList.GetPostScriptFontName(const AFontName: string; ABold: boolean; AItalic: boolean): String; Var lFC : TFPFontCacheItem; lMissingFontName : String; begin Result:=DoFindPostScriptFontName(aFontName,aBold,aItalic,lfc); if (Result=aFontName) and (aBold or aItalic) then begin if lFC<>Nil then lMissingFontName := lfc.FamilyName else lMissingFontName := aFontName; if (aBold and AItalic) then lMissingFontName := lMissingFontName + '-BoldItalic' else if aBold then lMissingFontName := lMissingFontName + '-Bold' else if aItalic then lMissingFontName := lMissingFontName + '-Italic'; raise EFontNotFound.CreateFmt(SErrFontNotFound, [lMissingFontName]); end; end; function TFPFontCacheList.FindPostScriptFontName(const AFontName: string; ABold: boolean; AItalic: boolean): String; Var lFC : TFPFontCacheItem; begin Result:=DoFindPostScriptFontName(aFontName,aBold,aItalic,lfc); end; function TFPFontCacheList.DoFindPostScriptFontName(const AFontName: string; ABold: boolean; AItalic: boolean; Out aBaseFont : TFPFontCacheItem): String; Var lNewFC : TFPFontCacheItem; begin Result:=aFontName; aBaseFont := FindFont(aFontName); if not Assigned(aBaseFont) then exit; // find corresponding font style (bold and/or italic) lNewFC := Find(aBaseFont.FamilyName, aBold, aItalic); if not Assigned(lNewFC) then exit; Result := lNewFC.PostScriptName; end; function TFPFontCacheList.Find(const AFontCacheItem: TFPFontCacheItem): integer; var i: integer; begin Result := -1; // nothing found for i := 0 to Count-1 do begin if (Items[i].FamilyName = AFontCacheItem.FamilyName) and (Items[i].StyleFlags = AFontCacheItem.StyleFlags) then begin Result := i; exit; end; end; end; function TFPFontCacheList.Find(const AFamilyName: string; ABold: boolean; AItalic: boolean): TFPFontCacheItem; var i: integer; begin for i := 0 to Count-1 do begin Result := Items[i]; if SameText(Result.FamilyName,AFamilyName) and (Result.IsItalic = AItalic) and (Result.IsBold = ABold) then exit; end; Result := nil; end; function TFPFontCacheList.Find(const APostScriptName: string): TFPFontCacheItem; var i: integer; begin for i := 0 to Count-1 do begin Result := Items[i]; if SameText(Result.PostScriptName,APostScriptName) then Exit; end; Result := nil; end; function TFPFontCacheList.FindHumanFriendly(const AName: string): TFPFontCacheItem; var i: integer; begin for i := 0 to Count-1 do begin Result := Items[i]; if SameText(Result.HumanFriendlyName,AName) then Exit; end; Result := nil; end; function TFPFontCacheList.FindFamily(const AFamilyName: string): TFPFontCacheItemArray; var i,aLen: integer; f : TFPFontCacheItem; begin aLen:=0; SetLength(Result,Count); for i := 0 to Count-1 do begin f:=Items[i]; if SameText(F.FamilyName,AFamilyName) then begin Result[aLen]:=F; inc(Alen); end; end; SetLength(Result,aLen); end; function TFPFontCacheList.FindFont(const AName: string): TFPFontCacheItem; Var aFamily : TFPFontCacheItemArray; begin Result:=Find(AName); if (Result=Nil) then Result:=Find(aName,False,False); if (Result=Nil) then Result:=FindHumanFriendly(aName); if (Result=Nil) then begin aFamily:=FindFamily(aName); if Length(aFamily)>0 then Result:=aFamily[0]; end; end; function TFPFontCacheList.PointSizeInPixels(const APointSize: single): single; begin Result := APointSize * DPI / 72; end; initialization uFontCacheList := nil; finalization uFontCacheList.Free; end. �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������tomboy-ng_0.39-1/source/kmemo2pdf.lrj���������������������������������������������������������������0000644�0001750�0001750�00000000226�14551457644�017334� 0����������������������������������������������������������������������������������������������������ustar �dbannon�������������������������dbannon����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������{"version":1,"strings":[ {"hash":84927299,"name":"tformkmemo2pdf.caption","sourcebytes":[80,68,70,32,73,115,115,117,101,115],"value":"PDF Issues"} ]} ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������tomboy-ng_0.39-1/source/kmemo2pdf.pas���������������������������������������������������������������0000644�0001750�0001750�00000107673�14551457644�017346� 0����������������������������������������������������������������������������������������������������ustar �dbannon�������������������������dbannon����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������unit kmemo2pdf; { Copyright (C) 2023 David Bannon License: This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html ------------------ This form will convert an in memory KMemo note to a PDF. At this stage, it requires creating, getting told a few things (The Kmemo, a default font, etc) and call StartPDF. The form itself is not shown unless something has gone wrong, in which case StartPDF will return false. Some messages are shown in the memo .... See https://gitlab.com/freepascal.org/fpc/source/-/issues/30116 for issues about fonts ! https://forum.lazarus.freepascal.org/index.php/topic,62254.0.html - my question on the topic. We have to assume here that fpPDF cannot 'generate' bold or italic from a regular font. So, you must have chosen a font that comes with, at least regular, bold, italic and bold-italic font files. If its "all in one TTF file" you get a warning and any bold or italic will be converted to regular. Fonts like DejaVu that have 'Oblique' do not get translated to italic. I have had to blacklist certain OpenType fonts, this is really getting rough ! Line 396 of fpTTF looks for otf fonts as well as ttf !!!!! Fonts that mention bold and italic in the Font selection dialog do not necessarily have seperate font files for bold and italic, they may generate them ! But fpPDF does not. History : 2023-02-14 Initial Release of this unit. } {$mode ObjFPC}{$H+} interface uses {$ifdef unix}cwstring,{$endif} Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, Buttons, fpttf, kmemo, k_prn, fpimage, fppdf, fpparsettf, typinfo, tb_utils, KFunctions; { NOTE: above includes rtl fpttf but I have copied it to source dir, added it to this project and so guzumpted the one in FTP. In there, around line 496, I have commented out the code that loads a otf font, now gTTFontCache reads only TTF. Must look into what this is all about ! } type PFontRecord=^TFontRecord; TFontRecord=record FamName:string; // eg 'Ubuntu', 'FreeSans' OldName : string; // the name of the font this record replaces. Bold : boolean; Italic : boolean; Pitch : TFontPitch; // eg fpFixed or not. FontIndex : integer; // -1 if not set yet end; type { TFontList } TFontList = class(TFPList) private function FindOld(TheFont: ANSIString; Bold, Italic : boolean; out NewFont: string): boolean; //DefaultFontName : string; function Get(Index : Integer) : PFontRecord; function FindInFontCache(FamName : string; Bold, Italics : boolean) : boolean; function GetSuitableFont(const Bold, Italic, Fixed: boolean): string; public constructor Create(); destructor Destroy; Override; { Might add the passed font family name to the Fontlist as either OldName or FamName. If its already in FontList, as FamName, or is not yet there but will be now because it can be found by gTTFFontCache, returns False. If its already there as OldName or not there but a substitute can be found in gttFFoneCache and added to list, it returns True and with the new FamName in NewName (and calling process should use it in WordList). Hmm, what to do if we cannot find a substitute ? } function Add(const TheFont: ANSIString; const Bold, Italic: boolean; Pitch: TFontPitch; var NewName: string): boolean; procedure Dump(); // Returns FontIndex of passed font record, -1 is not present; function Find(TheFont: ANSIString; Bold, Italic, FIndex: boolean): integer; property Items[Index : integer] : PFontRecord read Get; default; end; type { TFormKMemo2pdf } TFormKMemo2pdf = class(TForm) BitBtn1: TBitBtn; BitBtnProceed: TBitBtn; Memo1: TMemo; procedure BitBtnProceedClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormShow(Sender: TObject); private AllowNoBoldItalic : boolean;// Allow use of font that does not have its own Bold or Italic font file. BulletIndent : integer; // Bullet Indent (not including bullet), zero means no bullet; FontList : TFontList; // A list of all the fonts we will need to print/display the PDF, Initially populated in KMemoRead() WordList : TWordList; // A list of all the words and their details such as font, size etc. Populated in KMemoRead(). WordIndex : integer; // Points to a word in wordlist, must be less than WordList.count //FPage: integer; FDoc: TPDFDocument; CurrentPage : integer ; // Starts at zero ? // does a non write scan of next block of words returning the necessary Height // to push Y down to to provide clearance for any larger text. Do We have to push down // by less if first char of the line is higher ? test run is very strange ! // Return 0 for a blank line (just inc Y by line height, don't run WriteLine) // This function is not being used ! // function ChangedFont(): boolean; function CheckHeight: integer; // Returns with width and height in mm of the word in wordlist pointed to by WI // If AltText contains anything, it will be used instead of the text in WordList // but font and associated settings from WordList will still be used. function GetWordDimentions(const WI: integer; out W: integer; var H: integer; AltText: string = ''): boolean; // Builds a WordList based on the KMemo. Each word will have a trailing space if applicable // A newline has an empty list item and NewLine true. Tries to register a suitable // font for each word but it may get told by FontList.Add() to use another font. function KMemoRead(): boolean; { Checks all fonts in FontList for necessary bold and Italic varients and allocates a FontIndex that will be used during PDF writing. Returns False if no suitable font files exist (hopefully, issue was dealt with before we got here). } function LoadFonts(): boolean; // Generates the PDF, might return False if it finds the available fonts // do not include a needed bold or italic version, user invited to proceed // anyway (without font tricks). However, thats now unlikely as we will // have already changed to a "know good" font. Hopefully. function MakePDF: boolean; procedure SaveDocument(); // Returns true if all the fonts in FontList can be found. // function TestForGoodFonts: string; // Returns true if a font with passed name can be found, regular, bold, italics, bold-italics // function TestForGoodFonts(FName: string): boolean; procedure UpdateWordList(BadFName, GoodFName: string); // Tries to print out a line of words, word by word, at indicated starting point. // returns false if there is no more words to print. function WriteLine(Page: TPDFPage; XLoc: integer; const Y: integer): boolean; // sends a page of text to the Document, returning True when its all done. function WritePage(): boolean; public TheKMemo : TKMemo; // This is the KMemo, set it before showing the form. TheTitle : string; FFileName : string; // Full filename including path, DefaultFont : string; // New Text in a KMemo is saved with font='default', only after reload does it have true name // Public function to initiate the PDF. If it returns False then // show user the form with some error or advice messages. Its // going to be a font problem most likely, see header. function StartPDF: boolean; end; var FormKMemo2pdf: TFormKMemo2pdf; implementation {$R *.lfm} { TFormKMemo2pdf } const TopMargin = 15; BottomMargin = 10; SideMargin = 15; PageHeight = 297; PageWidth = 210; LineHeight = 6; {$ifdef LINUX} FontsFixed : array of string = ('Liberation Mono', 'Ubuntu Mono'); FontsVariable : array of string = ('Liberation Sans', 'Ubuntu Mono', 'Noto Sans', 'Liberation Serif'); {$endif} {$ifdef WINDOWS} FontsFixed : array of string = ('Courier New'); FontsVariable : array of string = ('Arial', 'Calibri', 'Segoe UI'); {$endif} {$ifdef DARWIN} FontsFixed : array of string = ('Monaco', 'Menlo','Courier New'); FontsVariable : array of string = ('Lucida Grande', 'Geneva', 'Arial'); {$endif} // FontsBlackList : array of string = ('Cantarell', 'MathJax', 'Nimbus', 'URW'); { We can only use true Type Fonts, NOT OpenType ! I cannot find any way to tell the difference, I'd expect gTTFontCache to know but if it does, it won't tell me. So, until I find a better way, I'll blacklist. Not Good. Ugly hack but using a local fpTTY unit, hacked to no look for OTF.} { TFontList } function TFontList.Get(Index: Integer): PFontRecord; begin Result := PFontRecord(inherited get(Index)); end; function TFontList.FindInFontCache(FamName: string; Bold, Italics: boolean): boolean; var CachedFont : TFPFontCacheItem; begin CachedFont := gTTFontCache.Find(FamName, Bold, Italics); result := Assigned(CachedFont); end; constructor TFontList.Create(); begin inherited Create; gTTFontCache.ReadStandardFonts; // https://forum.lazarus.freepascal.org/index.php/topic,54280.msg406091.html // note, dont call gTTFontCache.ReadStandardFonts here, it must be called only once in the app's life // gTTFontCache.SearchPath.Add('/usr/share/fonts/'); // can, possibly, add custom font locations ??? // gTTFontCache.BuildFontCache; // seems this is not needed too. end; destructor TFontList.Destroy; var I : integer; begin for I := 0 to Count-1 do begin dispose(Items[I]); end; inherited Destroy; end; // Will return the name a (hopefully) suitable font to use. function TFontList.GetSuitableFont(const Bold, Italic, Fixed : boolean) : string; var i : integer; begin if Fixed then begin for I := 0 to high(FontsFixed) do if FindInFontCache(FontsFixed[i], Bold, Italic) then exit(FontsFixed[i]); end else for I := 0 to high(FontsVariable) do if FindInFontCache(FontsVariable[i], Bold, Italic) then exit(FontsVariable[i]); result := ''; end; function TFontList.Add(const TheFont: ANSIString; const Bold, Italic: boolean; Pitch : TFontPitch; var NewName : string) : boolean; var P : PFontRecord; SubFont : string; procedure InsertIntoList(SubName : string = ''); begin new(P); if SubName <> '' then begin P^.FamName := SubName; P^.OldName := TheFont; end else begin P^.FamName := TheFont; P^.OldName := ''; end; P^.Bold := Bold; P^.Italic := Italic; P^.FontIndex := -1; // Wots this for ??? P^.Pitch := Pitch; inherited Add(P); end; { function InBlackList : boolean; var Cnt : integer; begin for Cnt := 0 to high(FontsBlackList) do if TheFont = FontsBlackList[Cnt] then exit(True); result := False; end; } begin Result := False; // if not InBlackList then begin if Find(TheFont, Bold, Italic, False) > -1 then Exit(False); // All good, its already here. if FindOld(TheFont, Bold, Italic, NewName) then exit(True); // We already have a substitute if FindInFontCache(TheFont, Bold, Italic) then begin InsertIntoList(); NewName := TheFont; exit(False); end; // end; // OK, start guessing then Davo ! SubFont := GetSuitableFont(Bold, Italic, (Pitch = fpFixed)); if SubFont <> '' then begin InsertIntoList(SubFont); NewName := SubFont; exit(True); end; showmessage('ERROR - Cannot find a sunstitute font for ' + TheFont + Bold.ToString(True) + Italic.ToString(True)); //memo1.Append('ERROR - Cannot find a substitute font for ' + TheFont + Bold.ToString(True) + Italic.ToString(True)); end; procedure TFontList.Dump(); var i : integer; begin writeln('TFontList.Dump we have ' + count.tostring + ' items ========'); for i := 0 to count -1 do writeln('FONT : ', Items[i]^.FamName, ' B=', booltostr(Items[i]^.Bold, True) , ' I=', booltostr(Items[i]^.Italic, True), ' replaces=', Items[i]^.OldName); end; function TFontList.Find(TheFont: ANSIString; Bold, Italic, FIndex: boolean): integer; var i : integer; begin Result := -1; for i := 0 to count -1 do if (Items[i]^.FamName = TheFont) and (Items[i]^.Bold = Bold) and (Items[i]^.Italic = Italic) then begin if FIndex then Result := Items[i]^.FontIndex // thats data saved in the record. else Result := i; break; end; end; function TFontList.FindOld(TheFont: ANSIString; Bold, Italic : boolean; out NewFont : string): boolean; var i : integer; begin for i := 0 to count -1 do if (Items[i]^.OldName = TheFont) and (Items[i]^.Bold = Bold) and (Items[i]^.Italic = Italic) then begin NewFont := Items[i]^.FamName; exit(True); end; Result := False; end; function TFormKMemo2PDF.GetWordDimentions(const WI : integer; out W : integer; var H : integer; AltText : string = '') : boolean; var CachedFont : TFPFontCacheItem; SWidthF, DescenderH : single; LocH : integer; begin Result := true; //writeln('INFO - TFormKMemo2pdf.GetWordDimentions WI=' + inttostr(WI) + ' and Wordlist.Count=' + inttostr(WordList.count)); if AltText = '' then AltText := WordList[WI]^.AWord; //writeln('INFO - TFormKMemo2pdf.GetWordDimentions looking at ' + WordList[WI]^.AWord + ' Font=' + WordList[WI]^.FName); CachedFont := gTTFontCache.Find(WordList[WI]^.FName, WordList[WI]^.Bold, WordList[WI]^.Italic); if not Assigned(CachedFont) then begin //writeln('INFO - TFormKMemo2pdf.GetWordDimentions Cannot find Font in Cache : ', WordList[WI]^.FName, ' ', WordList[WI]^.Bold, ' ', WordList[WI]^.Italic); // We will try a plain version of same font and if that works, change entry in WordList CachedFont := gTTFontCache.Find(WordList[WI]^.FName, False, False); if Assigned(CachedFont) then begin WordList[WI]^.Bold := False; // ToDo : this is very, very ugly must understand fonts better WordList[WI]^.Italic := False; end else begin //writeln('ERROR - TFormKMemo2pdf.GetWordDimentions Cannot find Font in Cache : ', WordList[WI]^.FName, ' Plain Font'); memo1.append('ERROR - TFormKMemo2pdf.GetWordDimentions Cannot find Font in Cache : ' + WordList[WI]^.FName + ' Plain Font'); exit(False); end; end; SWidthF := CachedFont.TextWidth(AltText, WordList[WI]^.Size); W := round((SWidthF * 25.4) / gTTFontCache.DPI); LocH := round(CachedFont.TextHeight(AltText, WordList[WI]^.Size, DescenderH) / 2.0); // writeln('TFormKMemo2pdf.GetWordDimentions LocH=', LocH); if LocH > H then H := LocH; end; function TFormKMemo2pdf.WriteLine(Page : TPDFPage; XLoc : integer; const Y : integer) : boolean; var W, H : integer; // word dimensions //i : integer; Bullet : string; function ExtraIndent(Bull : TKMemoParaNumbering) : integer; begin result := 0; case Bull of pnuNone : result := 0; // The bullet is at indicated indent BulletOne : result := 1; // and the text starts the width of bullet BulletTwo : result := 6; // and a couple of spaces further in. BulletThree : result := 11; // mm. BulletFour : result := 16; BulletFive : result := 21; BulletSix : result := 26; BulletSeven : result := 31; BulletEight : result := 36; end; end; begin H := 0; //i := 0; if WordList[WordIndex]^.ABullet <> pnuNone then begin // We arrive at the start of a line, is it a bullet line ? Bullet := UnicodeToNativeUTF(cRoundBullet) + ' '; if not GetWordDimentions(WordIndex, W, H, Bullet) then exit(False); // font fault unlikely, we have already checked this block. BulletIndent := ExtraIndent(WordList[WordIndex]^.ABullet); // Set a default font in case we have just started a new page. Page.SetFont(FontList.Find(WordList[WordIndex]^.FName, WordList[WordIndex]^.Bold, WordList[WordIndex]^.Italic, True), WordList[WordIndex]^.Size); Page.WriteText(BulletIndent + XLoc, Y, Bullet); // u2022 inc(BulletIndent, W); end; while WordIndex < WordList.Count do begin if WordList[WordIndex]^.NewLine then begin inc(WordIndex); BulletIndent := 0; exit(true); end; if not GetWordDimentions(WordIndex, W, H) then exit(False); // font fault unlikely, we have already checked this block. Page.SetFont(FontList.Find(WordList[WordIndex]^.FName, WordList[WordIndex]^.Bold, WordList[WordIndex]^.Italic, True), WordList[WordIndex]^.Size); if (XLoc+W+BulletIndent) > (PageWidth - SideMargin) then exit(true); // no more on this line. memo1.Append('TFormKMemo2pdf.WriteLine will WriteText T=' + WordList[WordIndex]^.AWord + ' F=' + WordList[WordIndex]^.FName+ ' X=' {+ inttostr(BulletIndent)} + ' ' + inttostr(XLoc) + ' W='+ inttostr(W)); Page.WriteText(BulletIndent + XLoc, Y, WordList[WordIndex]^.AWord); memo1.Append('TFormKMemo2pdf.WriteLine wrote word=' + WordList[WordIndex]^.AWord + ' Font=' + WordList[WordIndex]^.FName + ' ' + inttostr(W) + ' ' + inttostr(H)); XLoc := XLoc+W; inc(WordIndex); end; result := false; // no more to do. end; function TFormKMemo2pdf.CheckHeight() : integer; var W, i, WI : integer; // word dimensions Xloc : integer = SideMargin; OldFont : string; begin i := 0; WI := WordIndex; Result := 0; while WI < WordList.Count do begin inc(i); if i > 2000 then break; if WordList[WI]^.NewLine then begin //BulletIndent := 0; exit; end; if not GetWordDimentions(WI, W, Result) then begin OldFont := WordList[WI]^.FName; memo1.Append('WARNING - TFormKMemo2pdf.CheckHeight Failed to initially load the requested font : ' + OldFont); WordList[WI]^.FName := DefaultFont; // We will change it to default font and try again if not GetWordDimentions(WI, W, Result) then begin memo1.Append('ERROR - TFormKMemo2pdf.CheckHeight Failed to load the substitute font : ' + WordList[WI]^.FName); exit; end; end; // writeln('TFormKMemo2pdf.WriteLine Setting FontIndex to ', FontList.Find(WordList[Wi]^.FName, WordList[WI]^.Bold, WordList[WI]^.Italic) // , ' and name is ', WordList[WI]^.FName); if (Xloc+W) > (PageWidth - SideMargin) then exit; if WI >= WordList.Count then exit; XLoc := XLoc+W; inc(WI); end; end; function TFormKMemo2pdf.LoadFonts() : boolean; var I : integer; CachedFont : TFPFontCacheItem; Suffix : string = ''; begin Result := True; for i := 0 to FontList.Count -1 do begin //writeln('TFormKMemo2pdf.LoadFonts FontName=', FontList[i]^.FamName); Suffix := ''; CachedFont := gTTFontCache.Find(FontList[i]^.FamName, FontList[i]^.Bold, FontList[i]^.Italic); if not Assigned(CachedFont) then begin Memo1.Append('Font ' + FontList[i]^.FamName + ' does not have a bold or italic font file.'); //writeln('WARNING - TFormKMemo2pdf.LoadFonts could not find font in cache ' + FontList[i]^.FamName + ' ' + booltostr(FontList[i]^.Bold, True) +' ' + booltostr(FontList[i]^.Italic, True)); Result := False; continue; // will cause (managed) problems in GetWordDimensions() ! end; // writeln('INFO - TFormKMemo2pdf.LoadFonts DID find font in cache ' + FontList[i]^.FamName + ' ' + booltostr(FontList[i]^.Bold, True) +' ' + booltostr(FontList[i]^.Italic, True)); if FontList[i]^.Bold then Suffix := 'B'; if FontList[i]^.Italic then Suffix := Suffix + 'I'; if Suffix <> '' then Suffix := '-' + Suffix; FontList[i]^.FontIndex := FDoc.AddFont(CachedFont.FileName, CachedFont.FamilyName + Suffix); // is This my naming scheme ?? // FontList[i]^.FontIndex := FDoc.AddFont(gTTFontCache.Items[i].FileName, gTTFontCache.Items[i].FamilyName + Suffix); // writeln('TFormKMemo2pdf.LoadFonts Font=', CachedFont.FamilyName + Suffix, ' FontIndex=',FontList[i]^.FontIndex, ' Family=', FontList[i]^.FamName); end; end; function TFormKMemo2pdf.WritePage() : boolean; var X : integer = SideMargin; // how far we are across the page, left to right, mm Y : integer = TopMargin; // how far we are down the page, top to botton, mm Page : TPDFPage; {i,} Yt : integer; begin Result := true; if WordList.Count < 1 then begin showmessage('WritePage called with empty word list'); exit(false); end; // writeln('TFormKMemo2pdf.WritePage starting page ===== ' + inttostr(CurrentPage)); Page := FDoc.Pages[CurrentPage]; // writeln('TFormKMemo2pdf.WritePage Fonts loaded for this page -'); // for i := 0 to Page.Document.Fonts.Count-1 do begin // writeln('Found in Page ' + Page.Document.Fonts[i].Name + ' DisplayName=' + Page.Document.Fonts[i].DisplayName ); // end; while Result do begin // Returns false if it has run out of words Yt := CheckHeight(); // Does not inc WordIndex. inc(Y, Yt); if Y > (PageHeight - TopMargin - BottomMargin) then exit; if Yt <> 0 then Result := WriteLine(Page, X, Y) // Does inc WordIndex else begin inc(Y, LineHeight); inc(WordIndex); end; if WordIndex >= WordList.Count then Result := false; //writeln('TFormKMemo2pdf.WritePage writing ' + WordList[i]^.AWord, X, ' ', Y); // WARNING, crashes on a newline !!!!!! end; end; { After we build the WordList and FontList, we have to see whats possible. Firstly can gTTFonCache find the font (and its Bold and Italic friends) ? It will not if they are not TTF and not as seperate files. So, we test, if it can find the indicated combo, all good. If not, we will have to identify a usable font and replace the existing ones. One error is enough, change the lot ! } (* function TFormKMemo2pdf.TestForGoodFonts() : string; var I : integer; CachedFont : TFPFontCacheItem; // Suffix : string = ''; begin Result := ''; for i := 0 to FontList.Count -1 do begin CachedFont := gTTFontCache.Find(FontList[i]^.FamName, FontList[i]^.Bold, FontList[i]^.Italic); if not Assigned(CachedFont) then begin Memo1.Append('ERROR TFormKMemo2pdf.TestForGoodFonts() - font not found = ' + FontList[i]^.FamName + ' ' + FontList[i]^.Bold.ToString(True) + FontList[i]^.Italic.ToString(True)); exit(FontList[i]^.FamName); end; end; end; *) (*function TFormKMemo2pdf.TestForGoodFonts(FName : string) : boolean; // This is just a debug function, remove ! var CachedFont : TFPFontCacheItem; begin Result := True; CachedFont := gTTFontCache.Find(FName, False, False); if not Assigned(CachedFont) then begin writeln('ERROR TFormKMemo2pdf.TestForGoodFonts - font not found = ' + FName + ' regular'); exit(False); end; CachedFont := gTTFontCache.Find(FName, True, False); if not Assigned(CachedFont) then begin writeln('ERROR TFormKMemo2pdf.TestForGoodFonts - font not found = ' + FName + ' bold'); exit(False); end; CachedFont := gTTFontCache.Find(FName, False, True); if not Assigned(CachedFont) then begin writeln('ERROR TFormKMemo2pdf.TestForGoodFonts - font not found = ' + FName + ' italic'); exit(False); end; CachedFont := gTTFontCache.Find(FName, True, True); if not Assigned(CachedFont) then begin writeln('ERROR TFormKMemo2pdf.TestForGoodFonts - font not found = ' + FName + ' bold - italic'); exit(False); end; end; *) procedure TFormKMemo2pdf.UpdateWordList(BadFName, GoodFName : string); var I : integer; begin for i := 0 to FontList.Count -1 do if FontList[i]^.FamName = BadFName then FontList[i]^.FamName := GoodFName; for i := 0 to WordList.Count-1 do if WordList[i]^.FName = BadFName then WordList[i]^.FName := GoodFName; end; (*function TFormKMemo2pdf.ChangedFont() : boolean; var BadFontName, GoodFontName : string; begin GoodFontName := 'Liberation Sans'; // ToDo : this sets both prop and fixed to prop if not TestForGoodFonts(GoodFontName) then begin Memo1.Append('TFormKMemo2pdf.ChangedFont Cannot find a usable FONT !'); exit(False); end; result := False; BadFontName := TestForGoodFonts(); if BadFontName <> '' then begin Result := True; UpdateWordList(BadFontName, GoodFontName); Memo1.Append('Changing ' + BadFontName + ' to ' + GoodFontName); end; end; *) function TFormKMemo2pdf.StartPDF : boolean; {var i : integer; } begin Memo1.Clear; CurrentPage := -1; If WordList <> nil then FreeAndNil(WordList); if FontList <> Nil then FreeAndNil(FontList); FontList := TFontList.Create(); WordList := TWordList.Create; FDoc := TPDFDocument.Create(Nil); try KMemoRead(); //FontList.Dump(); //WordList.Dump(); //TestForGoodFonts(); // This is for later, it does no make fonts available to the PDF //gTTFontCache.ReadStandardFonts; // https://forum.lazarus.freepascal.org/index.php/topic,54280.msg406091.html // gTTFontCache.SearchPath.Add('/usr/share/fonts/'); // can, possibly, add custom font locations .... //gTTFontCache.BuildFontCache; // FDoc := TPDFDocument.Create(Nil); // FDoc.FontDirectory := '/usr/share/fonts'; // ToDo : this is NOT cross platform // OK, now we test the FontList against the limited list of available fonts in gTTFontCache (* if not ChangedFont() then // We try twice because may need to change both normal and monospaced if not ChangedFont() then begin memo1.Append('ERROR, cannot find a suitable font to use'); BitBtnProceed.enabled := False; end; *) Result := MakePDF(); // False if we found an issue, probably font related ! finally FDoc.Free; FreeAndNil(FontList); FreeAndNil(WordList); end; end; function TFormKMemo2pdf.MakePDF : boolean; var P: TPDFPage; S: TPDFSection; Opts: TPDFOptions; begin Result := True; FDoc.Infos.Title := TheTitle; FDoc.Infos.Author := 'tomboy-ng notes'; FDoc.Infos.Producer := 'fpGUI Toolkit 1.4.1'; //Result.Infos.ApplicationName := ApplicationName; FDoc.Infos.CreationDate := Now; Opts := [poPageOriginAtTop]; Include(Opts, poSubsetFont); Include(Opts, poCompressFonts); Include(Opts,poCompressText); FDoc.Options := Opts; FDoc.StartDocument; if not LoadFonts() then begin if not AllowNoBoldItalic then {memo1.Append('Warning, your selected fonts may be unsuitable') else} begin showmessage('Warning, your selected fonts may be unsuitable'); memo1.Append('Warning, Press Retry to make a PDF without bold or italics'); Memo1.Append('or close, select more appropriate fonts from Settings and start again.'); exit(False); // check for memory leaks here please end; end; S := FDoc.Sections.AddSection; // we always need at least one section // ToDo : chase this up one way or another. // If the note has eg bold or italic markup and the user selected font does not // have seperate font files for bold and/or italic, the markup will be ignored // and the user will be shown the following message. repeat //if CurrentPage > 15 then break; // ToDo : remove me. For testing only. P := FDoc.Pages.AddPage; P.PaperType := ptA4; P.UnitOfMeasure := uomMillimeters; S.AddPage(P); // Add the Page to the Section inc(CurrentPage); until not WritePage(); // This is where page content is created. SaveDocument(); end; procedure TFormKMemo2pdf.SaveDocument(); var F: TFileStream; begin F := TFileStream.Create(FFileName, fmCreate); try try FDoc.SaveToStream(F); // Writeln('Document used ',FDoc.ObjectCount,' PDF objects/commands'); except on E: Exception do begin Memo1.Append('ERROR - Failed to save the PDF ' + E.Message); show; end; end; finally F.Free; end; Memo1.Append('INFO Wrote file to ' + FFileName); end; procedure TFormKMemo2pdf.BitBtnProceedClick(Sender: TObject); // ToDo : replace all this with call to StartPDF {var i : integer; } begin AllowNoBoldItalic := True; StartPDF(); exit(); (* CurrentPage := -1; If WordList <> nil then FreeAndNil(WordList); FontList := TFontList.Create(); WordList := TWordList.Create; KMemoRead(); // This is for later, it does no make fonts available to the PDF gTTFontCache.ReadStandardFonts; // https://forum.lazarus.freepascal.org/index.php/topic,54280.msg406091.html // gTTFontCache.SearchPath.Add('/usr/share/fonts/'); // ToDo : this is NOT cross platform gTTFontCache.BuildFontCache; // Memo1.append('TFormKMemo2pdf.BitBtn2Click gTTFontCache has ' + inttostr(gTTFontCache.Count) + ' fonts including - '); for i := 0 to gTTFontCache.Count -1 do // ToDo : remove me if (gTTFontCache.Items[i].FamilyName = 'Ubuntu') or (gTTFontCache.Items[i].FamilyName = 'Karumbi') then begin Memo1.append(gTTFontCache.Items[i].FamilyName + ' - ' + gTTFontCache.Items[i].FileName + ' - ' + gTTFontCache.Items[i].HumanFriendlyName + ' - ' + booltostr(gTTFontCache.Items[i].IsBold, true) + ' - ' + booltostr(gTTFontCache.Items[i].IsItalic, true) + ' - ' + booltostr(gTTFontCache.Items[i].IsFixedWidth, true) + ' - ' + booltostr(gTTFontCache.Items[i].IsRegular, true)); writeln(gTTFontCache.Items[i].FamilyName + ' - ' + gTTFontCache.Items[i].FileName + ' - ' + gTTFontCache.Items[i].HumanFriendlyName + ' - ' + booltostr(gTTFontCache.Items[i].IsBold, true) + ' - ' + booltostr(gTTFontCache.Items[i].IsItalic, true) + ' - ' + booltostr(gTTFontCache.Items[i].IsFixedWidth, true) + ' - ' + booltostr(gTTFontCache.Items[i].IsRegular, true)); end; FDoc := TPDFDocument.Create(Nil); // FDoc.FontDirectory := '/usr/share/fonts'; // ToDo : this is NOT cross platform MakePDF(); FDoc.Free; FreeAndNil(FontList); FreeAndNil(WordList); *) end; function TFormKMemo2pdf.KMemoRead() : boolean; var BlockNo : integer = 0; I : integer; ExFont : TFont; AWord : ANSIString = ''; AFontName : string; procedure CopyFont(FromFont : TFont); begin ExFont.Bold := FromFont.Bold; ExFont.Italic := FromFont.Italic; ExFont.Size := FromFont.Size; ExFont.Color := FromFont.Color; ExFont.Name := FromFont.Name; ExFont.Pitch := FromFont.Pitch; // fpFixed, fpVariable, fpDefault end; begin ExFont := TFont.Create(); for BlockNo := 0 to TheKMemo.Blocks.Count-1 do begin // For every block if not TheKMemo.Blocks.Items[BlockNo].ClassNameIs('TKMemoParagraph') then begin CopyFont(TKMemoTextBlock(TheKmemo.Blocks.Items[BlockNo]).TextStyle.Font); // copies to ExFont if ExFont.Name = 'default' then begin //writeln('INFO TFormKMemo2pdf.KMemoRead() Reasigning [' + TheKmemo.Blocks.Items[BlockNo].Text + '] to font=' + DefaultFont); ExFont.Name := DefaultFont; end; // writeln('INFO TFormKMemo2pdf.KMemoRead() [' + TheKMemo.Blocks.Items[BlockNo].Text + '] ' + booltostr(ExFont.Pitch = fpFixed, true)); AFontName := ExFont.Name; // we might need to change this in next line. //writeln('INFO TFormKMemo2pdf.KMemoRead() fontname before=' + AFontName + ' [' + TheKMemo.Blocks.Items[BlockNo].Text + ']'); FontList.Add(ExFont.Name, ExFont.Bold, ExFont.Italic, ExFont.Pitch, AFontName); // writeln('INFO TFormKMemo2pdf.KMemoRead() fontname after=' + AFontName); for I := 0 to TheKMemo.Blocks.Items[BlockNo].WordCount-1 do begin // For every word in this block AWord := TheKMemo.Blocks.Items[BlockNo].Words[I]; WordList.Add(AWord, ExFont.Size, ExFont.Bold, ExFont.Italic, False, ExFont.Color, AFontName); end; end else begin WordList.Add('', 0, False, False, True, clBlack); // TKMemoParagraph, thats easy but is it a Bullet ? if (TKMemoParagraph(Thekmemo.blocks.Items[BlockNo]).Numbering <> pnuNone) then begin // We want to mark start of bullet, not KMemo's way of marking at the end. I := WordList.Count -2; // Thats just before the current one while I > -1 do begin if WordList[i]^.NewLine then break; dec(i); end; if i < 0 then // under run, bullet must be first line ?? WordList[0]^.ABullet := TKMemoParagraph(Thekmemo.blocks.Items[BlockNo]).Numbering else WordList[i+1]^.ABullet := TKMemoParagraph(Thekmemo.blocks.Items[BlockNo]).Numbering; // Must be the one we want. Mark first word after NL end; end; end; FreeandNil(ExFont); WordIndex := 0; result := (WordList.Count > 1); //WordList.Dump(); { (TKMemoParagraph(Thekmemo.blocks.Items[BlockNo]).Numbering = pnuBullets) pnuNone, BulletOne .. BulletEight } end; procedure TFormKMemo2pdf.FormCreate(Sender: TObject); begin WordList := nil; FontList := nil; CurrentPage := -1; Memo1.Clear; BitBtnProceed.Visible := False; // ToDo : I really wonder what ? end; procedure TFormKMemo2pdf.FormShow(Sender: TObject); begin AllowNoBoldItalic := False; end; end. ���������������������������������������������������������������������tomboy-ng_0.39-1/source/markdown.lrj����������������������������������������������������������������0000644�0001750�0001750�00000001563�14551457644�017277� 0����������������������������������������������������������������������������������������������������ustar �dbannon�������������������������dbannon����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������{"version":1,"strings":[ {"hash":208094446,"name":"tformmarkdown.caption","sourcebytes":[70,111,114,109,77,97,114,107,100,111,119,110],"value":"FormMarkdown"}, {"hash":73996050,"name":"tformmarkdown.panel1.caption","sourcebytes":[77,97,114,107,100,111,119,110,32,69,120,112,111,114,116,101,114],"value":"Markdown Exporter"}, {"hash":4863637,"name":"tformmarkdown.buttonclose.caption","sourcebytes":[67,108,111,115,101],"value":"Close"}, {"hash":108741772,"name":"tformmarkdown.buttoncopyall.caption","sourcebytes":[67,111,112,121,32,65,108,108],"value":"Copy All"}, {"hash":366789,"name":"tformmarkdown.buttonsave.caption","sourcebytes":[83,97,118,101],"value":"Save"}, {"hash":98288873,"name":"tformmarkdown.label1.caption","sourcebytes":[80,114,101,115,115,32,67,116,114,108,45,65,44,32,67,116,114,108,45,67,32,116,111,32,99,111,112,121],"value":"Press Ctrl-A, Ctrl-C to copy"} ]} ���������������������������������������������������������������������������������������������������������������������������������������������tomboy-ng_0.39-1/source/noteindex.pas���������������������������������������������������������������0000644�0001750�0001750�00000014347�14551457644�017452� 0����������������������������������������������������������������������������������������������������ustar �dbannon�������������������������dbannon����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������unit NoteIndex; { Copyright (C) 2017-2021 David Bannon License: This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html ------------------ This unit will load all notes in a directory into a memory structure and provides a means to filter it down incrementally (ie while user types a search term. Each subsquent seach term is only searched for in notes that are still 'active' so, gets faster as search progresses. But uses quite a bit of memory so make sure you release it as soon as possible. Some users, with very large note collections, very large notes or slow hardware may find using this model tiresome. HISTORY : released on 2021/12/03 } {$mode ObjFPC}{$H+} interface uses Classes, SysUtils, ComCtrls; type PNote=^TNote; TNote = record Content : string; ID : string; Active : boolean; end; type { TNoteList } { TNoteIndex } TNoteIndex = class(TFPList) private function Get(Index: integer): PNote; function GetNotecontent(const FFName: string; out St: string): boolean; function ImportAll(const NDir: string; const CSensitive: boolean): boolean; // Adds a new item to List, Notes and files in Meta require prefix added before being passed here procedure AddNewItem(const ID, Content : string); // Returns True if the passed FName exists (as an ID) in the list function Find(const FName : string): boolean; property Items[Index: integer]: PNote read Get; default; public Busy : boolean; constructor Create(NoteDir: string; CaseSensitive: boolean); destructor Destroy; override; // Searches content of each note for St, if not present, mark that // note as Active=False. function SearchList(St: string): integer; // Files out the created STL with IDs of notes that are 'Active', // True if one or more notes passed back. function GetActive(STL : TStringList) : boolean; procedure ResetActive(); procedure UpDateLview(LV : TListView); end; implementation function TNoteIndex.Get(Index: integer): PNote; begin Result := PNote(inherited get(Index)); end; constructor TNoteIndex.Create(NoteDir : string; CaseSensitive : boolean); begin inherited Create; ImportAll(NoteDir, CaseSensitive); end; destructor TNoteIndex.Destroy; var i : integer; begin for I := 0 to Count-1 do begin dispose(Items[I]); end; inherited Destroy; end; procedure TNoteIndex.AddNewItem(const ID, Content : string); var NoteP : PNote; begin new(NoteP); NoteP^.Active:= True; NoteP^.Content := Content; NoteP^.ID := ID; inherited Add(NoteP); end; // iterates over list looking for St in the Content of all Required notes. Any that // don't have St are set to Required False. Returns the number of remaining trues. function TNoteIndex.SearchList(St : string) : integer; var NoteP : PNote; begin busy := true; Result := 0; // iterate over structure. I tried moving known false entries down the // list so they could be skipped but it did not help. Unnecessary complication. for NoteP in self do if NoteP^.Active then begin //writeln(NoteP^.ID); NoteP^.Active := pos(St, NoteP^.Content) > 0; if NoteP^.Active then inc(Result); end; Busy := False; end; function TNoteIndex.GetActive(STL: TStringList): boolean; // do not need this var NoteP : PNote; begin for NoteP in self do if NoteP^.Active then STL.Add(NoteP^.ID); result := STL.Count > 0; end; procedure TNoteIndex.ResetActive; var NoteP : PNote; begin busy := true; for NoteP in self do NoteP^.Active := true; busy := false; end; function TNoteIndex.Find(const FName: string): boolean; var NoteP : PNote; begin for NoteP in self do if NoteP^.ID + '.note' = FName then exit(NoteP^.Active); result := false; end; procedure TNoteIndex.UpDateLview(LV: TListView); var Cnt : integer; begin busy := true; Cnt := LV.items.count -1; while Cnt > -1 do begin //writeln('TNoteIndex.UpDateLview - checking ' + LV.Items[Cnt].SubItems[1]); if not find(lv.Items[Cnt].SubItems[1]) then begin // subitem[1] being note name LV.Items[Cnt].Delete; //writeln('TNoteIndex.UpDateLview - deleted line ' + cnt.tostring); end; dec(Cnt) end; busy := false; end; function TNoteIndex.ImportAll(const NDir : string; const CSensitive : boolean): boolean; var Info : TSearchRec; St : string; begin busy := true; if FindFirst(NDir + '*.note', faAnyFile, Info) = 0 then try repeat GetNotecontent(NDir + Info.Name, ST); if CSensitive then AddNewItem(copy(Info.Name, 1, length(Info.name) - 5), ST) else AddNewItem(copy(Info.Name, 1, length(Info.name) - 5), lowercase(ST)); until FindNext(Info) <> 0; finally FindClose(Info); end else begin //ErrorMessage := 'ERROR : No notes were found in ' + NotesDir; //DebugLn(ErrorMessage); exit(false); end; result := true; busy := False; end; // Reads one note, putting all its content into the passed string, in the event of an error, // returns .F. and with an empty string. function TNoteIndex.GetNotecontent(const FFName : string; out St : string): boolean; var FileStream: TFileStream; Sz : integer; begin FileStream := TFileStream.Create(FFName, fmOpenRead); St := ''; try try Sz := Filestream.Size; setlength(St, Sz); FileStream.Read(St[1], Sz); // interesting, BufReadStream is slightly worse here .... except on E: Exception do begin //writeln('Bugger, ' + E.Message); St := ''; end; end; finally Filestream.free; end; result := (st.length > 100); end; end. �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������tomboy-ng_0.39-1/source/sync.pas��������������������������������������������������������������������0000644�0001750�0001750�00000212743�14551457644�016431� 0����������������������������������������������������������������������������������������������������ustar �dbannon�������������������������dbannon����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������unit sync; { Copyright (C) 2017-2022 David Bannon License: This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html ------------------ } {$mode objfpc}{$H+} { How to use this Unit - Syncutils will probably be needed in Interface Uses Sync in implementation of Uses. if we belive we have an existion Repo accessible - ASync := TSync.Create(); ASync.SetTransport(TransP); // possible value defined in SyncUtils, SyncFile, SyncNextCloud, SyncAndroid ASync.DebugMode:=True; ASync.TestRun := ? ; ASync.ProceedFunction:=@Proceed; // A higher level function that can resolve clashes ASync.NotesDir:= ?; ASync.ConfigDir := ?; ASync.SyncAddress := ?; ASync.RepoAction:= RepoUse; // RepoUse says its all there, ready to go. Async.SetMode(SyncFile); // SyncFile, SyncNextRuby .... SyncReady <> ASync.TestConnection() then // something bad happened, SyncReady only // acceptable answer. Check ErrorString If joining an existing or making a new repo, set RepoAction to RepoJoin, if TestConnection returns SyncNoRemoteRepo then ask user if they want to create a new repo, try again with RepoNew. Other errors to be dealt with include - SyncXMLError, SyncNoRemoteDir, SyncBadRemote, SyncNoRemoteWrite .... ----------------------------------------------------------------------------- Operation of this unit - Fistly, this unit depends on on the Trans unit, a virtual unit of which the TransFile has been implemented and TransNet partially. Further Transport layers should be easily made. Two seperate approaches are needed. In both cases we build a list of all the notes we know about and what we plan to do for each. The list is built differently for each case and, then, the same processes are applied to that list. Creating a new Repo is, effectivly, a variation of the second. ---- Terms ---- LCD - Last Change Date LSD - Last Sync Date LocalDelete - a note that has been previously synced but is no longer mentioned in Remote Manifest, its been deleted elsewhere. RemoteDelete - a note that has been previously synced but has been eleted locally, remove it from Repo. NewUpLoad - a note the Repo has not seen before EditUpLoad - a note, previusly synced and has been edited locally since last sync. Some globals we'll need to know - - Repo, config and notes directory. - Remote ServerID - RemoteRevNo (except if its a new repo) - Local Last Sync Date, as a string. - Local Last Revision Number TestConnection() will establish indicated Repo dir exists and we have write permission there, does it look like an Existing Repo ? If an existing repo, get ServerID and RemoteRevNo. If we are making a new connection, make a GUID and set those vars appropriatly. The Model as implemented in tomboy-ng, October 2018 We call TestTransportEarly() and/or TestTransport() Its tests and may, or may not populate NoteMetaData with remote notes. It may, or may not put the remote LCD in NoteMetaData. We call StartSync() (not talking about Android mode here.) --------------------- RepoAction = RepoUse (that is, it all should be setup, just go and do it) CheckUsingRev() Assigned a action to each existing entry in NoteMetaData based on the current revision number and notes present in NotesDir. Note this method is an alternative to CheckUsingLCD(). CheckRemoteDeletes() Marks remote deletes, that is notes that are mentioned in LocalManifets as having been synced in the past (but not deleted section) but were not listed in NoteMetaData at this stage because the Remote Server does not know about them. Note, this will override a local note that has been edited since last sync - should this be a clash ? CheckLocalDeletes() looks at notes listed in LocalManifest as Deletes, it markes them, in NoteMetaData as DeleteRemote to be deleted from remote system (maybe just not mentioned in remote manifest any more). CheckNewNotes() looks in Notes dir for any notes there that are not yet listed in NoteMetaData. These notes are UploadNew. Call the General Write Behavour Block if not a TestRun. RepoAction = RepoJoin --------------------- CheckUsingLCD(True) Assignes an Action to each entry in NoteMetaData (which only contains entries from remote repo at this stage) based on last-change-date. If it finds a potential clash, aborts if it does not have last-change-date for the remote note. In that case, we recall LoadReopData(True) this time demanding last change date. And then run CheckUsingLCD again. Note this method is an alternative to CheckUsingRev(). Any notes thats determined here to be an UpLoad has its LCD (in NoteMetaData) set to the local note's LCD. Because a join cannot use local manifest, we do not honour remote or local deletes. CheckNewNotes() looks in Notes dir for any notes there that are not yet listed in NoteMetaData. These notes are UploadNew. Call the General Write Behavour Block if not a TestRun. RepoAction = RepoNew (if we determine, during a RepoJoin, that the dir we are pointing to does not contain a repo, we create one in this mode. Must always call RepoJoin first) ----------------------- CheckNewNotes() looks in Notes dir for any notes there that are not yet listed in NoteMetaData (which, is, of course empty at this stage). These notes are UploadNew. Call the General Write Behavour Block if not a TestRun. General Write Behavour ---------------------- applies for all three cases above. Some methods are not relevent in some modes, they just return true when they detect that themselves.) ProcessClashes() DoDownLoads() WriteRemoteManifest() - writes out a local copy of remote manifest to be used later. We always write it (except in TestRun) but only call Transport to deal with it if we have notes changing. DoDeletes() - Deletes from remote server. In current file implementation, does nothing. DoUploads() DoDeleteLocal() WriteLocalManifest() Note, we want to write a new local manifest even if there are no note changes taking place, that way, we get an updated Last-Sync-Date and possibly updated revnumber. If we have not changed any files, then RevNo is the one we found in RemoteManifest. So, we must step through the write stack. We make a half harted attempt to restore normality if we get to local manifest stage and somehow fail to write it out. ----------------------------------------------------------------------------------- HISTORY 2018/10/18 Memory leak in CheckUsingLCD(), StartSync() should not call processClashes() during a TestRun. Only during real thing. 2018/10/22 CheckMetaData() was returning wrong value. 2018/10/25 Much testing, support for Tomdroid. 2018/10/28 Much tweaking and bug fixing. 2018/10/29 Tell TB_Sdiff about note title before showing it. 2018/11/03 Call checkmetadata before resolving clashes. 2018/11/04 No longer call MarkNoteReadOnly as we now rely on searchForm.ProcessSyncUpdates 2018/11/05 Now set Notemeatdata LCD to LCD of local note when Clash handler sets SyUpLoadEdit 2018/11/25 Added DeleteFromLocalManifest(), called from search unit, TEST ! 2018/06/05 Change to doing Tomboy's sync dir names, rev 431 is in ~/4/341 2019/07/19 Escape ' and " when using Title as an attribute in local manifest. 2020/02/27 Better detect when we try to sync and don't have a local manifest, useful for Tomdroid, check normal ! 2021/01/04 Support TomdroidFile sync mode. 2021/08/31 Added sha to TNoteInfo 2021/09/08 Added progress indicator 2021/09/27 Selective Sync, possible to have both configured and in use. 2022/10/18 When renaming a file, delete target if its exists first, its a windows problem 2023/10/28 Restructure some of Auto Sync to allow multithreading, does not use SyncGUI 2023/12/16 Nasty bug where ProcessClashes() return value was not set. } interface uses Classes, SysUtils, SyncUtils, Trans, LCLIntf; type { ----------------- T S Y N C --------------------- } { TSync } TSync = class private // Indicates that use of this class, currently, is multithreaded. // In particular, StartSync() will call Synchronize() and tell it to // check upcoming downloads, marking any matching notes as readonly. // Its set in AutoSync() only. Threaded : boolean; // Generally an empty string but in Android/Tomdroid something we prefix // to local manifest file name to indicate which connection it relates to. ManPrefix : string; // Set by SetTransport(), indicates what sort of Sync we are trying to do. TransportMode : TSyncTransport; { Indicates an action to take to be taken for each (and every) note during a sync. } ProceedAction : TSyncAction; // Where we find Tomboy style notes FNotesDir : string; // Where we find config and local manifest files FConfigDir : string; { Scans Notes dir looking for each note in NoteMetaData. Any it finds are either clashes or SyNothing, anything left are downloads. If AssumeNoClash and we find a clash, unresolable 'cos LCD missing, ret False, (and expect LoadRepoData to be called again. Used when JOINING an existing repo.} function CheckUsingLCD(AssumeNoClash : boolean) : boolean; { Returns true if the passed dates are pretty close, see code for just how close } function DatesClose(const DS1, DS2: TDateTime): boolean; { Backs up and then removes any local local notes listed NoteMetaData as SyDeleteLocal } function DoDeleteLocal(): boolean; { Returns the title of given note, prefers the local version but if it does not exist, then "downloads" remote one } function GetNoteTitle(const ID : ANSIString; const Rev : integer): ANSIString; // function IDLooksOK(const ID: string): boolean; { Looks at a clash and determines if its an up or down depending on possible higher order TSyncActions such as newer, older } function ResolveAllClash(const Act : TSyncAction; const ID, FullRemoteFileName : ANSIString): TSyncAction; { Goes over NoteMetaData (which has only remote notes at this stage) assigning an Action to each. Only called when using an established sync connection. } function CheckUsingRev(): boolean; {Notes we have deleted (and existed) here since last sync are marked DeleteRemote because we must delete them from the server. For file sync, that means not mentioning them in remote manifest any more. Note that while it might seem unnecessary, we must inc the revision number.} procedure CheckLocalDeletes(); { Scans over the notes directory for any note not mentioned in NoteMetaData and adds it as an syUploadNew as its a new note since last sync. Call after all the other methods that help build the NoteMetaDate. } procedure CheckNewNotes(); {if we have a note prev synced (ie, in local manifest) but not now in RemoteMetaData, it was deleted by another client, Mark these as DeleteLocal, will later backup and delete.} procedure CheckRemoteDeletes(); // Just a debug procedure, dumps (some) contents of a list to console procedure DisplayNoteInfo(const meta: TNoteInfoList; const ListTitle : string); // Based on NoteMetaData, calls transport to delete notes from Server. function DoDeletes(): boolean; { We call transport for all the notes in the list we need download. Transport does most of the work. In TestMode, does nothing } function DoDownloads(): boolean; { Uploads any files it finds necessary in NoteMetaData. Returns false if anything goes wrong (such as a file error) } function DoUploads(): boolean; { Asks Transport for a list of the notes remote server knows about. If ForceLCD then make heroic efforts to get last-change-dates } function LoadRepoData(ForceLCD : boolean): boolean; { Searches list for any clashes, refering each one to user. Done after list is filled out in case we want to ask user for general instrucions } function ProcessClashes: boolean; // Checks if local note exists, optionally returning with its last change date. function LocalNoteExists(const ID : string; out CDate: string; GetDate: boolean=false): Boolean; // Call this when we are resolving a sync clash. Note : not possible results make sense ! function ProceedWith(const ID, FullRemoteFileName, NTitle: ANSIString): TSyncAction; { Reads through Local Manifest file, filling out LocalMetaData, LastSyncDateSt and CurrRev. If local manifest does not exist, still returns True but CurrRev=0 and LocalLastSyncDateSt='' If FullFileName parameter is missing, uses default version.} function ReadLocalManifest(const FullFileName : string = ''): boolean; { Writes a local mainfest file. Assumes NoteMetaData contains valid data about new Rev numbers and for uploads, last-change-date. If WriteOK is false then don't rev number and don't mention new notes in local manifest. Should never write entries in the DeletedNotes section. This function is called at the end of a normal file sync, another one is used when updating (with deletes) an existing manifest. Key diff is ability to inc rev no and (unnecessary) writing of a failsafe version if things go wrong. Merge at some stage. } function WriteLocalManifest(const WriteOK, NewRev : boolean) : boolean; { We write a remote manifest out localy if we have any uploads or to handle the delete from server a note that was deleted locally to do. Then, if TestMode is false, call Transport to deal with it. Writing it locally is fast and we get to check for and isolate any data errors. Initially written to $CONFIG/manifest.xml-remote and copied (moved ?).} function WriteRemoteManifest(out NewRev: boolean): boolean; { Only used with DeleteFromLocalManifest(), iff it finds a matching entry in indicated manifest main sesction moves it to the deleted Notes section } function DeleteFromThisManifest(const FullFileName, ID: string): boolean; { Only used with DeleteFromLocalManifest(), writes LocalMetaData back to disk. Honours TestRun. } function ReWriteLocalManifest(const FullFileName : string) : boolean; { Applies only to Github, returns the token expire data or 'Expired' } function FGetTokenExpire() : string; function FGetTransRemoteAddress() : string; public // A passord, passed on to Trans for those Transports that need it. // Must be set (if needed) before SetTransport is called. UserName, Password : string; // Indicates what we want this unit to do. Set it and call TestConnection() repeatly... RepoAction : TRepoAction; { Records local manifests view of serverID, after succefull test, it should be the remote manifest's one too. In Android mode, we preload it from the config file at class creation and its overwritten (with same data) when local manifest is read. But in RepoJoin, we set it, after TestConnection to the Transport's view of what remote ServerID is. This is for Android mode to be able to record the new ID in its own config file. } LocalServerID : string; { The calling process must pass a function address to this var except in Auto Sync mode (when its nil). It will be called if the sync process finds a sync class where both copies of a note have changed since last sync.} ProceedFunction : TProceedFunction; { A method to call when we can advise a GUI of progress through sync } ProgressProcedure : TProgressProcedure; // A URL or directory with trailing delim. Get from Settings. SyncAddress : string; // Revision number the client is currently on CurrRev : integer; // A string of local last sync date. Empty if we have not synced before // Available iff we are in RepoUse mode after TestConnection() LocalLastSyncDateSt : string; // Last time this client synced (not this run), set and tested in call to StartSync() // Available iff we are in RepoUse mode after TestConnection() LocalLastSyncDate : TDateTime; // Write debug messages as we do things. DebugMode : boolean; // Determine what we'd do and write ref ver of manifests but don't move files around. // The first run during a Join is a TestRun, then, if user says Save, its not. TestRun : boolean; // A reason why something failed. ErrorString : string; { Data about notes in remote manifest, this list ultimatly holds the actions to be taked when the the actual sync process really runs. } RemoteMetaData : TNoteInfoList; // Data obtained from Local Manifest. Represents notes previously synced. Might be empty..... LocalMetaData : TNoteInfoList; // Used in Threaded mode to lock any open notes that are about to be overwritten by a sync download. Procedure AdjustNoteList(); { returns the number of changes this sync run made. } function ReportChanges(): integer; procedure FSetConfigDir(Dir : string); property ConfigDir : string read FConfigDir write FSetConfigDir; property TransMode : TSyncTransport read TransportMode; property TokenExpire : string read FGetTokenExpire; procedure FSetNotesDir(Dir : string); Property NotesDir : string read FNotesDir write FSetNotesDir; { Returns the set Transport's RemoteAddress, for GithubSync } property GetTransRemoteAddress : string read fGetTransRemoteAddress; { IFF its there, delete the indicated ID from main section of local manifest (and any Tomdroid and SyncGithub manifests) and list it in the deleted section instead. Its really stand alone, create a sync object, set config and notes dir, call this method and free. } function DeleteFromLocalManifest(ID: ANSIString) : boolean; { Reports on contents of a created and filled list } procedure ReportMetaData(out UpNew, UpEdit, Down, DelLoc, DelRem, Clash, DoNothing, Errors: integer); { Selects a Trans layer, adjusts config dir, TransFileAnd : checks for the expected remote dir, may return SyncNoRemoteRepo, SyncNoServerID (not an error, just not used previously) or SyncReady. } function SetTransport(Mode : TSyncTransport) : TSyncAvailable; { Checks NoteMetaData for valid Actions, writes error to console. Always returns True and does mark bad lines with Action=SyError Also fills in note Title for notes we will do something with.} function CheckMetaData() : boolean; { May return : SyncXMLError, SyncNoRemoteDir, SyncNoRemoteWrite, SyncNoRemoteRepo, SyncBadRemote, SyncMismatch. Checks if the connecton looks viable, either (fileSync) it has right files there and write access OR (NetSync) network answers somehow (?). Reads local manifest if RepoAction=RepoUse and compares ts serverID with one found by Trans.testConnection. SyncReady means we can proceed to StartSync, else must do something first, setup new connect, consult user etc.} function TestConnection() : TSyncAvailable; { Does the actual moving of files around, depends on a successful GetSyncData() before hand. TestRun=True just report on what you'd do. Assumes a Transport has been selected and remote address is set. } function UseSyncData: boolean; { Populates the Sync data structures with info about what files need to be moved where. Does no data moving (thats done by UseSyncData()) We must already be a member of this sync, ie, its remote ID is recorded in our local manifest. TestRun=True just report on what you'd do.} function GetSyncData(): boolean; { Shortcut setup for background run, still needs GetSyncData() and UseSyncData() to be called aftwards. Able to be run in a background thread. } function AutoSetUp(Mode: TSyncTransport): boolean; constructor Create(); destructor Destroy(); override; end; implementation { TSync } uses laz2_DOM, laz2_XMLRead, TransFile, TransGithub, LazLogger, LazFileUtils, FileUtil, Settings, tb_utils, SearchUnit; // here because we call SearchForm.ProcessSyncUpdates() var Transport : TTomboyTrans; constructor TSync.Create(); begin ProgressProcedure := Nil; ProceedFunction := Nil; RemoteMetaData := TNoteInfoList.Create; LocalMetaData := TNoteInfoList.Create; Transport := nil; end; destructor TSync.Destroy(); begin FreeandNil(LocalMetaData); FreeandNil(RemoteMetaData); FreeandNil(Transport); inherited Destroy(); end; function TSync.DeleteFromLocalManifest(ID: ANSIString) : boolean; var FullFileName : string; Info : TSearchRec; begin FullFileName := ConfigDir + 'manifest.xml'; if FileExists(FullFileName) then if not DeleteFromThisManifest(FullFileName, ID) then begin debugln('ERROR - failed to delete ' + ID + ' from ' + FullFileName); // Note - not finding the manifest file is not an error, just unsynced. exit(False); end else if DebugMode then debugln('DeleteFromLocalManifest - cannot find ' + FullFileName + ' not in use ?'); FullFileName := ConfigDir + SyncTransportName(SyncGithub) + PathDelim + 'manifest.xml'; if FileExists(FullFileName) then if not DeleteFromThisManifest(FullFileName, ID) then begin debugln('ERROR - failed to delete ' + ID + ' from ' + FullFileName); exit(False); end else if DebugMode then debugln('DeleteFromLocalManifest - cannot find ' + FullFileName + ' not in use ?'); if DirectoryExists(ConfigDir + 'android') then begin if FindFirst(ConfigDir + 'android' + pathdelim + '*.xml', faAnyFile, Info)=0 then try repeat // Info.Name is just the file name, no path prepended. // debugln('DeleteFromLocalManifest-------- Found xml file ' + Info.Name); DeleteFromThisManifest(ConfigDir + 'android' + pathdelim + Info.Name, ID); until FindNext(Info) <> 0; finally FindClose(Info); end; end else if DebugMode then debugln('DeleteFromLocalManifest - cannot find ' + ConfigDir + 'android'); exit(True); end; function TSync.LocalNoteExists(const ID : string; out CDate : string; GetDate : boolean = false) : Boolean; var Doc : TXMLDocument; Node : TDOMNode; //LastChange : string; begin if not FileExists(NotesDir + ID + '.note') then exit(False); if not GetDate then exit(True); Result := True; try ReadXMLFile(Doc, NotesDir + ID + '.note'); Node := Doc.DocumentElement.FindNode('last-change-date'); if assigned(node) then CDate := Node.FirstChild.NodeValue else begin CDate := ''; Result := False; end; finally Doc.free; end; end; { ================= E X T E R N A L C A L L O U T S ===========================} function TSync.ProceedWith(const ID, FullRemoteFileName, NTitle : ANSIString) : TSyncAction; var ClashRec : TClashRecord; //ChangeDate : ANSIString; begin // Note - we no longer fill in all of clash record, let sdiff unit work it out. ClashRec.NoteID := ID; ClashRec.Title:= NTitle; ClashRec.ServerFileName := FullRemoteFileName; ClashRec.LocalFileName := self.NotesDir + ID + '.note'; Result := ProceedFunction(Clashrec); if Result in [SyAllOldest, SyAllNewest, SyAllLocal, SyAllRemote] then ProceedAction := Result; end; function TSync.ResolveAllClash(const Act : TSyncAction; const ID, FullRemoteFileName : ANSIString) : TSyncAction; var Temp : string; begin Result := SyDownload; // just in case .... case Act of SyAllLocal : exit(SyUpLoadEdit); SyAllRemote : exit(SyDownLoad); SyAllNewest : if TB_GetGMTFromStr(GetNoteLastChangeSt(NotesDir + ID + '.note', Temp)) > TB_GetGMTFromStr(GetNoteLastChangeSt(FullRemoteFileName, Temp)) then exit(SyUploadEdit) else exit(SyDownLoad); SyAllOldest : if TB_GetGMTFromStr(GetNoteLastChangeSt(NotesDir + ID + '.note', Temp)) < TB_GetGMTFromStr(GetNoteLastChangeSt(FullRemoteFileName, Temp)) then exit(SyUploadEdit) else exit(SyDownLoad); end; end; function TSync.ProcessClashes() : boolean; var Index : integer; RemoteNote : string; begin Result := True; // Will be false if we have a Sync Clash and in AutoSync Mode for Index := 0 to RemoteMetaData.Count -1 do begin //debugln('TSync.ProcessClashes checking note number ' + inttostr(Index) + ' id=' + RemoteMetaData.Items[Index]^.ID); with RemoteMetaData.Items[Index]^ do begin if Action = SyClash then begin if ProceedFunction = Nil then exit(False); // In autosync, we cannot have a ProceedFunction ! RemoteNote := Transport.DownLoadNote(ID, Rev); debugln('TSync.ProcessClashes - Resolving clash with ' + RemoteNote); if ProceedAction = SyUnSet then begin // let user decide Action := ProceedWith(ID, RemoteNote, RemoteMetaData.Items[Index]^.Title); if Action in [SyAllOldest, SyAllNewest, SyAllLocal, SyAllRemote] then Action := ResolveAllClash(Action, ID, RemoteNote); end else Action := ResolveAllClash(ProceedAction, ID, RemoteNote); // user has already said "all something" end; //if its now become an upload, we update the LCD because ...... if Action = SyUpLoadEdit then begin LastChange := GetNoteLastChangeSt(NotesDir + ID + '.note', ErrorString); if LastChange <> '' then LastChangeGMT := TB_GetGMTFromStr(LastChange) else debugln('ERROR, Failed to get LCD from local ' + ID + ' --- ' + ErrorString); end; end; end; end; procedure TSync.ReportMetaData(out UpNew, UpEdit, Down, DelLoc, DelRem, Clash, DoNothing, Errors : integer); var Index : integer; begin UpNew := 0; UpEdit := 0; Down := 0; Errors := 0; DelLoc := 0; DelRem := 0; DoNothing := 0; Clash := 0; for Index := 0 to RemoteMetaData.Count -1 do begin case RemoteMetaData.Items[Index]^.Action of SyUpLoadNew : inc(UpNew); SyUpLoadEdit : inc(UpEdit); SyDownLoad : inc(Down); SyDeleteLocal : inc(DelLoc); SyDeleteRemote : inc(DelRem); SyClash : inc(Clash); SyNothing : inc(DoNothing); SyError : inc(Errors); end; end; end; {x$define DEBUGAUTOSYNC} function TSync.ReportChanges() : integer; var Index : integer; // St : string; begin result := 0; if (RemoteMetaData = nil) then begin debugln({$I %CURRENTROUTINE%}, '() ', {$I %FILE%}, ', ', 'line:', {$I %LINE%}, ' : ', 'BUT REMOTEMETADATA is NIL.'); exit(0); end; {$ifdef DEBUGAUTOSYNC} debugln('------- AutoSync Run ' + FormatDateTime('YYYY-MM-DD hh:mm', now()) + ' TSync.ReportChanges -------'); {$endif} for Index := 0 to RemoteMetaData.Count -1 do if RemoteMetaData.Items[Index]^.Action in [SyUpLoadNew, SyUpLoadEdit, SyDownLoad, SyDeleteLocal, SyDeleteRemote] then begin inc(result); {$ifdef DEBUGAUTOSYNC} debugln(RemoteMetaData.Items[Index]^.Title + ' ' + RemoteMetaData.ActionName(RemoteMetaData.Items[Index]^.Action)); {$endif} end; end; function TSync.CheckMetaData(): boolean; var Index : integer; begin Result := True; ErrorString := ''; for Index := 0 to RemoteMetaData.Count -1 do begin if RemoteMetaData[Index]^.Action = SyUnSet then begin Debugln('ERROR note not assigned ' + RemoteMetaData[Index]^.ID + ' ' + RemoteMetaData.ActionName(RemoteMetaData[Index]^.Action) + ' ' + RemoteMetaData[Index]^.LastChange + ' ' + RemoteMetaData[Index]^.Title ); result := False; end; if IDLooksOK(RemoteMetaData[Index]^.ID) then begin if (RemoteMetaData[Index]^.Action in [SyNothing, SyUploadNew, SyUpLoadEdit, SyDownLoad, SyDeleteLocal, SyDeleteRemote, SyClash] ) and (RemoteMetaData[Index]^.Title = '') then RemoteMetaData[Index]^.Title := GetNoteTitle(RemoteMetaData[Index]^.ID, RemoteMetaData[Index]^.Rev); end else begin if RemoteMetaData[Index]^.Title = '' then RemoteMetaData[Index]^.Title := GetNoteTitle(RemoteMetaData[Index]^.ID, RemoteMetaData[Index]^.Rev); Debugln('ERROR - invalid ID detected when CheckMetaData [' + RemoteMetaData[Index]^.ID + ']'); RemoteMetaData[Index]^.Action := SyError; ErrorString := 'ERROR - invalid ID detected when CheckMetaData [' + RemoteMetaData[Index]^.ID + ']'; end; end; if debugmode then debugln('CheckMetaData - NoteMetaData has ' + inttostr(RemoteMetaData.Count) + ' entries.'); end; function TSync.GetNoteTitle(const ID : ANSIString; const Rev : integer) : ANSIString; var Doc : TXMLDocument; Node : TDOMNode; FileName : string; begin Result := 'File Not Found'; FileName := NotesDir + ID + '.note'; if not FileExistsUTF8(FileName) then if assigned(Transport) then FileName := Transport.DownLoadNote(ID, Rev); if FileExistsUTF8(FileName) then begin try Result := 'Unknown Title'; try ReadXMLFile(Doc, FileName); Node := Doc.DocumentElement.FindNode('title'); Result := Node.FirstChild.NodeValue; except on EXMLReadError do Result := 'Note has no Title ' + FileName; on EAccessViolation do Result := 'Access Violation ' + FileName; end; finally Doc.free; end; end else begin debugln('ERROR - cannot get title for ' + FileName); result := 'ERROR getting Title'; end; end; procedure TSync.DisplayNoteInfo(const meta : TNoteInfoList; const ListTitle : string); var I : Integer; St : string; begin debugln('-----------list dump for ' + ListTitle); for I := 0 to Meta.Count -1 do begin St := ' ' + inttostr(Meta.Items[i]^.Rev); while length(St) < 5 do St := St + ' '; // St := Meta.ActionName(Meta.Items[i]^.Action); debugln('ID=' + copy(Meta.Items[I]^.ID, 1, 9) + St + Meta.ActionName(Meta.Items[i]^.Action) + ' ' + Meta.Items[I]^.Title + ' sha=' + copy(Meta.Items[I]^.Sha, 1, 9)); debugln(' CDate=' + Meta.Items[i]^.CreateDate + ' LCDate=' + Meta.Items[i]^.LastChange); end; end; { ===================== D A T A C H E C K I N G M E T H O D S ============= } function TSync.DatesClose(const DS1, DS2 : TDateTime) : boolean; var Margin : TDateTime = 0.000001; // a tenth of a second is about one millionth of a day ! begin if DS1 > DS2 then result := (DS1 < (DS2 + Margin)) // 1 greater than 2, if it changes when we increase 2 result is true else Result := (DS1 > (DS2 - Margin)); // 1 is less than 2, if it changes when we decrease 2, result is true end; function TSync.CheckUsingLCD(AssumeNoClash : boolean) : boolean; var Index : integer; Count : integer = 0; Info : TSearchRec; PNote : PNoteInfo; LocLCD : string; // The local note's last change date begin { We declare a clash if both notes exist and LCDs are not identical (or nearly identical) However, iff we have a local last sync date (LLSD) then if the earlier note pre-dates it, its not a clash. So, not a 'pure' LCD model, } if FindFirst(NotesDir + '*.note', faAnyFile, Info)=0 then begin try repeat inc(Count); PNote := RemoteMetaData.FindID(copy(Info.Name, 1, 36)); LocLCD := GetNoteLastChangeSt(NotesDir + Info.Name, ErrorString); // hmm, not checking for errors there ..... if PNote <> nil then begin // ie, note exists on both sides if AssumeNoClash and (PNote^.LastChange = '') then begin if Debugmode then debugln('CheckUsingLCD exiting because if unresolved clash'); exit(false); // might be a clash, go fill out LCD in remote data end; // Next line new, we now accept an idetical string or a datestring thats pretty close if ((PNote^.LastChange = LocLCD) or (DatesClose(PNote^.LastChangeGMT, TB_GetGMTFromStr(LocLCD)))) then // its the same note PNote^.Action := SyNothing else begin PNote^.Action := SyClash; // Best we can do if last sync date not available. if LocalLastSyncDateSt <> '' then begin // We can override that iff we have a LLSD if TB_GetGMTFromStr(LocLCD) < LocalLastSyncDate then PNote^.Action := SyDownload else if PNote^.LastChangeGMT < LocalLastSyncDate then PNote^.Action := SyUploadEdit; if debugmode then debugln('GMTimes - loc=' + FormatDateTime( 'yyyy-mm-dd hh:mm:ss', TB_GetGMTFromStr(LocLCD)) + ' rem=' + FormatDateTime( 'yyyy-mm-dd hh:mm:ss', PNote^.LastChangeGMT) + ' LLSD=' + FormatDateTime( 'yyyy-mm-dd hh:mm:ss', LocalLastSyncDate) + ' rem-st=' + PNote^.LastChange); end; end; end else begin // this note is a new upload, add it to list. new(PNote); PNote^.ID := copy(Info.Name, 1, 36); PNote^.LastChange:=LocLCD; PNote^.Action:= SyUpLoadNew; // Note, we may overrule that in CheckRemoteDeletes() PNote^.Sha := ''; RemoteMetaData.Add(PNote); end; until FindNext(Info) <> 0; finally FindClose(Info); end; end; for Index := 0 to RemoteMetaData.Count -1 do if RemoteMetaData.Items[Index]^.Action = SyUnSet then RemoteMetaData.Items[Index]^.Action := SyDownLoad; if DebugMode then Debugln('CheckUsingLCD checked against ' + inttostr(Count) + ' local notes'); exit(True); end; procedure TSync.CheckRemoteDeletes(); var Index : integer; PNote : PNoteInfo; Count : integer = 0; begin // Must find a created LocalMetaData but an empty one is normal. // Iterate over LocalMetaData looking for notes listed as prev synced // but are not listed in RemoteMetaData. Or are listed as SyUploadNew !! // CheckUsingLCD puts all notes it finds locally but not in Remote as SyUploadNew // We'll add a entry (or change entry) in NoteMetaData for any we find. for Index := 0 to LocalMetaData.Count -1 do begin if not LocalMetaData.Items[Index]^.Deleted then begin PNote := RemoteMetaData.FindID(LocalMetaData.Items[Index]^.ID); if PNote = nil then begin // That is, we did not find it new(PNote); PNote^.ID:= LocalMetaData.Items[Index]^.ID; PNote^.Title := LocalMetaData.Items[Index]^.Title; // I think we know title, useful debug info here.... PNote^.Action := SyDeleteLocal; // Was deleted elsewhere, do same here. PNote^.Sha := ''; RemoteMetaData.Add(PNote); inc(Count); end else begin if PNote^.Action = SyUploadNew then // if it is mentioned in Local Man but Load decided it was '~New', its PNote^.Action := SyDeleteLocal; // really a note that was deleted remotely and should be deleted locally now end; end; end; if debugmode then debugln('CheckRemoteDeletes checked ' + inttostr(LocalMetaData.Count) + ' and found ' + inttostr(Count) + ' notes '); end; procedure TSync.CheckNewNotes(); var Info : TSearchRec; PNote : PNoteInfo; ID, CDate : string; Count : integer = 0; CountNew : integer = 0; begin if FindFirst(NotesDir + '*.note', faAnyFile, Info)=0 then begin repeat ID := copy(Info.Name, 1, 36); inc(Count); //Debugln('Found [' + NotesDir+ Info.Name + ']'); PNote := RemoteMetaData.FindID(ID); if PNote = nil then begin if LocalNoteExists(ID, CDate, True) then begin new(PNote); Pnote^.ID:=ID; Pnote^.LastChange:=CDate; PNote^.Action:=SyUploadNew; PNote^.sha := ''; RemoteMetaData.Add(PNote); inc(CountNew); end else Debugln('Failed to find lastchangedate in ' + Info.Name); end; until FindNext(Info) <> 0; end; FindClose(Info); if debugMode then debugln('CheckNewNotes found ' + inttostr(Count) + ' notes in local dir and ' + inttostr(CountNew) + ' new ones.'); end; // Iterate over LocalMetaData looking for notes that have been deleted // locally and put them in RemoteMetaData to be deleted from the server. procedure TSync.CheckLocalDeletes(); var I : integer; Count : integer = 0; PNote : PNoteInfo; begin for I := 0 to LocalMetaData.Count -1 do begin if LocalMetaData.Items[i]^.Deleted then begin inc(Count); PNote := RemoteMetaData.FindID(LocalMetaData.Items[i]^.ID); if PNote <> nil then PNote^.Action := SyDeleteRemote; end; end; if DebugMode then debugln('CheckLocalDeletes found ' + inttostr(Count) + ' deleted notes in local manifest'); end; function TSync.CheckUsingRev() : boolean; var I : integer; ID : string; // to make it a bit easier to read souce PNote : PNoteInfo; LocCDate : string; LocChange, RemChange : boolean; begin Result := True; for I := 0 to RemoteMetaData.Count -1 do begin ID := RemoteMetaData.Items[I]^.ID; if LocalNoteExists(ID, LocCDate) then begin LocalNoteExists(ID, LocCDate, True); LocChange := TB_GetGMTFromStr(LocCDate) > LocalLastSyncDate; // TDateTime is a float RemChange := RemoteMetaData.Items[I]^.Rev > CurrRev; // This is not valid for Tomdroid if LocChange and RemChange then RemoteMetaData.Items[I]^.Action := SyClash else if LocChange then RemoteMetaData.Items[I]^.Action := SyUpLoadEdit else if RemChange then RemoteMetaData.Items[I]^.Action := SyDownLoad else RemoteMetaData.Items[I]^.Action := SyNothing; end else begin // OK, not here but maybe we deleted it previously ? Pnote := LocalMetaData.FindID(ID); if PNote <> Nil then begin if PNote^.Deleted then RemoteMetaData.Items[I]^.Action:=SyDeleteRemote; // I have deleted that already. end else RemoteMetaData.Items[I]^.Action:=SyDownload; // its a new note from elsewhere end; if RemoteMetaData.Items[I]^.Action = SyUnset then begin debugln('---- Note on Sync List with unassigned action ----'); debugln('ID=' + RemoteMetaData.Items[I]^.ID); debugln('sync.pas CheckUsingRev() - please report this message'); end; if RemoteMetaData.Items[I]^.Action = SyUpLoadEdit then begin RemoteMetaData.Items[I]^.LastChange := GetNoteLastChangeSt(NotesDir + ID + '.note', ErrorString); // debugln('=========== LCD is [' + RemoteMetaData.Items[I]^.CreateDate + ']'); end; end; end; { ======================== N O T E M O V E M E N T M E T H O D S ================} function TSync.DoDownloads() : boolean; {var I : integer; } begin Result := Transport.DownloadNotes(RemoteMetaData); if Result = false then begin self.ErrorString:= Transport.ErrorString; debugln('ERROR - Download Notes reported ' + ErrorString); end; if DebugMode then debugln('Downloaded notes.'); end; function TSync.DoDeleteLocal() : boolean; var I : integer; begin for I := 0 to RemoteMetaData.Count -1 do begin if RemoteMetaData.Items[i]^.Action = SyDeleteLocal then begin if FileExists(NotesDir + RemoteMetaData.Items[i]^.ID + '.note') then if CopyFile(NotesDir + RemoteMetaData.Items[i]^.ID + '.note', NotesDir + PathDelim + 'Backup' + Pathdelim + RemoteMetaData.Items[i]^.ID + '.note') then DeleteFile(NotesDir + RemoteMetaData.Items[i]^.ID + '.note'); end; end; result := true; end; function TSync.DoDeletes() : boolean; var Index : integer; //Cnt : integer = 0; begin if DebugMode then Debugln('DoDeletes Count = ' + inttostr(RemoteMetaData.Count)); for Index := 0 to RemoteMetaData.Count - 1 do begin if RemoteMetaData[Index]^.Action = SyDeleteRemote then begin if DebugMode then Debugln('Delete remote note : ' + RemoteMetaData.Items[Index]^.ID); if not TestRun then begin if not Transport.DeleteNote(RemoteMetaData.Items[Index]^.ID, RemoteMetaData.Items[Index]^.Rev) then begin debugln('ERROR, TSync.DoDeletes got back false from transport'); Exit(False); end; end; end; end; Result := true; end; function TSync.DoUploads() : boolean; var Uploads : TstringList; Index : integer; begin if DebugMode then debugln('Doing uploads and Remote ServerRev is ' + inttostr(Transport.RemoteServerRev)); try Uploads := TstringList.Create; for Index := 0 to RemoteMetaData.Count -1 do begin if RemoteMetaData.Items[Index]^.Action in [SyUploadEdit, SyUploadNew] then begin Uploads.Add(RemoteMetaData.Items[Index]^.ID); RemoteMetaData.Items[Index]^.Rev := Transport.RemoteServerRev + 1; end; end; if not TestRun then if not Transport.UploadNotes(Uploads) then begin ErrorString := Transport.ErrorString; exit(False); end; finally Uploads.Free; end; Result := true; end; function TSync.FGetTokenExpire(): string; begin if assigned(Transport) and (Transport is TGitHubSync) then Result := TGitHubSync(Transport).TokenExpires else Result := 'not applicable'; // should never happen end; function TSync.FGetTransRemoteAddress(): string; begin Result := Transport.RemoteAddress; end; { ================= S T A R T U P M E T H O D S ============== } function TSync.SetTransport(Mode: TSyncTransport) : TSyncAvailable; begin if ProgressProcedure <> nil then ProgressProcedure('Set Transport'); TransportMode := Mode; NotesDir := AppendPathDelim(NotesDir); ConfigDir := AppendPathDelim(ConfigDir); ErrorString := ''; FreeAndNil(Transport); case Mode of SyncFile : begin SyncAddress := AppendPathDelim(Sett.GetSyncFileRepo()); Transport := TFileSync.Create; end; SyncGitHub : begin Transport := TGithubSync.Create; Transport.Password := Password; Transport.Username := UserName; ConfigDir := ConfigDir + SyncTransportName(SyncGithub) + PathDelim; ForceDirectory(ConfigDir); end; end; Transport.ProgressProcedure := ProgressProcedure; Transport.Password := Password; Transport.NotesDir := NotesDir; Transport.DebugMode := DebugMode; Transport.ConfigDir := ConfigDir; // unneeded I think ?? Transport.RemoteAddress:= SyncAddress; // happens _before_ Trans.SetTransport Result := Transport.SetTransport(); // in github, this will (re)set Transport.RemoteAddress ErrorString := Transport.ErrorString; if DebugMode then begin debugln('Remote address is ' + SyncAddress); debugln('Local Config ' + ConfigDir); debugln('Notes dir ' + NotesDir); end; end; function TSync.TestConnection(): TSyncAvailable; {var XServerID : string;} begin if ProgressProcedure <> nil then ProgressProcedure('Test Transport'); if RepoAction = RepoNew then begin LocalLastSyncDate := 0; LocalLastSyncDateSt := ''; Transport.RemoteServerRev:=-1; Transport.ANewRepo:= True; // means we should prepare for a new repo (but not make it yet), don't check for files. end; if RepoAction = RepoUse then begin if not ReadLocalManifest() then exit(SyncXMLError); // Error in local mainfest, OK or no manifest=true if LocalLastSyncDateSt = '' then begin ErrorString := 'Failed to read local manifest, is this an existing sync ?'; debugln('ReadLocalManifest set an empty LocalLastSyncDateSt, probably local manifest does not exist.'); exit(SyncNoLocal); end; LocalLastSyncDate := TB_GetGMTFromStr(LocalLastSyncDateSt); if LocalLastSyncDate < 1.0 then begin ErrorString := 'Invalid last sync date in local manifest [' + LocalLastSyncDateSt + ']'; debugln('Invalid last sync date in ' + ConfigDir + ManPrefix + 'manifest.xml'); exit(SyncXMLError); end; end; if RepoAction = RepoJoin then begin LocalLastSyncDate := 0; LocalLastSyncDateSt := ''; end; Result := Transport.TestTransport(not TestRun); // ***************** if Result <> SyncReady then begin ErrorString := Transport.ErrorString; exit; end; if DebugMode then begin debugln('CurrRev=' + inttostr(CurrRev) + ' Last Sync=' + LocalLastSyncDateSt + ' Local Entries=' + inttostr(LocalMetaData.Count)); debugln('Config=' + ConfigDir + ' NotesDir=' + NotesDir); end; if RepoAction = RepoUse then if Transport.ServerID <> LocalServerID then begin ErrorString := 'ServerID Mismatch'; if DebugMode then debugln('ERROR Server ID Mismatch Remote ' + Transport.ServerID + ' and local ' + LocalServerID); exit(SyncMismatch); end; if RepoAction = RepoJoin then begin LocalServerID := Transport.ServerID; end; if Result = SyncReady then if not IDLooksOK(Transport.ServerID) then begin ErrorString := 'An invalid serverID detected [' + Transport.ServerID + ']'; debugln('ERROR - completed TestConnection but ServerID is invalid [' + Transport.ServerID + ']'); Result := SyncBadError; end; end; function TSync.LoadRepoData(ForceLCD : boolean): boolean; begin if ProgressProcedure <> nil then ProgressProcedure('Load Remote Repo'); Result := True; FreeAndNil(RemoteMetaData); RemoteMetaData := TNoteInfoList.Create; if not assigned(Transport) then debugln('Transport is not assigned'); if not assigned(RemoteMetaData) then debugln('RemoteMetaData is not assigned'); if TransportMode = SyncGitHub then exit(); case RepoAction of RepoUse : Result := Transport.GetRemoteNotes(RemoteMetaData, False); RepoJoin : Result := Transport.GetRemoteNotes(RemoteMetaData, ForceLCD); // Note, RepoNew does not apply here, if we are making a new one, we assume its empty. end; if DebugMode then begin debugln('LoadRepoData found ' + inttostr(RemoteMetaData.Count) + ' remote notes'); // DisplayNoteInfo(RemoteMetaData, 'NoteMetaData just after Loading'); end; // We do not load remote metadata when creating a new repo ! end; { ---------- The Lets Do it Functions ------------- } //function TSync.StartSync(): boolean; function TSync.GetSyncData() : boolean; // Tick1, Tick2, Tick3, Tick4 : Dword; begin Result := True; if ProgressProcedure <> nil then ProgressProcedure('Starting Sync'); // TestRun := True; if not LoadRepoData(False) then exit(False); // don't get LCD until we know we need it. case RepoAction of RepoUse : begin if TransportMode = SyncGithub then TGithubSync(Transport).AssignActions(RemoteMetaData, LocalMetaData, TestRun) else CheckUsingRev(); // note that the Android sync used to use CheckUsingLCD(False) do we still need it ? CheckRemoteDeletes(); CheckLocalDeletes(); end; RepoJoin : if TransportMode = SyncGithub then TGithubSync(Transport).AssignActions(RemoteMetaData, LocalMetaData, TestRun) else // Github will always have a LCD but not usable for this purpose. if not CheckUsingLCD(True) then begin // at least 1 possible clash LoadRepoData(True); // start again, getting LCD this time CheckUsingLCD(False); end; RepoNew : begin freeandNil(RemoteMetaData); RemoteMetaData := TNoteInfoList.Create; // clean out the list abd start again if TransportMode = SyncGithub then TGithubSync(Transport).AssignActions(RemoteMetaData, LocalMetaData, TestRun) end end; //DisplayNoteInfo(RemoteMetaData, 'RemoteMetaData before CheckNewNotes()'); if TransportMode <> SyncGithub then CheckNewNotes(); //DisplayNoteInfo(RemoteMetaData, 'RemoteMetaData before CheckMetaData()'); CheckMetaData(); if DebugMode then DisplayNoteInfo(RemoteMetaData, 'RemoteMetaData after CheckMetaData()'); if TestRun then begin if ProgressProcedure <> nil then ProgressProcedure('Finished Test Run'); exit(); end; result := ProcessClashes(); // Will be false if in AutoSync mode AND we have a clash. if DebugMode then DisplayNoteInfo(RemoteMetaData, 'NoteMetaData after ProcessClashes'); end; // ToDo : SyncInThread requires us to call AdjustNoteList() from here so any downloaded and open notes are locked. // if Threaded then // Synchronize(@AdjustNoteList); function TSync.UseSyncData() : boolean; var NewRev : boolean = false; begin if not DoDownLoads() then exit(SayDebugSafe('TSync.StartSync - failed DoDownLoads')); if TransPortMode <> SyncGitHub then if not WriteRemoteManifest(NewRev) then exit(SayDebugSafe('TSync.StartSync - failed early WriteRemoteManifest')); if not DoDeletes() then exit(SayDebugSafe('TSync.StartSync - failed DoDeletes')); if not DoUploads() then exit(SayDebugSafe('TSync.StartSync - failed DoUploads')); if not DoDeleteLocal() then exit(SayDebugSafe('TSync.StartSync - failed DoDeleteLocal')); if TransportMode = SyncGithub then if not Transport.DoRemoteManifest('', RemoteMetaData) then exit(SayDebugSafe('TSync.StartSync - failed late WriteRemoteManifest')); if not WriteLocalManifest(true, NewRev) then WriteLocalManifest(false, false); // write a recovery local manifest. Downloads only noted. (* if DoDownLoads() then if TransPortMode <> SyncGitHub then if WriteRemoteManifest(NewRev) then if DoDeletes() then if DoUploads() then if DoDeleteLocal() then if TransportMode = SyncGithub then if not WriteLocalManifest(true, NewRev) then WriteLocalManifest(false, false); // write a recovery local manifest. Downloads only noted. *) if ProgressProcedure <> nil then ProgressProcedure('Sync Complete'); Result := True; end; procedure TSync.AdjustNoteList(); // Another version of this exists in SyncGUI, maybe merge ? var DeletedList, DownList : TStringList; Index : integer; begin DeletedList := TStringList.Create; DownList := TStringList.Create; with RemoteMetaData do begin for Index := 0 to Count -1 do begin if Items[Index]^.Action = SyDeleteLocal then DeletedList.Add(Items[Index]^.ID); if Items[Index]^.Action = SyDownload then DownList.Add(Items[Index]^.ID); end; end; if (DeletedList.Count > 0) or (DownList.Count > 0) then SearchForm.ProcessSyncUpdates(DeletedList, DownList); FreeandNil(DeletedList); FreeandNil(DownList); end; function TSync.AutoSetUp(Mode : TSyncTransport) : boolean; { we must have set, after creation and before calling this - debugmode NotesDir ConfigDir Password UserName } begin Threaded := True; RepoAction:= RepoUse; SetTransport(Mode); //debugln({$I %FILE%}, ', ', {$I %CURRENTROUTINE%}, '(), line:', {$I %LINE%}, ' : Testing Connection.'); if TestConnection() <> SyncReady then begin //debugln({$I %FILE%}, ', ', {$I %CURRENTROUTINE%}, '(), line:', {$I %LINE%}, ' : ', 'Test Transport Failed.'); exit(false); end; TestRun := False; Result := True; // PostMessage(sett.Handle, WM_SYNCBLOCKFINISHED, 2, 0); // ThreadTest end; // ------------------ M A N I F E S T R E L A T E D ----------------------- function TSync.WriteRemoteManifest(out NewRev : boolean): boolean; var OutFile: TextFile; Index : integer; NewRevString : string; begin if DebugMode then debugln('Ready to do remote Manifest'); if not IDLooksOK(Transport.ServerID) then exit(false); // already checked but .... result := true; NewRev := False; for Index := 0 to RemoteMetaData.Count - 1 do begin if RemoteMetaData[Index]^.Action in [SyUploadNew, SyUpLoadEdit, SyDeleteRemote] then begin NewRev := True; break; // one is enough, we need a new manifest file ! end; end; if Not NewRev then exit(true); // exit cos no need for new Man, ret true cos no file error, NewRevString := inttostr(Transport.RemoteServerRev + 1); AssignFile(OutFile, ConfigDir + 'manifest.xml-remote'); try try Rewrite(OutFile); writeln(OutFile, '<?xml version="1.0" encoding="utf-8"?>'); write(OutFile, '<sync revision="' + NewRevString); writeln(OutFile, '" server-id="' + Transport.ServerID + '">'); for Index := 0 to RemoteMetaData.Count - 1 do begin if RemoteMetaData[Index]^.Action in [SyUploadNew, SyUpLoadEdit, SyDownLoad, SyNothing] then begin write(OutFile, ' <note id="' + RemoteMetaData.Items[Index]^.ID + '" rev="'); if RemoteMetaData[Index]^.Action in [SyUploadNew, SyUpLoadEdit] then write(OutFile, NewRevString + '"') else write(OutFile, inttostr(RemoteMetaData.Items[Index]^.Rev) + '"'); if RemoteMetaData.Items[Index]^.LastChange = '' then writeln(OutFile, ' />') else writeln(OutFile, ' last-change-date="' + RemoteMetaData.Items[Index]^.LastChange + '" />'); end; end; writeln(OutFile, '</sync>'); except on E: EInOutError do begin Debugln('File handling error occurred. Details: ' + E.Message); exit(false); // file error ! end; end; finally CloseFile(OutFile); end; // do a safe version of this - if not TestRun then result := Transport.DoRemoteManifest(ConfigDir + 'manifest.xml-remote'); if debugmode then debugln('Have written remote manifest to ' + ConfigDir + ManPrefix + 'manifest.xml-remote'); end; //OK, this needs to call its code for each valid android manifest file. function TSync.DeleteFromThisManifest(const FullFileName, ID : string): boolean; var i : integer; Found : boolean = false; begin // if debugmode then debugln('DeleteFromThisManifest, searching for ' + ID); if not ReadLocalManifest(FullFileName) then exit(false); // read a local manifest if debugmode then debugln('DeleteFromThisManifest lines = ' + inttostr(LocalMetaData.count)); if LocalMetaData.count = 0 then exit(True); //if debugmode then debugln('DeleteFromThisManifest searcing for ' + ID); for I := 0 to LocalMetaData.count -1 do begin // debugln('DeleteFrom.. Testing ' + LocalMetaData.Items[i]^.ID); if LocalMetaData.Items[i]^.ID = ID then begin LocalMetaData.Items[i]^.Deleted:= True; LocalMetaData.Items[i]^.Title := GetNoteTitle(ID, -1); // -1 says don't try and download if its not local Found := True; if debugmode then debugln('DeleteFromThisManifest deleted ' + ID + ' from ' + FullFileName); break; end; end; if Found then ReWriteLocalManifest(FullFileName); Result := True; end; function TSync.ReWriteLocalManifest(const FullFileName : string) : boolean; var OutFile: TextFile; Index : integer; begin AssignFile(OutFile, FullFileName + '-local'); try try Rewrite(OutFile); writeln(OutFile, '<?xml version="1.0" encoding="utf-8"?>'); writeln(Outfile, '<manifest xmlns="http://beatniksoftware.com/tomboy">'); writeln(OutFile, ' <last-sync-date>' + LocalMetaData.LastSyncDateSt + '</last-sync-date>'); write(OutFile, ' <last-sync-rev>"' + inttostr(LocalMetaData.LastRev)); writeln(OutFile, '"</last-sync-rev>'); writeln(OutFile, ' <server-id>"' + LocalMetaData.ServerID + '"</server-id>'); writeln(OutFile, ' <note-revisions>'); for Index := 0 to LocalMetaData.Count - 1 do begin if not LocalMetaData[Index]^.Deleted then begin write(Outfile, ' <note guid="' + LocalMetaData[Index]^.ID + '" latest-revision="'); write(OutFile, inttostr(LocalMetaData[Index]^.Rev) + '" '); if LocalMetaData[Index]^.Sha <> '' then write(Outfile, 'sha="' + LocalMetaData[Index]^.Sha + '" '); writeln(Outfile, '/>'); end; end; writeln(OutFile, ' </note-revisions>'#10' <note-deletions>'); for Index := 0 to LocalMetaData.Count - 1 do begin if LocalMetaData[Index]^.Deleted then begin write(Outfile, ' <note guid="' + LocalMetaData[Index]^.ID + '" title="'); write(OutFile, RemoveBadXMLCharacters(LocalMetaData[Index]^.Title, True)); // cannot allow " or ' in an xml attribute writeln(Outfile, '" />'); end; end; writeln(OutFile, ' </note-deletions>'#10'</manifest>'); finally CloseFile(OutFile); end; except on E: EInOutError do begin Debugln('File handling error occurred. Details: ' + E.Message); exit(false); end; end; // if to here, copy the file over top of existing local manifest { if debugmode then debugln('Have written local manifest to ' + FullFileName + '-local'); } if not TestRun then begin if FileExistsUTF8(FullFileName + '-old') then DeleteFileUTF8(FullFileName + '-old'); renamefileutf8(FullFileName, FullFileName + '-old'); renamefileutf8(FullFileName + '-local', FullFileName); // ToDo : check for errors, Windows rename will not overwrite ! end; result := True; end; function TSync.WriteLocalManifest(const WriteOK, NewRev : boolean ): boolean; { We try and provide some recovery from a fail to write to remote repo. It should not happen but ... If WriteOk is false we write back local manifest that still mentions the previous deleted files and does not list locally new and changed files. Such files retain their thier previous rev numbers. Test ! } var OutFile: TextFile; Index : integer; IncRev : integer = 0; begin if not IDLooksOK(Transport.ServerID) then exit(false); // already checked but .... result := true; if WriteOK and NewRev then IncRev := 1 else IncRev := 0; AssignFile(OutFile, ConfigDir + ManPrefix + 'manifest.xml-local'); // ManPrefix is '' for most Modes. try try Rewrite(OutFile); writeln(OutFile, '<?xml version="1.0" encoding="utf-8"?>'); writeln(Outfile, '<manifest xmlns="http://beatniksoftware.com/tomboy">'); writeln(OutFile, ' <last-sync-date>' + TB_GetLocalTime + '</last-sync-date>'); write(OutFile, ' <last-sync-rev>"' + inttostr(Transport.RemoteServerRev + IncRev)); writeln(OutFile, '"</last-sync-rev>'); writeln(OutFile, ' <server-id>"' + Transport.ServerID + '"</server-id>'); writeln(OutFile, ' <note-revisions>'); for Index := 0 to RemoteMetaData.Count - 1 do begin if RemoteMetaData[Index]^.Action in [SyUploadNew, SyUpLoadEdit, SyDownLoad, SyNothing] then begin if (not WriteOK) and (RemoteMetaData[Index]^.Action = SyUpLoadNew) then continue; write(Outfile, ' <note guid="' + RemoteMetaData[Index]^.ID + '" latest-revision="'); write(OutFile, inttostr(RemoteMetaData[Index]^.Rev) + '" '); if RemoteMetaData[Index]^.Sha <> '' then write(Outfile, 'sha="' + RemoteMetaData[Index]^.Sha + '" '); writeln(Outfile, '/>'); end; end; writeln(OutFile, ' </note-revisions>'#10' <note-deletions>'); writeln(OutFile, ' </note-deletions>'#10'</manifest>'); finally CloseFile(OutFile); end; except on E: EInOutError do begin Debugln('File handling error occurred. Details: ' + E.Message); exit(false); end; end; // if to here, copy the file over top of existing local manifest if not TestRun then copyfile(ConfigDir + ManPrefix + 'manifest.xml-local', ConfigDir + ManPrefix + 'manifest.xml'); if debugmode then debugln('Have written local manifest to ' + ConfigDir + ManPrefix + 'manifest.xml-local'); end; function TSync.ReadLocalManifest(const FullFileName : string = '') : boolean; var Doc : TXMLDocument; NodeList : TDOMNodeList; Node, NodeSha : TDOMNode; j : integer; NoteInfoP : PNoteInfo; RevStr, ServerID, ManifestFile : string; begin Result := true; ErrorString := ''; freeandNil(LocalMetaData); LocalMetaData := TNoteInfoList.Create; if FullFileName = '' then begin // get a FFN when using this unit to edit local man after a file delete ManifestFile := ConfigDir + ManPrefix + 'manifest.xml'; if not FileExists(ManifestFile) then begin LocalLastSyncDateSt := ''; CurrRev := 0; exit(True); // Its not an error, just never synced before end; end else ManifestFile := FullFileName; // existance is checked before calling. if DebugMode then debugln('Reading local mainfest ' + ManifestFile); try try ReadXMLFile(Doc, ManifestFile); Node := Doc.DocumentElement.FindNode('last-sync-date'); if assigned(Node) then begin LocalLastSyncDateSt := Node.FirstChild.NodeValue; LocalMetaData.LastSyncDateSt := Node.FirstChild.NodeValue; if not MyTryISO8601ToDate(LocalLastSyncDateSt, LocalMetaData.LastSyncDate, True) then LocalMetaData.LastSyncDate := 0.0; end else begin LocalLastSyncDateSt := ''; LocalMetaData.LastSyncDateSt := ''; LocalMetaData.LastSyncDate := 0.0; debugln('ERROR, cannot find LSD in ' + ManifestFile); end; Node := Doc.DocumentElement.FindNode('server-id'); if Assigned(Node) then ServerID := Node.FirstChild.NodeValue else ServerID := ''; // Thats untested but should never happen if ServerID[1] = '"' then ServerID := copy(ServerID, 2, 36); if not IDLooksOK(ServerID) then begin ErrorString := 'Local manifest contains an invalid serverID [' + ServerID +']'; debugln('ERROR - local manifest contains an invalid serverID [' + ServerID +']'); debugln('Maybe you should delete it and rejoin the Repo. ?'); exit(false); end; LocalServerID := ServerID; LocalMetaData.ServerID:= ServerID; Node := Doc.DocumentElement.FindNode('last-sync-rev'); try RevStr := Node.FirstChild.NodeValue; if RevStr[1] = '"' then Revstr := copy(revStr, 2, length(RevStr) - 2); CurrRev := strtoint(RevStr); except on EConvertError do // just a plain bad string ErrorString := 'Error converting Local Rev Version ' + RevStr; on EObjectCheck do // mac does this ErrorString := 'Error in local mainfest, check RevNo'; on EAccessViolation do // Lin does this ErrorString := 'Error in local mainfest, check RevNo'; end; LocalMetaData.LastRev := CurrRev; if ErrorString <> '' then begin CurrRev := 0; LocalLastSyncDateSt := ''; LocalMetaData.LastSyncDateSt:=''; exit(False); end; NodeList := Doc.DocumentElement.FindNode('note-revisions').ChildNodes; if assigned(NodeList) then for j := 0 to NodeList.Count-1 do begin new(NoteInfoP); NoteInfoP^.ID := NodeList.Item[j].Attributes.GetNamedItem('guid').NodeValue; NoteInfoP^.Rev := strtoint(NodeList.Item[j].Attributes.GetNamedItem('latest-revision').NodeValue); NodeSha := NodeList.Item[j].Attributes.GetNamedItem('sha'); if NodeSha = nil then NoteInfoP^.Sha := '' else NoteInfoP^.Sha := NodeSha.NodeValue; NoteInfoP^.Deleted := False; LocalMetaData.Add(NoteInfoP); end; NodeList := Doc.DocumentElement.FindNode('note-deletions').ChildNodes; if assigned(NodeList) then for j := 0 to NodeList.Count-1 do begin new(NoteInfoP); NoteInfoP^.ID := NodeList.Item[j].Attributes.GetNamedItem('guid').NodeValue; NoteInfoP^.Title := NodeList.Item[j].Attributes.GetNamedItem('title').NodeValue; NoteInfoP^.Deleted := True; NoteInfoP^.Sha := ''; LocalMetaData.Add(NoteInfoP); end; finally Doc.Free; end; except on EAccessViolation do begin // probably means we did not find an expected attribute ErrorString := 'Error in local mainfest'; CurrRev := 0; LocalMetaData.LastRev:=0; LocalLastSyncDateSt := ''; LocalMetaData.LastSyncDateSt:=''; Result := false; end; end; // if Debugmode then DisplayNoteInfo(LocalMetaData, 'LocalMetaData'); end; procedure TSync.FSetConfigDir(Dir: string); begin FConfigDir := AppendPathDelim(Dir); if DirectoryExists(FConfigDir) then begin if Not DirectoryIsWritable(FConfigDir) then self.ErrorString:= 'Cannot write to config dir'; end else ErrorString := 'Config dir does not exist'; end; procedure TSync.FSetNotesDir(Dir: string); begin FNotesDir := AppendPathDelim(Dir); end; end. �����������������������������tomboy-ng_0.39-1/source/resourcestr.pas�������������������������������������������������������������0000644�0001750�0001750�00000020140�14551457644�020021� 0����������������������������������������������������������������������������������������������������ustar �dbannon�������������������������dbannon����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������unit ResourceStr; { Copyright (C) 2017-2022 David Bannon License: This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html ------------------ An attempt to move all resource strings into one unit to facilate reuse where possible. Note that while arranged in blocks labeled with the unit that uses them, no reason to limit use to that. } {$mode objfpc}{$H+} interface uses Classes, SysUtils; RESOURCESTRING { to use replacable parameters, pass an array of parameters to format() rsString := 'you have %d pimples'; label1.caption := format(rsString, [Count]) } // notebook.pas rsMultipleNoteBooks = 'Settings allow multiple Notebooks'; rsOneNoteBook = 'Settings allow only one Notebook'; rsSetTheNotebooks = 'Set the Notebooks this note is a member of'; rsChangeNameofNotebook = 'Change the name of this Notebook'; rsNumbNotesAffected = 'This will affect %d notes'; // %d replaced by integer, 0 to big number rsEnterNewNotebook = 'Enter a new Notebook name please'; rsNotebookOptionRight = 'Right click for Notebook Options'; // Windows, Linux rsNotebookOptionCtrl = 'Ctrl click for Notebook Options'; // Mac rsAddNotesToNotebook = 'Add notes to this Notebook'; // SearchForm // these are main menu items and string grid headings - rsMenuNewNote = 'New Note'; rsMenuSearch = 'Search'; rsMenuAbout = 'About'; rsMenuSync = 'Synchronise'; rsMenuSettings = 'Settings'; rsMenuHelp = 'Help'; rsMenuQuit = 'Quit'; rsNotebooks = 'Notebooks'; rsName = 'Name'; rsLastChange = 'Last Change'; rsSetupNotesDirFirst = 'Please setup a notes directory first'; rsSetupSyncFirst = 'Please config sync system first'; rsCannotFindNote = 'ERROR, cannot find '; // is followed by a filename rsSearchHint = 'Exact matches for terms between " "'; // SyncGUI rsTestingSync = 'Testing Sync'; rsUnableToSync = 'Unable to sync because '; //rsUnableToSyncAuto = 'tomboy-ng is unable to do Auto Sync at the moment.' // mention tomboy-ng 'cos user may not be activly using tb when this pops up rsRunningSync = 'Running Sync'; rsAllDone = 'All Done'; rsPressClose = 'Press Close'; rsTestingRepo = 'Testing Repository ....'; rsCreateNewRepo = 'Create a new Repository ?'; rsUnableToProceed = 'Unable to proceed because'; rsLookingatNotes = 'Looking at notes ....'; rsSaveAndSync = 'Press Save and Sync if this looks OK'; rsSyncError = 'A Sync Error occurred'; rsSyncClash = 'A Sync Clash has occurred'; rsSyncClashAdvice = 'Run the Sync from Main Menu to resolve'; rsLastSync = 'Last Sync'; // Followed by a date and simplified sync report rsFileSyncInfo1 = 'tomboy-ng uses File Sync to sync to eg DropBox, Google Drive, a USB drive'; rsFileSyncInfo2 = 'or uses a remote server over the internet with sshfs'; rsGithubSyncInfo1 = 'tomboy-ng can use Github to both sync and display or edit notes'; rsGithubSyncInfo2 = 'you should read the tomboy-ng wiki page for instructions.'; // Settings but only part ... //rsChangeNetSync = 'Change Net Sync Repo'; // These are labels on the button used to set sync repo rsChangeSync = 'Change Sync Repository'; rsSyncNotConfig = 'not configured'; // means that the file of net sync is not configured yet. rsSetUp = 'Setup'; // means configure something, eg, one of the Sync modules. rsAutosnapshotRun='Completed autosnapshot run.'; // Message on status bar after an AutoSnapshot run. rsSnapshotCreated = 'created, do you want to copy it elsewhere ?'; // refers to a just taken snapshot rsErrorCopyFile = 'Failed to copy file, does destination dir exist ?'; rsAutoSyncNotPossible = 'Auto sync not possible right now'; // Auto sync is configured but cannot proceed, probably because drive is not available rsSyncTypeFile = 'File Sync - local or shared filesystem'; rsSyncTypeGitHub = 'Github - free Github account required'; // BackUpView rsNewerVersionExits = 'A newer version exists in main repo'; rsNotPresent = 'Not present in main repo'; rsCannotDelete = 'Cannot delete '; rsOverwriteNote = 'Overwrite newer version of that note'; rsNoteAlreadyInRepo = 'Note already in Repository'; rsNoteOpen = 'You have that note open, please close and try again'; rsCopyFailed = 'Copying orig to Backup directory failed'; rsRenameFailed = 'ERROR, could not rename Backup File '; rsRecoverOK = 'OK, File recovered.'; rsNotesDeleted = 'Note or notes deleted'; // CLI -- these are command line help lines that appear when user adds --help {$ifdef DARWIN} rsMacHelp1 = 'eg open tomboy-ng.app'; rsMacHelp2 = 'eg open tomboy-ng.app --args -o Note.txt|.note'; {$endif} rsHelpDelay = 'Delay startup 2 sec to allow OS to settle'; rsHelpLang = 'Force Language, en, es, uk, fr, nl'; rsHelpDebug = 'Direct debug output to SOME.LOG.'; rsHelpHelp = 'Show this help message and exit.'; rsHelpVersion = 'Print version and exit'; //rsHelpRedHat = 'Deprecated'; // No longer important, rsHelpNoSplash = 'Do not show small status/splash window'; rsHelpDebugSync = 'Show debug messages during Sync'; rsHelpDebugIndex = 'Show debug msgs while indexing notes'; rsHelpDebugSpell = 'Show debug messages while spell setup'; rsHelpConfig = 'Create or use an alternative config'; rsHelpSingleNote = 'Open indicated note, switch is optional'; rsHelpImportFile = 'Import file into Note Directory'; rsHelpSaveExit = 'After import single note, save & exit'; rsHelpTitleIsFName = 'Use Filename as title for import txt & md'; // Mainunit rsBadNotesFound1 = 'Please go to Settings -> Recover -> Recover Notes'; rsBadNotesFound2 = 'You should do so to ensure your notes are safe.'; rsFound = 'Found'; rsNotes = 'notes'; rsWARNNOSSYSTRAY = 'WARNING, your Desktop might not display SysTray'; // R E C O V E R unit rsClickSnapShot = 'Click an Available Snapshot'; rsWeHaveSnapShots = 'We have %d snapshots'; rsDeletedDamaged = 'OK, deleted %d damaged notes'; rsBadNotes = 'You have %d bad notes in Notes Directory'; rsClickBadNote = 'Double click on any Bad Notes'; // rsNoBadNotes = 'No errors, perhaps you should proceed to Snapshots'; rsTryRecover_1 = 'Try to recover a bad note by double clicking below,'; rsTryrecover_2 = 'if that fails, you may be able to recover it from a Snapshot.'; rsDeleteAndReplace_1 = 'Notes at risk !'; rsAllRestored = 'Notes and config files Restored, restart suggested.'; rsDeleteAndReplace_2 = 'Delete all notes in %s and replace with snapshot dated %s ?'; rsNotesInSnap = 'Notes in Snapshot'; // followed by the name of a snapshot // RollBack rsContentDated = 'Content Dated'; rsNotAvailable = 'Not Available'; rsRollBackIntro = 'You can roll back to previous version of this note'; // EditBox - lots more to do .. rsFindNavRightHint = 'Find : F3 or Ctrl-G'; rsFindNavLeftHint = 'Backward Find : Shift-F3 or Shift-Ctrl-G'; rsFindNavRightHintMac = 'Find : Command-G'; rsFindNavLeftHintMac = 'Backward Find : Shift-Command-G'; rsNoOtherNotes = 'No other notes link to this one'; rsNotesLinked = 'Notes that link to this one'; // github sync - I would like to use some of these in other syncs too. rsGithubTokenExpired = 'Github Token may have expired'; rsTestingCredentials = 'Testing Credentials'; rsLookingServerID = 'Looking for ServerID'; rsScanRemote = 'Scanning remote files'; rsDownloadNotes = 'Downloading notes'; rsDownLoaded = 'Downloaded'; // followed by a number rsUpLoading = 'Uploading'; // followed by a number rsUpLoaded = 'Uploaded'; // followed by a number rsMetaDirWarning = 'Please remember that to ensure a reliable sync, you must not change files in the Meta directory.'; // tb_symbol rsEnterHexValue = 'Enter the Hexadecimal value for a UTF8 character'; rsHexCharRequired = '2, 4, 6 or 8 Hex Characters Required'; rsUTF8CharList = 'Click here to browse to full list'; implementation end. ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������tomboy-ng_0.39-1/source/backupview.pas��������������������������������������������������������������0000644�0001750�0001750�00000023117�14551457644�017610� 0����������������������������������������������������������������������������������������������������ustar �dbannon�������������������������dbannon����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������unit BackupView; { Copyright (C) 2017-2022 David Bannon License: This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html ------------------ A unit to manage the Backup capability of tomboy-ng. It allows viewing, deleting or restoring a backed up note. Note, in Tomboy speak, Backup means backup of deleted or overwritten by sync process. History 2018/07/03 Finished the recver a backup note code 2018/08/14 Update the last-metadata-change-date instead of last-change-date when restoring a Backup file. See Sync spec. 2018/08/16 We now update both last-metadata-change-date AND last-change-date when restoring a backup file. 2018/08/27 Now change the ID of a deleted (but not overwritten) Note to avoid Sync issues 2019/05/19 Display strings all (?) moved to resourcestrings 2020/05/11 Restructure to do the backup note display and fiddling here. 2020/07/25 Tweak layout and select first note if there is one shown in the list. 2022/10/28 When renaming a file, delete target if its exists first, its a windows problem 2022/10/29 Tweaks to work with revised NoteLister model and to refresh display in SearchForm after a recover. } {$mode objfpc}{$H+} interface uses Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls, Note_Lister, ResourceStr; type { TFormBackupView } TFormBackupView = class(TForm) ButtonOpen: TButton; ButtonRecover: TButton; ButtonDelete: TButton; ButtonOK: TButton; ListBox1: TListBox; Memo1: TMemo; Panel1: TPanel; procedure ButtonDeleteClick(Sender: TObject); procedure ButtonOpenClick(Sender: TObject); procedure ButtonRecoverClick(Sender: TObject); procedure FormClose(Sender: TObject; var CloseAction: TCloseAction); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure FormShow(Sender: TObject); procedure ListBox1SelectionChange(Sender: TObject; User: boolean); private BUNoteLister : TNoteLister; //ExistsInRepo : boolean; //NeedUpDate : boolean; function RefreshBackup(): integer; procedure UpdateDetails(ID: string); public //FileName : string; //NoteTitle : string; //NotesChanged : boolean; end; var FormBackupView: TFormBackupView; implementation {$R *.lfm} { TFormBackupView } uses settings, LazFileUtils, LCLType, MainUnit, // For SingleNoteMode() tb_utils, SearchUnit; // access the notelister object procedure TFormBackupView.FormCreate(Sender: TObject); begin ButtonOpen.Enabled := False; ButtonRecover.Enabled := False; ButtonDelete.Enabled := False; BUNoteLister := nil; end; procedure TFormBackupView.FormDestroy(Sender: TObject); begin BUNoteLister.Free; end; procedure TFormBackupView.FormShow(Sender: TObject); begin if RefreshBackup() = 0 then Memo1.Append('We found no backup notes') else ListBox1.ItemIndex:=0; end; function TFormBackupView.RefreshBackup() : integer; begin ListBox1.Clear; Memo1.Clear; if BUNoteLister <> nil then BUNoteLister.free; BUNoteLister := TNoteLister.Create; BUNoteLister.WorkingDir:= sett.NoteDirectory + 'Backup' + PathDelim; BUNoteLister.IndexNotes(); BUNoteLister.LoadStrings(ListBox1.Items); result := BUNoteLister.GetNoteCount(); end; procedure TFormBackUpView.UpdateDetails(ID : string); begin Memo1.Clear; Memo1.Append('Title :'); Memo1.Append(BUNoteLister.GetTitle(ID)); Memo1.Append('Filename :'); Memo1.Append(ID); Memo1.Append('Last change ' + BUNoteLister.GetLastChangeDate(ID)); if FileExistsUTF8(Sett.NoteDirectory + ID) then begin Memo1.Append(rsNewerVersionExits); //ExistsInRepo := True; end else Memo1.Append(rsNotPresent); Memo1.Append(inttostr(ListBox1.SelCount) + ' notes selected'); ButtonOpen.Enabled := (ListBox1.SelCount = 1); ButtonRecover.Enabled := (ListBox1.SelCount = 1); ButtonDelete.Enabled := (ListBox1.SelCount > 0); end; procedure TFormBackupView.ListBox1SelectionChange(Sender: TObject; User: boolean); begin UpdateDetails(string(ListBox1.Items.Objects[ListBox1.ItemIndex])); end; procedure TFormBackupView.ButtonDeleteClick(Sender: TObject); var Index : integer = 0; begin while Index < ListBox1.Count do begin if ListBox1.Selected[Index] then if not DeleteFileUTF8(Sett.NoteDirectory + 'Backup' + PathDelim + string(ListBox1.Items.Objects[Index])) then Showmessage(rsCannotDelete + Sett.NoteDirectory + 'Backup' + PathDelim + string(ListBox1.Items.Objects[Index])); inc(Index); end; RefreshBackup(); Memo1.Append(rsNotesDeleted); end; procedure TFormBackupView.ButtonOpenClick(Sender: TObject); // Note : we only allow one at a time, multiselect will disable View begin MainUnit.MainForm.SingleNoteMode(Sett.NoteDirectory + 'Backup' + PathDelim + string(ListBox1.Items.Objects[ListBox1.ItemIndex]), False, True); end; // OK, overwriting an existing file is not an issue (as long as its not open). // However, if we are looking at a note that was deleted, it might be listed in // the Local Manifest as a deleted file. That will confuse the next sync. // So, lets just give those sort of notes a new ID. procedure TFormBackupView.ButtonRecoverClick(Sender: TObject); // Note : we only allow one at a time, multiselect will disable Recover var AForm : TForm; InString : string; InFile, OutFile: TextFile; NewFName : string; GUID : TGUID; FileName : string; ExistsInRepo : boolean; // Indicates note in question is in main notes dir. begin FileName := string(ListBox1.Items.Objects[ListBox1.ItemIndex]); ExistsInRepo := FileExistsUTF8(Sett.NoteDirectory + FileName); if ExistsInRepo then if IDYES <> Application.MessageBox(pchar(rsOverwriteNote), pchar(rsNoteAlreadyInRepo), MB_ICONQUESTION + MB_YESNO) then exit(); if TheMainNoteLister.IsThisNoteOpen(FileName, AForm) then begin showmessage(rsNoteOpen); exit(); end; if ExistsInRepo then begin if FileExistsUTF8(Sett.NoteDirectory + 'Backup' + PathDelim + FileName + 'TMP') then DeleteFileUTF8(Sett.NoteDirectory + 'Backup' + PathDelim + FileName + 'TMP'); // A Windows-ism, but does no harm if not RenameFileUTF8(Sett.NoteDirectory + FileName, Sett.NoteDirectory + 'Backup' // Move target note to backup with temp name + PathDelim + FileName + 'TMP') then begin showmessage(rsCopyFailed); exit; end; end else begin // Give the a non existing note a new name so that no issues about it being in delete section of Sync Manifest. CreateGUID(GUID); NewFName := copy(GUIDToString(GUID), 2, 36) + '.note'; if FileExistsUTF8(Sett.NoteDirectory + 'Backup' + PathDelim + NewFName) then DeleteFileUTF8(Sett.NoteDirectory + 'Backup' + PathDelim + NewFName); if RenameFile(Sett.NoteDirectory + 'Backup' + PathDelim + Filename, Sett.NoteDirectory + 'Backup' + PathDelim + NewFName) then FileName := NewFName else Showmessage(rsRenameFailed + ' ' + FileName); end; // OK, if to here, user really wants it back, no reason why not. AssignFile(InFile, Sett.NoteDirectory + 'Backup' + PathDelim + Filename); // We'll copy and update dates at same time, exists or not AssignFile(OutFile, Sett.NoteDirectory + Filename); try try Reset(InFile); Rewrite(OutFile); while not eof(InFile) do begin readln(InFile, InString); if (Pos('<last-metadata-change-date>', InString) > 0) or (Pos('<last-change-date>', InString) > 0) then begin if (Pos('<last-metadata-change-date>', InString) > 0) then writeln(OutFile, ' <last-metadata-change-date>' + TB_GetLocalTime() + '</last-metadata-change-date>') else writeln(OutFile, ' <last-change-date>' + TB_GetLocalTime() + '</last-change-date>'); end else writeln(OutFile, InString); end; finally CloseFile(OutFile); CloseFile(InFile); end; TheMainNoteLister.IndexThisNote(copy(GUIDToString(GUID), 2, 36)); // why GUID, not 'Filename' ? // OK, lets deal with the copy of target that we put in backup. If ExistsInRepo then begin if FileExistsUTF8(Sett.NoteDirectory + 'Backup' + PathDelim + FileName) then DeleteFileUTF8(Sett.NoteDirectory + 'Backup' + PathDelim + FileName); if not RenameFileUTF8(Sett.NoteDirectory + 'Backup' + PathDelim + FileName + 'TMP', Sett.NoteDirectory + 'Backup' + PathDelim + FileName) then begin showmessage('Failed to move temp backup file'); end; end; //NeedUpDate := True; except on E: EInOutError do showmessage('File handling error occurred. Details: ' + E.Message); end; // reindexing triggered from FormClose RefreshBackup(); Memo1.Append(rsRecoverOK); end; procedure TFormBackupView.FormClose(Sender: TObject; var CloseAction: TCloseAction); begin SearchForm.RefreshMenus(mkRecentMenu); SearchForm.IndexNotes(True); end; end. �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������tomboy-ng_0.39-1/source/tb_utils.pas����������������������������������������������������������������0000644�0001750�0001750�00000055256�14551457644�017306� 0����������������������������������������������������������������������������������������������������ustar �dbannon�������������������������dbannon����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������unit tb_utils; { Copyright (C) 2017-2021 David Bannon License: This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html ------------------ } { A very simple unit that provides some utilities and simple Date / Time functions specificially tuned for tomboy-ng. It provides a means to convert a ISO8601 string to a TDataTime and back again with microSecond precision. Note that while the TDateTime will store it with that sort of precision, existing methods like now() are limited to milliSecond. TryISO8601ToDate() will accept no decimal places after a second or exactly three. No more or no less. So, we will pass unchanged if no decimal point, if there is one, we will remove it and process the content ourselves. A safe way to make a human readable date time string from any UTC TDateTime - var DT : TDateTime; St : string; if MyTryISO8601ToDate(DateSt, DT) then St := MyFormatDateTime(DT) else BadThingsHappened(); We could make a simpler function that just does it but I have found real problems with date strings and am inclined to be careful. ------- This unit is used in both TomboyTools and tomboy-ng, keep them in sync !!!! ------- HISTORY : 2021/01/29 Added TB_MakeFileName 2021/05/11 FindInStringList was not checking last line of list 2021/07/30 Added some methods from TT_Utils, need to merge back to TB-NG 2021/07/31 A fix to ensure that </note-content> is removed with metadata 2021/08/02 Merged back here from TomboyTools. 2021/08/27 Added the constants for multilevel bullets. 2021/10/26 User selectable date stamp format } {$mode objfpc}{$H+} interface uses Classes, SysUtils {$ifndef TESTRIG}, KMemo{$endif} ; type TReindexProcedure = procedure(const St : string; CheckTitleClash : boolean) of object; // Used by CLI to request a reindex if GUI has started. // pass 0 to MaxDateStampIndex, various datetime formats function TB_DateStamp(Index : integer) : string; // True if looks like an ID, 36 char and dash as #9 function IDLooksOK(const ID : string) : boolean; // Gets sent a string that is converted into something suitable to use as base filename function TB_MakeFileName(const Candidate : string) : string; function MyFormatDateTime(aUTCDateTime : TDateTime; HumanReadable : boolean = false) : string; // Will take a range of ISO-8601 dates and convert to DateTime, either local or UTC // Uses TryISO8601ToDate for all greater than uSec, then adds uSec back in. // If ReturnUTC is false returns local time function MyTryISO8601ToDate(DateSt : string; out OutDT : TDateTime; ReturnUTC : boolean = true) : boolean; function GetUTCOffset() : string; // returns a string with current datetime in a format like the Tomboy schema function TB_GetLocalTime: ANSIstring; // A version of MyTryISO8601ToDate that does not report errors as well. function TB_GetGMTFromStr(const DateStr: ANSIString): TDateTime; // Use whenever we are writing content that may contain <>& to XML files // If DoQuotes is true, we also convert ' and " (for xml attributes). function RemoveBadXMLCharacters(const InStr : ANSIString; DoQuotes : boolean = false) : ANSIString; // Note we restore only < > &, Tomboy does not encode " or ' in Values (but must in attributes) function RestoreBadXMLChar(const Str : AnsiString) : AnsiString; // returns a version of passed string with anything between < > removed function RemoveXml(const St : AnsiString) : AnsiString; // Returns (0-x) index of string that contains passed term, -1 if not present function FindInStringList(const StL : TStringList; const FindMe : string) : integer; // Returns (0-x) index of exact matching string in array. function FindInStringArray(const AnArray : array of string; const FindMe : string) : integer; // Passed FFN, thats <path><ID><.note> and returns the Title, munge indicates // make it suitable for use as a file name, an empty ret string indicates error function GetTitleFromFFN(FFN: string; Munge : boolean{; out LenTitle : integer}): string; procedure GetHeightWidthOfNote(FFN : string; out NHeight, NWidth : integer); // Remove all content up to and including <note-content ...> and all content // including and after </note-content>. Because we cannot guarantee that these // lines are on their own, we will need to poke into individual lines. // Maybe tolerant of gnote format. procedure RemoveNoteMetaData(STL : TStringList); function SayDebugSafe(st: string) : boolean; function TB_ReplaceFile(const SourceFile, DestFile : string) : boolean; // Escapes any double inverted commas and backslashs it finds in passed string. function EscapeJSON(St : string) : string; // Removes a NoteBook tag from a note function RemoveNoteBookTag(const FullFileName, NB : string) : boolean; (* moved to MainUnit, ALL notifications should hit mainform.ShowNotification(Msg, mS=3000) {$ifdef Linux} // Linux only uses libnotify, Win and MacOS work through TrayIcon procedure ShowNotification(const Title, Message : string; ShowTime : integer = 6000); {$endif} *) { Returns the name of the config directory (with trailing seperator) } function TB_GetDefaultConfigDir : string; // These are constants that refer to Bullet Levels, we map the KMemo names here. // Using them requires that we 'use' kmemo here. If not use'd, will still compile. // Each one MUST resolve to a different value in KMemo, do not overload. {$if declared(pnuCircleBullets)} // Defined in KMemo in later versions (mid to late 2021) const BulletOne = pnuTriangleBullets; BulletTwo = pnuBullets; BulletThree = pnuCircleBullets; BulletFour = pnuArrowOneBullets; BulletFive = pnuArrowTwoBullets; BulletSix = pnuLetterlo; BulletSeven = pnuRomanLo; BulletEight = pnuArabic; // BulletNine = pnuArabic; // Messes with case statements, 8 is our limit ! {$endif} const MaxDateStampIndex = 4; // Zero based index to date/Time Formats var TheReindexProc : TReIndexProcedure; // Set by SearchForm during create. implementation uses dateutils, {$IFDEF LCL}LazLogger, {$ENDIF} {$ifdef LINUX} Unix, {$endif} // We call a ReReadLocalTime(); laz2_DOM, laz2_XMLRead, FileUtil, LazFileUtils, Forms; const ValueMicroSecond=0.000000000011574074; // ie double(1) / double(24*60*60*1000*1000); (* moved to MainUnit, ALL notifications should hit mainform.ShowNotification(Msg, mS=3000) {$ifdef Linux} // Linux only uses libnotify, Win and MacOS work through TrayIcon procedure ShowNotification(const Title, Message : string; ShowTime : integer = 6000); {$ifndef TESTRIG} var LNotifier : PNotifyNotification; begin notify_init(argv[0]); LNotifier := notify_notification_new (pchar(Title), pchar(Message), pchar('dialog-information')); notify_notification_set_timeout(LNotifier, ShowTime); // figure is mS notify_notification_show (LNotifier, nil); notify_uninit; {$else} begin {$endif} end; {$endif} *) { Returns the name of the config directory (with trailing seperator) } function TB_GetDefaultConfigDir : string; begin Result := ''; if Application.HasOption('config-dir') then Result := Application.GetOptionValue('config-dir'); if Result = '' then begin {$ifdef DARWIN} // First we try the right place, if there use it, else try unix place, if // its not there, go back to right place. Result := GetEnvironmentVariable('HOME') + '/Library/Application Support/Tomboy-ng/Config'; if not DirectoryExistsUTF8(Result) then begin Result := GetAppConfigDirUTF8(False); if not DirectoryExistsUTF8(Result) then // must be new install, put in right place Result := GetEnvironmentVariable('HOME') + '/Library/Application Support/Tomboy-ng/Config'; end; {$else} Result := GetAppConfigDirUTF8(False); {$endif} end; Result := AppendPathDelim(Result); {$ifndef DARWIN} // MainForm.SetAltHelpPath(Result); // English help notes in read only space {$endif} end; function RemoveNoteBookTag(const FullFileName, NB : string) : boolean; var InFile, OutFile: TextFile; InString : string; begin AssignFile(InFile, FullFileName); AssignFile(OutFile, FullFileName + '-temp'); Reset(InFile); Rewrite(OutFile); while not eof(InFile) do begin readln(InFile, InString); // Note, this leaves an empty set of <tags></tags>, does that matter ? if Pos('<tag>system:notebook:' + NB + '</tag>', InString) = 0 then writeln(OutFile, InString); end; CloseFile(OutFile); CloseFile(InFile); Result := TB_ReplaceFile(FullFileName + '-temp', FullFileName); if not Result then debugln('ERROR, RemoveNoteBookTag failed to mv ' + FullFileName+ '-temp to ' + FullFileName); end; function TB_ReplaceFile(const SourceFile, DestFile : string) : boolean; begin if not FileExists(SourceFile) then exit(SayDebugSafe('TB_ReplaceFile Failed to find ' + SourceFile)); {$ifdef WINDOWS} if not DeleteFile(DestFile) then exit(SayDebugSafe('TB_ReplaceFile Failed to delete ' + DestFile)); {$endif} result := RenameFile(SourceFile, DestFile); if not Result then SayDebugSafe('TB_ReplaceFile Failed to rename ' + SourceFile + ' to ' + DestFile); end; function TB_DateStamp(Index : Integer) : string; // make sure that you adjust MaxDateStampIndex (above) if adding formats begin result := ' date error '; case Index of 0 : result := FormatDateTime(' YYYY-MM-DD hh:mm:ss ', now()); // ISO 8601, 2020-09-14 08:37 1 : result := FormatDateTime(' dddd dd mmmm YYYY hh:mm am/pm ', now()); // Monday 29 December 2021 8:37 am much of the world 2 : result := FormatDateTime(' dddd, mmmm dd, YYYY hh:mm am/pm ', now()); // Monday, December 29, 2021 8:37 am US style 3 : result := FormatDateTime(' mmmm dd, YYYY hh:mm am/pm ', now()); // January 21, 2016 8:37 am US without DOW 4 : result := FormatDateTime(' YYYY-MM-DD dddd hh:mm:ss ', now()); // Monday 2020-09-14 08:37 ISO with added DOW end; end; // Escapes any double inverted commas and backslashs it finds in passed string. function EscapeJSON(St : string) : string; begin Result := St.Replace('\', '\\', [rfReplaceAll] ); Result := Result.Replace('"', '\"', [rfReplaceAll] ); end; function IDLooksOK(const ID : string) : boolean; begin if length(ID) <> 36 then exit(false); if pos('-', ID) <> 9 then exit(false); result := True; end; // Gets sent a string that is converted into something suitable to use as base filename function TB_MakeFileName(const Candidate : string) : string; var Ch : char; begin Result := StringReplace(Candidate, #32, '_', [rfReplaceAll]); for ch in [ '/', '\', '*', '.', '#', '%', '{', '}', '?', '&' ] do Result := StringReplace(Result, Ch, '-', [rfReplaceAll]); if Result.EndsWith('-') or Result.endswith('_') then Result := Result.Remove(Result.Length-1); end; function GetUTCOffset() : string; var Off : longint; begin Off := GetLocalTimeOffset(); // We assume that we are passed a UTC time ! if (Off div -60) >= 0 then Result := '+' else Result := '-'; if abs(Off div -60) < 10 then Result := Result + '0'; Result := Result + inttostr(abs(Off div -60)) + ':'; if (Off mod 60) = 0 then Result := result + '00' else Result := Result + inttostr(abs(Off mod 60)); end; function MyFormatDateTime(aUTCDateTime : TDateTime; HumanReadable : boolean = false) : string; var mSec, Cnt : longint; Remainder : double; DT : TDateTime; St : string; begin DT := UniversalTimeToLocal(aUTCDateTime); Result := FormatDateTime('YYYY-MM-DD', DT); if HumanReadable then exit(Result + ' ' + FormatDateTime('hh:mm:ss', DT)); // Gee, that was easy ! mSec := trunc(Frac(DT) / OneMilliSecond); remainder := frac(DT) - (mSec * OneMilliSecond); Cnt := trunc((1000*remainder) / OneMilliSecond); if Cnt > 999 then Cnt := 999; // We are playing down near limits of precision St := inttostr(Cnt); while length(St) < 4 do St := St + '0'; // NOTE : I require exactly 7 decimal places, you may not ! Result := Result + 'T' + FormatDateTime('hh:mm:ss.zzz', mSec * OneMilliSecond) + St; Result := Result + GetUTCOffset(); end; function MyTryISO8601ToDate(DateSt : string; out OutDT : TDateTime; ReturnUTC : boolean = true) : boolean; var I : integer; St : string = ''; begin OutDT := 0.0; if DateSt = '' then exit(False); Result := True; I := pos('.', DateSt); // if we have decimal point, we have stuff to do. if I > 0 then begin // TryISO8601ToDate cannot handle string with decimals of a second delete(DateSt, I, 1); // Remove decimal point while I < length(DateSt) do begin if DateSt[I] in ['0'..'9'] then begin St := St + DateSt[I]; // save digits to use later delete(DateSt, I, 1); end else break; end; // The first six digits in St represent microseconds. we will stop there. while length(St) > 6 do delete(St, length(St), 1); while length(St) < 6 do St := St + '0'; end; if TryISO8601ToDate(DateSt, OutDT, ReturnUTC) then begin // WARNING - apparently this is a FPC320 only feature if I > 0 then OutDT := OutDT + (St.ToDouble() * ValueMicroSecond); // ValueMicroSecond is Regional const, eg end else result := False; // ValueMicroSecond := 1.0 / double(24*60*60*1000*1000); end; function TB_GetLocalTime: ANSIstring; // The retuned date string includes four digits at the end representing a count // of 100 picoSeconds units. We cannot get that sort of precision and who needs it but // I have realised as tomboy-ng uses the datestring as a key to check that notes // are identical during a blind sync. So, instead of making those four digits 0000 // I will add a random number, not significent for timing but a usefull increase // in certaintly. var ThisMoment : TDateTime; Res : ANSIString; Off : longint; PicoSeconds : string; begin {$ifdef LINUX} ReReadLocalTime(); // in case we are near daylight saving time changeover {$endif} ThisMoment:=Now; PicoSeconds := inttostr(random(9999)); while length(PicoSeconds) < 4 do PicoSeconds := '0' + PicoSeconds; Result := FormatDateTime('YYYY-MM-DD',ThisMoment) + 'T' // + FormatDateTime('hh:mm:ss.zzz"0000"',ThisMoment); + FormatDateTime('hh:mm:ss.zzz',ThisMoment) + PicoSeconds; Off := GetLocalTimeOffset(); if (Off div -60) >= 0 then Res := '+' else Res := '-'; if abs(Off div -60) < 10 then Res := Res + '0'; Res := Res + inttostr(abs(Off div -60)) + ':'; if (Off mod 60) = 0 then Res := res + '00' else Res := Res + inttostr(abs(Off mod 60)); Result := Result + res; end; function TB_GetGMTFromStr(const DateStr: ANSIString): TDateTime; begin MyTryISO8601ToDate(DateStr, Result, True); end; function RemoveBadXMLCharacters(const InStr : ANSIString; DoQuotes : boolean = false) : ANSIString; // Don't use UTF8 versions of Copy() and Length(), we are working bytes ! // It appears that Tomboy only processes <, > and & , we also process single and double quote. // http://xml.silmaril.ie/specials.html var //Res : ANSIString; Index : longint = 1; Start : longint = 1; begin Result := ''; while Index <= length(InStr) do begin if InStr[Index] = '<' then begin Result := Result + Copy(InStr, Start, Index - Start); Result := Result + '<'; inc(Index); Start := Index; continue; end; if InStr[Index] = '>' then begin Result := Result + Copy(InStr, Start, Index - Start); Result := Result + '>'; inc(Index); Start := Index; continue; end; if InStr[Index] = '&' then begin // debugln('Start=' + inttostr(Start) + ' Index=' + inttostr(Index)); Result := Result + Copy(InStr, Start, Index - Start); Result := Result + '&'; inc(Index); Start := Index; continue; end; if DoQuotes then begin if InStr[Index] = '''' then begin // Ahhhh how to escape a single quote ???? Result := Result + Copy(InStr, Start, Index - Start); Result := Result + '''; inc(Index); Start := Index; continue; end; if InStr[Index] = '"' then begin Result := Result + Copy(InStr, Start, Index - Start); Result := Result + '"'; inc(Index); Start := Index; continue; end; end; inc(Index); end; Result := Result + Copy(InStr, Start, Index - Start); end; // Note we restore only < > &, Tomboy does not encode " or ' in Values (but must in attributes) function RestoreBadXMLChar(const Str : AnsiString) : AnsiString; var index : longint = 1; Start : longint = 1; begin // Don't use UTF8 functions here, we are working with bytes ! Result := ''; while Index <= Length(Str) do begin if '<' = Copy(Str, Index, 4) then begin Result := Result + Copy(Str, Start, Index - Start) + '<'; inc(Index); Start := Index + 3; Continue; end; if '>' = Copy(Str, Index, 4) then begin Result := Result + Copy(Str, Start, Index - Start) + '>'; inc(Index); Start := Index + 3; Continue; end; if '&' = Copy(Str, Index, 5) then begin Result := Result + Copy(Str, Start, Index - Start) + '&'; inc(Index); Start := Index + 4; Continue; end; inc(Index); end; Result := Result + Copy(Str, Start, Index - Start); end; function RemoveXml(const St : AnsiString) : AnsiString; var X, Y : integer; FoundOne : boolean = false; begin Result := St; repeat FoundOne := False; X := Pos('<', Result); // don't use UTF8Pos for byte operations if X > 0 then begin Y := Pos('>', Result); if Y > 0 then begin Delete(Result, X, Y-X+1); FoundOne := True; end; end; until not FoundOne; Result := trim(Result); end; function FindInStringList(const StL : TStringList; const FindMe : string) : integer; var I : integer = 0; begin if Stl = nil then exit(-1); while i < StL.Count {-1} do begin if pos(FindMe, StL.strings[i]) > 0 then exit(i); inc(i); end; result := -1; end; function FindInStringArray(const AnArray : array of string; const FindMe : string) : integer; var i : integer = 0; // OK, we always start at zero begin while i < high(AnArray) do begin if FindMe = AnArray[i] then // Note, this is an exact match, not a pos() type one. exit(i); inc(i); end; result := -1; end; function SayDebugSafe(st: string) : boolean; begin {$ifdef LCL}Debugln{$else}writeln{$endif}(St); result := false; end; procedure GetHeightWidthOfNote(FFN : string; out NHeight, NWidth : integer); var Doc : TXMLDocument; Node : TDOMNode; St : string; begin if not FileExists(FFN) then begin SayDebugSafe('ERROR : GetHeightWidthOfNote : File does not exist = ' + FFN); exit(); end; NHeight := 300; NWidth := 300; ReadXMLFile(Doc, FFN); try Node := Doc.DocumentElement.FindNode('width'); St := Node.FirstChild.NodeValue; NWidth := strtointdef(St, 300); Node := Doc.DocumentElement.FindNode('height'); St := Node.FirstChild.NodeValue; NHeight := strtointdef(St, 300); finally Doc.free; end; end; function GetTitleFromFFN(FFN: string; Munge : boolean{; out LenTitle : integer}): string; var Doc : TXMLDocument; Node : TDOMNode; // Index : integer = 1; begin if not FileExists(FFN) then begin SayDebugSafe('ERROR : File does not exist = ' + FFN); exit(''); end; ReadXMLFile(Doc, FFN); try Node := Doc.DocumentElement.FindNode('title'); result := Node.FirstChild.NodeValue; finally Doc.free; end; if Munge then Result := TB_MakeFileName(Result); { begin // remove char that don't belong in a file name while Index <= length(Result) do begin if Result[Index] in [ ' ', ':', '.', '/', '\', '|', '"', '''' ] then begin Result[Index] := '_'; end; inc(Index); end; Result := copy(Result, 1, 42); // Because 42 is the meaning of life end; } if Result = '' then SayDebugSafe('Title not found' + FFN); //LenTitle := length(Result); end; // Remove all content up to and including <note-content ...> and all content // including and after </note-content>. Because we cannot guarantee that these // lines are on their own, we will need to poke into individual lines. procedure RemoveNoteMetaData(STL : TStringList); var Index, CutOff : integer; St : string; begin // First, the trailing end. Index := FindInStringList(StL, '</note-content>'); // this is the line its on but we may have content on the same line St := Stl[Index]; CutOff := pos('</note-content>', St); if CutOff <> 1 then begin delete(St, CutOff, 1000); STL.Delete(Index); STL.Insert(Index, St); inc(Index); end; // Now Get rid of the remainder. while Index < StL.Count do StL.Delete(Index); // OK, now the start of the list Index := FindInStringList(StL, '<note-content'); while Index > 0 do begin STL.Delete(0); dec(Index); end; St := STL[0]; CutOff := St.IndexOf('>', St.IndexOf('<note-content')) +1; // Zero based index ! delete(St, 1, CutOff); STL.Delete(0); STL.Insert(0, St); end; initialization TheReindexProc := nil; // Set by SearchForm during create. end. ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������tomboy-ng_0.39-1/source/notebook.lrj����������������������������������������������������������������0000644�0001750�0001750�00000005172�14551457644�017275� 0����������������������������������������������������������������������������������������������������ustar �dbannon�������������������������dbannon����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������{"version":1,"strings":[ {"hash":179900739,"name":"tnotebookpick.caption","sourcebytes":[78,111,116,101,98,111,111,107,115],"value":"Notebooks"}, {"hash":86477809,"name":"tnotebookpick.label1.caption","sourcebytes":[76,97,98,101,108,49],"value":"Label1"}, {"hash":86477811,"name":"tnotebookpick.label3.caption","sourcebytes":[76,97,98,101,108,51],"value":"Label3"}, {"hash":1339,"name":"tnotebookpick.buttonok.caption","sourcebytes":[79,75],"value":"OK"}, {"hash":77089212,"name":"tnotebookpick.button1.caption","sourcebytes":[67,97,110,99,101,108],"value":"Cancel"}, {"hash":86477810,"name":"tnotebookpick.label2.caption","sourcebytes":[76,97,98,101,108,50],"value":"Label2"}, {"hash":254720579,"name":"tnotebookpick.tabexisting.caption","sourcebytes":[69,120,105,115,116,105,110,103,32,78,111,116,101,32,66,111,111,107,115],"value":"Existing Note Books"}, {"hash":247325035,"name":"tnotebookpick.tabnewnotebook.caption","sourcebytes":[78,101,119,32,78,111,116,101,32,66,111,111,107],"value":"New Note Book"}, {"hash":52993035,"name":"tnotebookpick.label4.caption","sourcebytes":[78,97,109,101,32,111,102,32,116,104,101,32,78,101,119,32,78,111,116,101,98,111,111,107],"value":"Name of the New Notebook"}, {"hash":7656910,"name":"tnotebookpick.label5.caption","sourcebytes":[80,114,101,115,115,32,79,75,32,97,110,100,32,119,101,32,119,105,108,108,32,109,97,107,101,32,116,104,101,32,78,111,116,101,98,111,111,107,32,65,78,68,32,97,100,100,32,116,104,105,115,32,110,111,116,101,32,116,111,32,105,116,46],"value":"Press OK and we will make the Notebook AND add this note to it."}, {"hash":238759157,"name":"tnotebookpick.tabchangename.caption","sourcebytes":[67,104,97,110,103,101,32,78,111,116,101,98,111,111,107,32,78,97,109,101],"value":"Change Notebook Name"}, {"hash":140898037,"name":"tnotebookpick.label6.caption","sourcebytes":[69,120,105,115,116,105,110,103,32,78,97,109,101],"value":"Existing Name"}, {"hash":86477815,"name":"tnotebookpick.label7.caption","sourcebytes":[76,97,98,101,108,55],"value":"Label7"}, {"hash":211108725,"name":"tnotebookpick.label8.caption","sourcebytes":[78,101,119,32,78,97,109,101],"value":"New Name"}, {"hash":185852081,"name":"tnotebookpick.label9.caption","sourcebytes":[73,102,32,121,111,117,32,115,121,110,99,32,97,110,100,32,97,114,101,32,110,111,116,32,97,98,115,111,108,117,116,101,108,121,32,115,117,114,101,32,105,116,32,105,115,32,117,112,32,116,111,32,100,97,116,101,44,32,67,97,110,99,101,108,32,110,111,119,32,33],"value":"If you sync and are not absolutely sure it is up to date, Cancel now !"}, {"hash":106246915,"name":"tnotebookpick.tabsetnotes.caption","sourcebytes":[83,101,116,32,78,111,116,101,115],"value":"Set Notes"} ]} ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������tomboy-ng_0.39-1/source/Tomboy_NG.lpr���������������������������������������������������������������0000644�0001750�0001750�00000006574�14551457644�017327� 0����������������������������������������������������������������������������������������������������ustar �dbannon�������������������������dbannon����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������program Tomboy_NG; { Copyright (C) 2017-2022 David Bannon License: This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html ------------------ History 27/12/2017 - Altered order to make the settings form the main one instead of RTSearch } {$mode objfpc}{$H+} {$define TOMBOY_NG} uses {$DEFINE UseCThreads} {$IFDEF UNIX}{$IFDEF UseCThreads} cmem, cthreads, {$ENDIF}{$ENDIF} Interfaces, // this includes the LCL widgetset LCLProc, Forms, Dialogs, printer4lazarus, SearchUnit, settings, SyncGUI, Notebook, Spelling, Mainunit, BackupView, recover, Index, autostart, hunspell, sync, syncutils, ResourceStr, colours, cli, RollBack, commonmark, notenormal, transgithub, import_notes, JsonTools, kmemo2pdf, tb_symbol, fpTTF, uQt_Colors , LazVersion {$ifdef LCLGTK2} , unitywsctrls // only safe to use in gtk2, use it if we need it or not {$endif}; {$R *.res} {$if defined(LCLGTK2) and (laz_major = 3) } // defined in LazVersion unit {$define APPINDPATCH} // Note: IDE greys incorrectly {$endif} // ---------------------------------------------------------------------------- // This about reading the command line and env for instructions re TrayIcon // It applies to ONLY gtk2 and Lazarus >= 3.0.0 (confirm that) ! // ---------------------------------------------------------------------------- {$ifdef APPINDPATCH} function GetUseAppInd() : UnityWSCtrls.TUseAppIndInstruction; var EnvVar : string; begin Result := UnityWSCtrls.GlobalUseAppInd; if Application.HasOption('useappind') then begin // Command line if Application.GetOptionValue('useappind') = 'yes' then // if not set, leave it alone. Result := UseAppIndYes else if Application.GetOptionValue('useappind') = 'no' then Result := UseAppIndNo; // Anything other than yes or no is ignored end else begin EnvVar := Application.EnvironmentVariable['LAZUSEAPPIND']; // EnvironmentVariable if EnvVar = 'YES' then Result := UseAppIndYes else if EnvVar = 'NO' then Result := UseAppIndNo; end; end; {$endif} begin Application.Scaled:=True; Application.Title:='tomboy-ng'; RequireDerivedFormResource:=True; Application.Initialize; if ContinueToGUI then begin {$ifdef APPINDPATCH} {$ifdef CPUi386} // Note: unless Ayatana fix their problem, no option for Gnome users // https://github.com/AyatanaIndicators/libayatana-appindicator/issues/76 UnityWSCtrls.GlobalUseAppInd := UnityWSCtrls.UseAppIndNo; // 32bit must be a 'no'. debugln('Tomboy_NG.lpr : Deciding to set UseAppInd to no to prevent AV.'); debugln('You may over rule that with --useappind=yes to see what happens.'); {$endif} UnityWSCtrls.GlobalUseAppInd := GetUseAppInd(); // Set before creating TrayIcon {$endif} Application.CreateForm(TMainForm, MainForm); Application.CreateForm(TFormSymbol, FormSymbol); Application.CreateForm(TSett, Sett); Application.CreateForm(TSearchForm, SearchForm); Application.CreateForm(TFormSync, FormSync); Application.CreateForm(TFormColours, FormColours); Application.CreateForm(TFormRollBack, FormRollBack); Application.Run; end; end. ������������������������������������������������������������������������������������������������������������������������������������tomboy-ng_0.39-1/source/colours.pas�����������������������������������������������������������������0000644�0001750�0001750�00000010450�14551457644�017132� 0����������������������������������������������������������������������������������������������������ustar �dbannon�������������������������dbannon����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������unit colours; { Copyright (C) 2017-2020 David Bannon License: This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html ------------------ A dialog that allows setting of the colours used to display tomboy-ng notes. } {$mode objfpc}{$H+} interface uses Classes, SysUtils, kmemo, Forms, Controls, Graphics, Dialogs, StdCtrls, Buttons; type { TFormColours } TFormColours = class(TForm) ColorDialog1: TColorDialog; KMemo1: TKMemo; Label1: TLabel; Label2: TLabel; SpeedLinks: TSpeedButton; SpeedTitle: TSpeedButton; SpeedText: TSpeedButton; SpeedBackground: TSpeedButton; SpeedHighlight: TSpeedButton; SpeedDefault: TSpeedButton; SpeedCancel: TSpeedButton; SpeedOK: TSpeedButton; procedure FormCreate(Sender: TObject); procedure FormShow(Sender: TObject); procedure SpeedBackgroundClick(Sender: TObject); procedure SpeedCancelClick(Sender: TObject); procedure SpeedDefaultClick(Sender: TObject); procedure SpeedHighlightClick(Sender: TObject); procedure SpeedLinksClick(Sender: TObject); procedure SpeedOKClick(Sender: TObject); procedure SpeedTextClick(Sender: TObject); procedure SpeedTitleClick(Sender: TObject); private procedure PopulateMemo; public CTitle, CBack, CText, CHiBack, CLink : TColor; end; var FormColours: TFormColours; implementation {$R *.lfm} { TFormColours } procedure TFormColours.PopulateMemo; var TB : TKMemoTextBlock; begin KMemo1.Clear(False); KMemo1.Colors.BkGnd:= CBack; TB := KMemo1.Blocks.AddTextBlock('The Title'); TB.TextStyle.Font.Size:= 16; TB.TextStyle.Font.Color:= CTitle; //TB.TextStyle.Brush.Color:= CBack; TB.TextStyle.Font.Underline := true; KMemo1.blocks.AddParagraph(); TB := KMemo1.Blocks.AddTextBlock('Normal Text'); TB.TextStyle.Font.Size:= 11; TB.TextStyle.Font.Color:=CText; //TB.TextStyle.Brush.Color:= CBack; KMemo1.blocks.AddParagraph(); TB := KMemo1.Blocks.AddTextBlock('Some Highlight'); TB.TextStyle.Font.Size:= 11; TB.TextStyle.Font.Color:= CText; TB.TextStyle.Brush.Color:= CHiBack; KMemo1.blocks.AddParagraph(); TB := KMemo1.Blocks.AddTextBlock('And a Link'); TB.TextStyle.Font.Size:=11; TB.TextStyle.Font.UnderLine := True; TB.TextStyle.Font.Color:= CLink; //TB.TextStyle.Brush.Color:= CBack; KMemo1.blocks.AddParagraph(); TB := KMemo1.Blocks.AddTextBlock('More normal Text'); TB.TextStyle.Font.Size:=11; TB.TextStyle.Font.Color:= CText; //TB.TextStyle.Brush.Color:= CBack; KMemo1.blocks.AddParagraph(); end; procedure TFormColours.FormCreate(Sender: TObject); begin { CBack := clCream; CHiBack := clYellow; CText := clBlack; CTitle := clBlue; } end; procedure TFormColours.FormShow(Sender: TObject); begin PopulateMemo; left := (screen.Width div 2) - (width div 2); top := (screen.Height div 2) - (width div 2); end; procedure TFormColours.SpeedBackgroundClick(Sender: TObject); begin ColorDialog1.Color := CBack; if ColorDialog1.Execute then begin CBack := ColorDialog1.Color; PopulateMemo; end; end; procedure TFormColours.SpeedCancelClick(Sender: TObject); begin ModalResult := mrCancel; end; procedure TFormColours.SpeedDefaultClick(Sender: TObject); begin ModalResult := mrRetry; end; procedure TFormColours.SpeedHighlightClick(Sender: TObject); begin ColorDialog1.Color := CHiBack; if ColorDialog1.Execute then begin CHiBack := ColorDialog1.Color; PopulateMemo; end; end; procedure TFormColours.SpeedLinksClick(Sender: TObject); begin ColorDialog1.Color := CLink; if ColorDialog1.Execute then begin CLink := ColorDialog1.Color; PopulateMemo; end; end; procedure TFormColours.SpeedOKClick(Sender: TObject); begin ModalResult:=mrOK; end; procedure TFormColours.SpeedTextClick(Sender: TObject); begin ColorDialog1.Color := CText; if ColorDialog1.Execute then begin CText := ColorDialog1.Color; PopulateMemo; end; end; procedure TFormColours.SpeedTitleClick(Sender: TObject); begin ColorDialog1.Color := CTitle; if ColorDialog1.Execute then begin CTitle := ColorDialog1.Color; PopulateMemo; end; end; end. ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������tomboy-ng_0.39-1/source/tb_symbol.lrj���������������������������������������������������������������0000644�0001750�0001750�00000001471�14551457644�017445� 0����������������������������������������������������������������������������������������������������ustar �dbannon�������������������������dbannon����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������{"version":1,"strings":[ {"hash":95435100,"name":"tformsymbol.caption","sourcebytes":[83,121,109,98,111,108],"value":"Symbol"}, {"hash":5966629,"name":"tformsymbol.stringgrid1.columns[0].title.caption","sourcebytes":[84,105,116,108,101],"value":"Title"}, {"hash":5966629,"name":"tformsymbol.stringgrid1.columns[1].title.caption","sourcebytes":[84,105,116,108,101],"value":"Title"}, {"hash":93113492,"name":"tformsymbol.bitbtnrevert.caption","sourcebytes":[82,101,118,101,114,116],"value":"Revert"}, {"hash":86477809,"name":"tformsymbol.label1.caption","sourcebytes":[76,97,98,101,108,49],"value":"Label1"}, {"hash":86477810,"name":"tformsymbol.label2.caption","sourcebytes":[76,97,98,101,108,50],"value":"Label2"}, {"hash":86477811,"name":"tformsymbol.label3.caption","sourcebytes":[76,97,98,101,108,51],"value":"Label3"} ]} �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������tomboy-ng_0.39-1/source/note_lister.pas�������������������������������������������������������������0000644�0001750�0001750�00000304267�14551457644�020007� 0����������������������������������������������������������������������������������������������������ustar �dbannon�������������������������dbannon����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������unit Note_Lister; {$define TOMBOY_NG} { Copyright (C) 2017-2022 David Bannon License: This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html ------------------ A class that knows how to read a directory full of notes. It keeps those list internally, sorted by date. Note details ( Title, LastChange) can be updated (eg when a note is saved). This unit is all about maintaining a list (FPList) of all the notes. We use a threaded class, TIndexThread, to read files and initially populate the list. When saving, deleting or syncing in a note, we update the list. Templates are not added to the list. -------- Multithreaded Indexing ---------- 1. Only used for indexing all notes, when a single note is indexed, main thread. 2. The IndexNotes() method will call ThreadIndex.Start (and therfore TIndexThread.Execute) four times, passing a set of the first chars [0..9, a..f, A..F] of file names to index. TIndexThread.Execute will call GetNoteDetails for each note that Execute finds GetNoteDetails reads note, builds a data structure and, subject to critical section, adds it to the main data structure. 3. NoteBooks cleaned up etc in the IndexNotes method. 4. Four theads on a multicore cpu gives some 2 - 3 times spead up. Little slower on single core. 5. We use RTL CriticalSection code, LCL version is similar performance. 6. Using FindFirst/Next is substantually faster than FindAllFiles. Search Modes ------------ We have two Search Modes, SWYT and PressEnter. Both expect ListView to be OwnerData mode. SWYT - We have maintained at all time full content of all notes in the NoteLister unit. Two indexes, TitleSearchIndex and DataSearchIndex, all they hold (in the pointer FPList provides) is the index into NoteList. So we can sort them (and use them backwards) to get sorted data. When searching, on the first scan, we build new, probably shorter indexes and then subsquent scans remove invalid entries as user types a search term. PressEnter - is kinder on memory and not as CPU demanding. It effectivly just uses the SWYT first scan. But it has to add all note content to NoteList first and clear it when user appears to be finished searching. Uses TGetContentThread class to search. In addition, we maintain another index, DateAllIndex to be able to display notes in date listed order. Its always as long as NoteList and, like the two above, must be maintained when a note is saved, deleted, synced in etc. History 2017/11/23 - added functions to save and retreive the Form when a note is open. Also added a function to turn a fullfilename, a filename or an ID into a filename of the form GID.note 2017/11/29 Added FileName to "Note has no Title" error message. 2017/11/29 check to see if NoteList is still valid before passing on updates to a Note's status. If we are quiting, it may not be. 2017/11/29 Fixed a memory leak that occurred when Delete-ing a entry in the list Turns out you must dispose() that allocation before calling Delete. 2017/12/28 Commented out unnecessary DebugLn 2017/12/29 Added a debug line to ThisNoteIsOpen() to try and see if there is a problem there. Really don't think there is but ... 2018/01/25 Changes to support Notebooks 2018/02/14 Changed code that does Search All Notes stuff cos old code stopped on a tag 2018/02/15 Can now search case sensitive or not and any combination or exact match 2018/04/28 Set FixedRows to zero after Clean-ing strgrid, seems necessary in Trunk 2018/06/26 Used E.Message in exception generated by bad XML - dah .... 2018/07/04 Added a flag, XMLError, set if we found a note unable to index. Why ? 2018/08/24 Debugmode now set by calling process. 2018/11/04 Added support for updating NoteList after a sync. 2018/12/29 Small improvements in time to save a file. 2019/04/13 Tweaks to overload to read help nodes 2019/05/06 Support saving pos and open on startup in note. 2020/01/03 When searching without AnyCombo ticked, string can be sub-grouped by double inverted commas " 2020/01/29 Fix multiple notebook tags for same notebook in note file. Sort main list, added functions to populate MMenu Recent list. Tweek func that populates the main stringGrid avoiding initial sort 2020/01/31 LoadStringGrid*() now uses the Lazarus column mode. 2020/02/03 Make contents of strgrid look like it claims to be after new data Removed LoadSearchGrid, no use LoadStGrid in both modes. 2020/02/19 XML Escape the notebook list sent back. 2020/03/27 Better reporting on short lastchangedate string. But need an autofix. 2020/04/01 Bug fix for code that auto fixes short last-change-date. 2020/04/19 Missing $H+ caused 255 char default string, messed with RewriteBadChangeDate() 2020/05/10 Multithreaded search 2020/05/25 Don't read sett.checkcasesensitive in thread. 2020/08/01 Disable code to rewrite short lcd. 2021/01/03 LoadListView now uses TB_datetime, more tolerant of differing DT formats. 2021/02/14 Notebook list now sorted, A->z 2021/07/05 Changed a lot of "for X to 0" to "for 0 downto X" so searches start at end of list where current data is 2021/08/30 Removed dependencies on Sett and SearchUnit. Added Dump methods. Added function GetNotebooks(const ID: ANSIString): string; for GitHub 2021/08/31 Added TheNoteLister to hold a ref to the NoteLister for any unit that 'uses' this unit. 2021/09/06 GetNotebooks result now wrapped in square brackets, JSON style 2022/01/12 Trapped out some errors that occur if XML element (field) is present but blank 2022/04/14 GetNotebooks() now takes a StringArray instead of List TNoteLister.Count() removed, use TNoteLister.GetNoteCount() instead 2022/09/05 ---- Substantial Changes ---- Got rid of local global vars. Use either SWYT, Search While You Type, or PressEnter mode. All here in NoteLister SearchUnit.ListView now in ownerdata mode, faster with lots of notes. NoteList now a public var of NoteLister, other units can iterate over it. 2022/10/29 Use test, "if TheMainNoteLister = self" to ensure Index are only used by TheMainNoteLister in IndexNotes() 2022/11/09 Trap out a totally bad xml note, reasonably gracefully. } {$mode objfpc} {$H+} INTERFACE uses Classes, SysUtils, Grids, ComCtrls, Forms, FileUtil; type TLVSortMode = (smRecentUp, smRecentDown, smAATitleUp, smAATitleDown, smAllRecentUp); type PNotebook=^TNotebook; TNotebook = record Name : ANSIString; // Name of the notebook Template : ANSIString; // The FName of the Template for this Notebook, inc .note Notes : TStringList; // A list of the Fnames of notes that are members of this Notebook, inc .note. end; type { TNoteBookList } TNoteBookList = class(TList) private function Get(Index : integer) : PNoteBook; procedure RemoveNoteBook(const NBName: AnsiString); public destructor Destroy; Override; { ID of Note to be added; Name of NoteBook it should be added to. Notebook rec is created if necessary. But if IsTemplate ID is ID of a newly created Template } procedure Add(const ID, ANoteBook : ANSIString; IsTemplate : boolean); { Returns True if the passed note ID is in the passed Notebook } function IDinNotebook(const ID, Notebook : ANSIstring) : boolean; // Returns a PNoteBook that has a name matching passed NoteBook. function FindNoteBook(const NoteBook : ANSIString) : PNoteBook; { Removes any list entries that do not have a Template } procedure CleanList(); property Items[Index : integer] : PNoteBook read Get; default; end; type PNote=^TNote; TNote = record { will have 36 char GUI plus '.note' } ID : ANSIString; Title : ANSIString; { An all lower case version of Title for searching } TitleLow : string; { a 33 char date time string } CreateDate : ANSIString; { a 33 char date time string, updateable } LastChange : ANSIString; IsTemplate : boolean; OpenOnStart : boolean; OpenNote : TForm; // If note is open, its in this TForm. Content : string; // May contain note content, '' else. InSearch : boolean; // indicates note 'passed' last filter, use again end; type { ---------- TNoteList ---------} //TNoteList = class(TList) TNoteList = class(TFPList) private function Get(Index: integer): PNote; public destructor Destroy; override; function Add(ANote : PNote) : integer; function FindID(const ID: ANSIString): pNote; function FindID(out Index:integer; const ID: ANSIString): boolean; property Items[Index: integer]: PNote read Get; default; end; type { SortList - Type for DateSortList and TitleSortList, indexes into NoteList } TSortList = class(TList) // Provides a "revised index" into NoteList, sorted on either date or title private function Get(Index: integer): integer; public destructor Destroy; override; function Add(ANumber : integer) : integer; //function FindName(const Name : ANSIString) : PNote; property Items[Index: integer]: integer read Get; default; end; type { TNoteLister } TNoteLister = class private //DebugMode : boolean; CriticalSection: TRTLCriticalSection; // we use RTL CriticalSection code, the LCL version is about the same TitleSearchIndex : TSortList; // A list of Indexes into NoteList, filtered by search, sorted by Title DateSearchIndex : TSortList; // A list of Indexes into NoteList, filtered by search, sorted by Date DateAllIndex : TSortList; // An sorted on date index of all notes in NoteList (except templates) EnterDateSearchIndex : TSortList; // A list of Indexes into NoteList, filtered by Press Enter search, sorted by Date EnterTitleSearchIndex : TSortList; // A list of Indexes into NoteList, filtered by Press Enter search, sorted by Title // SearchCount : integer; // How many notes are active in search, or all notes if search not active OpenNoteIndex : integer; // Used for Find*OpenNote(), points to last found one, -1 meaning none found SearchNoteList : TNoteList; { NoteBookList is a list of pointers. Each one points to a record containing Name, Template ID and a List (called Notes) of IDs of notes that are members of this Notebook. } NoteBookList : TNoteBookList; // Passed a StringList containing 0 to n strings. Returns False if any (non empty) // string is not present in NoteList[index]^.Content. True if all present or list empty. function CheckSearchTerms(const STermList: TStringList; const Index: integer): boolean; { Returns a simple note file name, accepts simple filename or ID } function CleanFileName(const FileOrID: AnsiString): ANSIString; //procedure GetNoteDetails(const Dir, FileName: ANSIString; {const TermList: TStringList;} DontTestName: boolean=false); // Indexes one note. Always multithread mode but sometimes its only one thread. // Does require CriticalSection to be setup before calling. // If note turns out to be a template, don't add it to main note list // but still call Notebook.add to ensure its mentioned in notebook list. // We might store Content and it may. or may not be all lower case. procedure GetNoteDetails(const Dir, FileName: ANSIString; DontTestName: boolean; TheLister : TNoteLister); // Inserts a new item into the ViewList, always Title, DateSt, FileName // function NewLVItem(const LView: TListView; const Title, DateSt, FileName: string): TListItem; { A Early ver of -ng wrote a bad date stamp, here we try to fix any we find. First just try to add missing bits, if that does not work, we replace the LCD with current, and known good date.} procedure RewriteBadChangeDate(const Dir, FileName, LCD: ANSIString); public DebugMode : boolean; ThreadLock : integer; // -1 if unlocked, has value of thread when locked FinishedThreads : integer; // There are here to allow the search threads to find them. { NoteList is a list of pointers. Each one points to a record that contains data about a particular note. Only Notebook info it has is whether or not its a template. The ID is stored as a 36 char GUI plus '.note'. Dates must be 33 char. } NoteList : TNoteList; XMLError : Boolean; // Indicates a note was found with an XML (or other) error, checked by calling process. ErrorNotes : TStringList; { The directory, with trailing seperator, that the notes are in } WorkingDir : ANSIString; SearchIndex : integer; procedure DumpNoteNoteList(WhereFrom: string); // Puts name of any note that contains (case insensitive) the passed string into // the passed stringlist. Does nothing to do with sorting, order etc. // Used to get backlinks. // ToDo : At present, assumes all content loaded. procedure SearchContent(const St: string; Stl: TstringList); procedure DumpNoteBookList(WhereFrom: String); { Returns true if there is a notebook of the passed title } function IsANotebookTitle(NBTitle : string) : boolean; { Returns the Notebook Name for a given filename or ID (of the template itself)} function GetNotebookName(FileorID: AnsiString): string; { returns a indexed pointer to a Notebookrecord } function GetNoteBook(Index: integer): PNoteBook; { returns the number items in the notebook list} function NotebookCount(): integer; {Returns the number of records in the Notelist, NOT the index lists. } function GetNoteCount() : integer; { Returns a pointer to PNote record, zero based, non sorted index } function GetNote(Index: integer): PNote; { Returns a pointer to PNote record, zero based index is adjusted for current search } function GetNote(Index: integer; mode : TLVSortMode): PNote; { Loads a TListView with note title, LCD and ID} //procedure LoadListView(const LView: TListView; const SearchMode: boolean); { Changes the name associated with a Notebook in the internal data structure } function AlterNoteBook(const OldName, NewName: string): boolean; { Returns a multiline string to use in writing a notes notebook membership, knows how to do a template too. String has special XML chars 'escaped' This function expects to be passed an ID + '.note'. } function NoteBookTags(const NoteID: string): ANSIString; { Returns true if it has returned with a pointer to a list with one or more Note Fnames that are members of NBName, it returns a pointer to the internal StList, do not create or free. FNames mean ID.note ! } function GetNotesInNoteBook(out NBIDList: TStringList; const NBName: string ): boolean; { Retuns the title of note at (zero based) index. } function GetTitle(Index: integer): string; { Returns the title for a given ID or Filename } function GetTitle(const ID: String): string; { Returns the number of items in the list } // function Count(): integer; { Returns the LastChangeDate string for ID in the Notes list, empty string if not found (empty string is its a notebook) } function GetLastChangeDate(const ID: String): string; { Adds details of note of passed to NoteList } procedure IndexThisNote(const ID : String); { Returns T is ID in current list, takes 36 char GUID or simple file name } function IsIDPresent(ID : string) : boolean; { Removes the Notebook entry with ID=Template from Notebook datastructure } procedure DeleteNoteBookwithID(FileorID : AnsiString); { Returns True if passed string is the ID or short Filename of a Template } function IsATemplate(FileOrID : AnsiString) : boolean; { ID of Note to be added; Name of NoteBook it should be added to. Notebook rec is created if necessary. But if IsTemplate ID is ID of a newly created Template } procedure AddNoteBook(const ID, ANoteBook: ANSIString; IsTemplate: Boolean); { Sets the passed Notebooks as 'parents' of the passed note. Any pre existing membership will be cancelled. The list can contain zero to many notebooks. } procedure SetNotebookMembership(const ID: ansistring; const MemberList: TStringList); { If ID is empty, always returns false, puts all Notebook names in NBArray. If ID is not empty, list is filtered for only notebooks that have that ID and returns True iff the passed ID is that of a Template. A Notebook Template will have only one Notebook name in its Tags and that will be added to strlist. The StartHere template won't have a Notebook Name and therefore wont get mixed up here ???? } function GetNotebooks(out NBArray: TStringArray; const ID: ANSIString): boolean; { Rets a (JSON array like, escaped) string of Notebook names that this note is a member of. It returns an empty array if the note has no notebooks or cannot be found. If ID is a template, will send a two element array ["template', "notebook-name"]. Expects an ID.note . Result is like this ["Notebook One", "Notebook2", "Notebook"] } function NotebookJArray(const ID: ANSIString): string; { Loads the Notebook ListBox up with the Notebook names we know about. Add a bool to indicate we should only show Notebooks that have one or more notes mentioned in SearchNoteList. Call after GetNotes(Term) } procedure LoadListNotebooks(const NotebookItems: TStrings; SearchListOnly: boolean); { Adds a note to main list, ie when user creates a new note } procedure AddNote(const FileName, Title, LastChange : ANSIString); { Read the metadata from all the notes into internal data structure, this is the main "go and do it" function. Note, it uses threads and FindFirst. Does NOT generate the note Indexes because its not always needed.} function IndexNotes(DontTestName: boolean=false): longint; { Copy the internal Note data to the passed TStringGrid, empting it first. NoCols can be 2, 3 or 4 being Name, LastChange, CreateDate, ID. Special case only main List SearchMode True will get from the search list. Only used by Recover unit now. } procedure LoadStGrid(const Grid: TStringGrid; NoCols: integer; SearchMode: boolean=false); { Copy the internal Note Data to passed TStrings } procedure LoadStrings(const TheStrings : TStrings); // Returns True if its updated the internal record as indicated, // will accept either an ID or a filename. Do NOT pass a Notebook ID !} function AlterNote(ID, Change : ANSIString; Title : ANSIString = '') : boolean; { True if the passed LOWERCASE string is a valid note Title } function IsThisATitle(const Title : ANSIString) : boolean; { Returns the Form this note is open on, Nil if its not open. Take ID or FileName } function IsThisNoteOpen(const ID : ANSIString; out TheForm : TForm) : boolean; { Tells the list that this note is open, pass NIL to indicate its now closed } function ThisNoteIsOpen(const ID: ANSIString; const TheForm: TForm): boolean; { Returns true if it can find a FileName (ie ID.note) to Match this Title } function FileNameForTitle(const Title: ANSIString; out FileName : ANSIstring): boolean; procedure StartSearch(); function NextNoteTitle(out SearchTerm : ANSIString) : boolean; { removes note from int data, accepting either an ID or Filename. Because this alters the NoteList indexes, generate new Indexes from SearcUnit, not this method.} function DeleteNote(const ID : ANSIString) : boolean; { Copy the internal data about notes in passed Notebook to passed TListView for display. So, shown would be all the notes in the nominated notebook.} //procedure LoadNotebookViewList(const VL: TListView; const NotebookName: AnsiString); { Copy the internal data about notes in passed Notebook to passed TStringGrid for display. So, shown would be all the notes in the nominated notebook.} procedure LoadNotebookGrid(const Grid : TStringGrid; const NotebookName : AnsiString); { Returns the ID (inc .note) of the notebook Template, if an empty string we did not find a) the Entry in NotebookList or b) the entry had a blank template. } function NotebookTemplateID(const NotebookName : ANSIString) : AnsiString; { Returns the Form of first open note and sets internal pointer to it, Nil if none found } function FindFirstOpenNote(): TForm; { Call after FindFirstOpenNote(), it will return the next one or Nil if no more found } function FindNextOpenNote() : TForm; { Returns the ID of first note that should be opened on startup internal pointer (which is same interger as FindFirstOpenNate) to it, '' if none found } function FindFirstOOSNote(out NTitle, NID: ANSIstring): boolean; { Call after FindFirstOOSNote(), it will return the next one or '' if no more found } function FindNextOOSNote(var NTitle, NID: ANSIstring): boolean; { Ret True if we need to either rerun search search or redisplay it. Called, typically, when a note is saved. May be a new note or a note that is being updated. Will always have a new LCD, might have a new Title. The note may or may not be displayed in SearchUnit. Depending on all that, we may update Indexes, return false if nothing needs to be done, if True we will refresh displayed list or, if ReRunSearch is true, we'll re-run the current search, thus updating Search Indexes. We always update DateAllIndex.} function AlterOrAddNote(out ReRunSearch: boolean; const FFName, LCD, Title: string): boolean; // New Search methods // Continues a possible existing search with an extra char in STerm, rets number // of found items. Rewrites note indexes with only reference to Notes that pass test. // Does not do anything about Notebook, it may, or may not be already applied. // Calling process should trigger a redraw of Display. function RefineSearch(STermList: TstringList): integer; // Clears any search, returns number of notes represented in list (not inc Templates) // Rewrites NoteIndexes using all Notes // Calling process should trigger a redraw of Display. function ClearSearch() : integer; // An overload, accepts a string rather than the StringList. // Triggers a new search, may have STerm or Notebook or both, rets number of found items. // Rebuilds and sorts DateSortIndex and TitleSortIndex. // Calling process should trigger a redraw of Display. function NewSearch(STerm: string; NoteBook: string): integer; // Triggers a new search, may have STerm or Notebook or both, rets number of found items. // Rebuilds and sorts DateSortIndex and TitleSortIndex. // Calling process should trigger a redraw of Display. function NewSearch(STermList: TstringList; NoteBook: string): integer; // Returns the number of notes still active in SWYT, Search While You Type. Its // the number in NoteList or less. 0 is possible. function NoteIndexCount() : integer; // Unloads the note content from NoteList, thus saving some memory. Only used in // PressEnter search mode. procedure UnLoadContent(); { This is only called when using the "Press Enter to search" mode - triggers threads who's Execute add all the Note's content to NoteList. } function LoadContentForPressEnter(): longint; { Builds a new date sorted index refrencing all notes in NoteList for Menu builder } function BuildDateAllIndex(): integer; constructor Create; destructor Destroy; override; end; Type { ======================= GET CONTENT THREAD ========================== } TGetContentThread = class(TThread) private protected procedure Execute; override; public CaseSensitive : boolean; NoteLister : TNoteLister; // Thats the note lister that called us TIndex : integer; // Zero based count of threads ThreadBlockSize : integer; // how many files each thread processes ResultsList1, ResultsList2 : TSortList; // List to contain details of what we found, 1=date, 2=title WorkDir : String; // Dir where notes files are Term_List : TStringList; // Incoming list of terms to search for Constructor Create(CreateSuspended : boolean); end; { ======================= INDEX THREAD ========================== } type CharSet = set of char; type TGetNoteDetailsProc = procedure(const Dir, FileName: ANSIString; DontTestName: boolean; TheLister : TNoteLister) of Object; Type TIndexThread = class(TThread) private protected procedure Execute; override; public GetNoteDetailsProc : TGetNoteDetailsProc; TIndex : integer; // Zero based count of threads StartsWith : CharSet; WorkingDir : string; OneThread : boolean; // indicates its not regular UUID based notes, do single thread index TheLister : TNoteLister; Constructor Create(CreateSuspended : boolean); end; // Not in Class so that Threads can find it. function NoteContains(const TermList : TStringList; FullFileName: ANSIString; const CaseSensitive : boolean): boolean; var // This is a pointer to the MAIN notelister, its really, really global ! // Its set after lister is created in Search unit and must not be used by // any of the other units thinking its the NoteListers made for their own use. TheMainNoteLister : TNoteLister = nil; { ------------------------------------------------------------------- } { -------------------------- IMPLEMENTATION ------------------------- } { ------------------------------------------------------------------- } implementation uses laz2_DOM, laz2_XMLRead, LazFileUtils, LazUTF8, LazLogger, tb_utils, syncutils {, SearchUnit} {$ifdef TOMBOY_NG}, settings {$endif}; // project options -> Custom Options { Laz* are LCL packages, Projectinspector, double click Required Packages and add LCL } // var // Look Mum, no Globals ! // FinishedThreads : integer; // There are here to allow the search threads to find them. // ThreadLock : integer; // -1 if unlocked, has value of thread when locked // CriticalSection: TRTLCriticalSection; // we use RTL CriticalSection code, the LCL version is about the same // NoteList : TNoteList; // NO, not global ! { -------------------------------- SortList --------------------------------- } { Several TSortLists are created. They are based on FPList, the only data they store is stored in the pointer itself, cast to an integer. } function TSortList.Get(Index: integer): integer; begin {$push} {$hints off} result := PtrUInt(inherited get(Index)); {$pop} end; destructor TSortList.Destroy; begin // we have not allocated any memory for data, no need to dispose inherited Destroy; end; function TSortList.Add(ANumber: integer): integer; begin // result := inherited Add(pointer(ANumber)); // warning {$push} {$hints off} result := inherited Add(pointer(PtrUInt(ANumber))); // hint {$pop} end; // A sort function for TitleSortList function SortOnTitle(Item1: Pointer; Item2: Pointer):Integer; inline; // BE VERY CAREFULL, usable ONLY by main NoteLister var LItem1: SizeInt absolute Item1; // Superimpose an Int like thing over pointer to avoid warnings LItem2: SizeInt absolute Item2; begin if TheMainNoteLister.NoteList[Litem1]^.TitleLow = TheMainNoteLister.NoteList[Litem2]^.TitleLow then Result := 0 else if TheMainNoteLister.NoteList[LItem1]^.TitleLow > TheMainNoteLister.NoteList[LItem2]^.TitleLow then // This gives alphabetical, AA at the top Result := 1 else Result := -1; (* {$push} {$hints off} if TheMainNoteLister.NoteList[PtrUInt(item1)]^.TitleLow = TheMainNoteLister.NoteList[PtrUInt(item2)]^.TitleLow then Result := 0 else if TheMainNoteLister.NoteList[PtrUInt(item1)]^.TitleLow > TheMainNoteLister.NoteList[PtrUInt(item2)]^.TitleLow then // This gives alphabetical, AA at the top Result := 1 else Result := -1; {$pop} *) end; function SortOnDate(Item1, Item2 : Pointer):Integer; inline; // BE VERY CAREFULL, usable ONLY by main NoteLister var LItem1: SizeInt absolute Item1; LItem2: SizeInt absolute Item2; begin if TheMainNoteLister.NoteList[LItem1]^.LastChange = TheMainNoteLister.NoteList[LItem2]^.LastChange then Result := 0 else if TheMainNoteLister.NoteList[LItem1]^.LastChange > TheMainNoteLister.NoteList[LItem2]^.LastChange then // ?? This gives most recent at the top Result := 1 else Result := -1; (* {$push} {$hints off} if TheMainNoteLister.NoteList[PtrUInt(item1)]^.LastChange = TheMainNoteLister.NoteList[PtrUInt(item2)]^.LastChange then Result := 0 else if TheMainNoteLister.NoteList[PtrUInt(item1)]^.LastChange > TheMainNoteLister.NoteList[PtrUInt(item2)]^.LastChange then // ?? This gives most recent at the top Result := 1 else Result := -1; {$pop} *) end; { ================ I N D E X T H R E A D ======================= } // ToDo : much of the work here is done in GetNoteDetails, maybe it belongs in this Type ? constructor TIndexThread.Create(CreateSuspended : boolean); begin inherited Create(CreateSuspended); FreeOnTerminate := True; end; procedure TIndexThread.Execute; var Ch : char; procedure FindNoteFile(Mask : string); var Info : TSearchRec; Cnt : integer = 0; begin if FindFirst(WorkingDir + Mask, faAnyFile, Info)=0 then repeat inc(cnt); GetNoteDetailsProc(WorkingDir, Info.Name, OneThread, TheLister); //SearchForm.NoteLister.GetNoteDetails(WorkingDir, Info.Name, OneThread, TheLister); until FindNext(Info) <> 0; FindClose(Info); end; begin if OneThread then FindNoteFile('*.note') else for ch in StartsWith do FindNoteFile(Ch + '*.note'); InterLockedIncrement(TheLister.FinishedThreads); end; { ========================== SEARCH THREAD =========================== } constructor TGetContentThread.Create(CreateSuspended : boolean); begin inherited Create(CreateSuspended); FreeOnTerminate := True; end; procedure TGetContentThread.Execute; var EndBlock, I : integer; // NoteP : PNote; Doc : TXMLDocument; Node : TDOMNode; begin EndBlock := (TIndex+1)*ThreadBlockSize; if EndBlock > NoteLister.NoteList.Count then EndBlock := NoteLister.NoteList.Count; if (NoteLister.NoteList.Count - EndBlock) < ThreadBlockSize then EndBlock := NoteLister.NoteList.Count; I := TIndex * ThreadBlockSize; {if EndBlock := FileList.Count then debugln('Last Thread Endblock=' + dbgs(EndBlock)); } while (not Terminated) and (I < EndBlock) do begin if not NoteLister.NoteList[i]^.IsTemplate then begin if not FileExistsUTF8(WorkDir + NoteLister.NoteList[i]^.ID) then begin debugln('TNoteLister.TSearchThread.Execute ======== ERROR cannot find ' + WorkDir + NoteLister.NoteList[i]^.ID); exit; end; ReadXMLFile(Doc, WorkDir + NoteLister.NoteList[i]^.ID); // requires free try Node := Doc.DocumentElement.FindNode('text'); while InterlockedCompareExchange(NoteLister.ThreadLock, TIndex, -1) <> -1 do if Terminated then break; // cycle until its our turn if assigned(Node) then begin {$ifdef TOMBOY_NG} if Sett.SearchCaseSensitive then NoteLister.NoteList[i]^.Content := Node.TextContent else {$endif} NoteLister.NoteList[i]^.Content := lowercase(Node.TextContent); end else debugln('TNoteLister.TSearchThread.Execute ======== ERROR unable to find text in ' + WorkDir + NoteLister.NoteList[i]^.ID); finally InterlockedExchange(NoteLister.ThreadLock, -1); doc.free; end; end; inc(I); end; InterLockedIncrement(NoteLister.FinishedThreads); end; { ========================= N O T E B O O K L I S T ======================== } function TNoteBookList.Get(Index: integer): PNoteBook; begin Result := PNoteBook(inherited get(Index)); end; destructor TNoteBookList.Destroy; var I : Integer; begin for I := 0 to Count-1 do begin Items[I]^.Notes.free; dispose(Items[I]); end; inherited Destroy; end; procedure TNoteBookList.Add(const ID, ANoteBook: ANSIString; IsTemplate: boolean ); var NB : PNoteBook; NewRecord : boolean = False; I : integer; begin NB := FindNoteBook(ANoteBook); if NB = Nil then begin NewRecord := True; new(NB); NB^.Name:= ANoteBook; NB^.Template := ''; NB^.Notes := TStringList.Create; end; if IsTemplate then begin NB^.Template:= ID // should only happen if its a new template. end else begin // Check its not there already .... I := NB^.Notes.Count; while I > 0 do begin dec(I); if ID = NB^.Notes[i] then exit; // cannot be there if its a new entry so no leak here end; NB^.Notes.Add(ID); end; if NewRecord then inherited Add(NB); end; function TNoteBookList.IDinNotebook(const ID, Notebook: ANSIstring): boolean; var Index : longint; TheNoteBook : PNoteBook; begin Result := False; TheNoteBook := FindNoteBook(NoteBook); if TheNoteBook = Nil then exit(); for Index := 0 to TheNoteBook^.Notes.Count-1 do if ID = TheNoteBook^.Notes[Index] then begin Result := True; exit(); end; end; function TNoteBookList.FindNoteBook(const NoteBook: ANSIString): PNoteBook; var Index : longint; begin Result := Nil; for Index := 0 to Count-1 do begin if Items[Index]^.Name = NoteBook then begin Result := Items[Index]; exit() end; end; end; function TNoteLister.IsANotebookTitle(NBTitle: string): boolean; var P : PNoteBook; begin P := NoteBookList.FindNoteBook(NBTitle); result := P <> nil; end; procedure TNoteBookList.CleanList; var Index : integer = 0; begin while Index < Count do begin if Items[Index]^.Template = '' then begin Items[Index]^.Notes.free; dispose(Items[Index]); Delete(Index); end else inc(Index); end; end; // Don't think we use this method ? procedure TNoteBookList.RemoveNoteBook(const NBName: AnsiString); var Index : integer; begin for Index := 0 to Count-1 do if Items[Index]^.Name = NBName then begin Items[Index]^.Notes.free; dispose(Items[Index]); Delete(Index); break; end; debugln('ERROR, asked to remove a note book that I cannot find.'); end; // =================== DEBUG PROC ====================================== procedure TNoteLister.DumpNoteBookList(WhereFrom : String); var P : PNotebook; I : integer; begin debugln('------------ ' + WhereFrom + ' -----------'); for P in NoteBookList do begin debugln('Name=' + P^.Name); for I := 0 to P^.Notes.Count -1 do debugln(' ' + P^.Notes[I]); end; debugln('-----------------------'); end; procedure TNoteLister.DumpNoteNoteList(WhereFrom : string); var P : PNote; Pnb : PNotebook // I : integer; ;begin debugln('-----------' + WhereFrom + '------------'); for P in NoteList do begin debugln('ID=' + P^.ID + ' ' + P^.Title); debugln('CDate=' + P^.CreateDate + ' template=' + booltostr(P^.IsTemplate, true)); end; debugln('-----------------------------------------------'); for Pnb in NoteBookList do debugln('Template ID=' + Pnb^.Template + ' NB Name='+Pnb^.Name + ' and Notes are ' + Pnb^.Notes.Text); debugln('-----------------------------------------------'); end; function TNoteLister.GetNoteCount(): integer; begin result := NoteList.Count; end; { ============================== NoteLister ================================ } { ------------- Things relating to NoteBooks ------------------ } function TNoteLister.NotebookCount(): integer; begin Result := NoteBookList.Count; end; function TNoteLister.GetNoteBook(Index : integer) : PNoteBook; begin Result := NoteBookList[Index]; end; function TNoteLister.NoteBookTags(const NoteID : string): ANSIString; var NBArray : TStringArray; Index : Integer; begin Result := ''; if GetNotebooks(NBArray, NoteID) then begin // its a template Result := ' <tags>'#10' <tag>system:template</tag>'#10; if length(NBArray) > 0 then Result := Result + ' <tag>system:notebook:' + RemoveBadXMLCharacters(NBArray[0], True) + '</tag>'#10' </tags>'#10; end else if length(NBArray) > 0 then begin // its a Notebook Member Result := ' <tags>'#10; for Index := 0 to High(NBArray) do // here, we auto support multiple notebooks. Result := Result + ' <tag>system:notebook:' + RemoveBadXMLCharacters(NBArray[Index], True) + '</tag>'#10; Result := Result + ' </tags>'#10; end; end; function TNoteLister.NotebookJArray(const ID: ANSIString): string; var NBArray : TStringArray; Index : Integer; begin Result := ''; if GetNotebooks(NBArray, ID) then // its a template Result := '"template", "' + EscapeJSON(NBArray[0]) + '"' else begin // maybe its a Notebook Member for Index := 0 to high(NBArray) do // here, we auto support multiple notebooks. Result := Result + '"' + EscapeJSON(NBArray[Index]) + '", '; if Result <> '' then // will be empty if note is not member of a notebook delete(Result, length(Result)-1, 2); // remove trailing comma and space end; Result := '[' + Result + ']'; // Always return the brackets, even if empty //debugln('TNoteLister.NotebookJArray returning Notebooks jArray = ' + Result); end; function TNoteLister.GetNotesInNoteBook(out NBIDList : TStringList; const NBName : string) : boolean; var NB : PNoteBook; begin Result := True; NB := NoteBookList.FindNoteBook(NBName); if NB <> Nil then NBIDList := NB^.Notes else Result := False; end; function TNoteLister.AlterNoteBook(const OldName, NewName : string) : boolean; var NB : PNoteBook; begin Result := True; NB := NoteBookList.FindNoteBook(OldName); if NB <> nil then NB^.Name:= NewName else Result := False; end; procedure TNoteLister.AddNoteBook(const ID, ANoteBook: ANSIString; IsTemplate : Boolean); begin NoteBookList.Add(ID, ANoteBook, IsTemplate); //DumpNoteBookList('After TNoteLister.AddNoteBook'); end; (* procedure TNoteLister.LoadNotebookViewList(const VL : TListView; const NotebookName: AnsiString); var Index : integer; LCDst : string; begin VL.Clear; Index := NoteList.Count; while Index > 0 do begin dec(Index); if NotebookList.IDinNotebook(NoteList.Items[Index]^.ID, NoteBookName) then begin LCDst := NoteList.Items[Index]^.LastChange; if length(LCDst) > 11 then // looks prettier, dates are stored in ISO std LCDst[11] := ' '; // with a 'T' between date and time NewLVItem(VL, NoteList.Items[Index]^.Title, LCDst, NoteList.Items[Index]^.ID); end; end; end; *) procedure TNoteLister.LoadNotebookGrid(const Grid: TStringGrid; const NotebookName: AnsiString); var Index : integer; begin while Grid.RowCount > 1 do Grid.DeleteRow(Grid.RowCount-1); Index := NoteList.Count; while Index > 0 do begin dec(Index); if NotebookList.IDinNotebook(NoteList.Items[Index]^.ID, NoteBookName) then begin Grid.InsertRowWithValues(Grid.RowCount, [NoteList.Items[Index]^.Title, NoteList.Items[Index]^.LastChange]); end; end; end; function TNoteLister.NotebookTemplateID(const NotebookName: ANSIString): AnsiString; var Index : integer; //St : string; begin for Index := 0 to NotebookList.Count - 1 do begin //St := NotebookList.Items[Index]^.Name; if NotebookName = NotebookList.Items[Index]^.Name then begin Result := NotebookList.Items[Index]^.Template; exit(); end; end; debugln('ERROR - asked for the template for a non existing Notebook'); debugln('NotebookName = ' + Notebookname); for Index := 0 to NotebookList.Count - 1 do begin if NotebookName = NotebookList.Items[Index]^.Name then debugln('Match [' + NotebookList.Items[Index]^.Name + ']') else debugln('NO - Match [' + NotebookList.Items[Index]^.Name + ']') end; Result := ''; end; function TNoteLister.GetNotebookName(FileorID: AnsiString) : string; var Index : integer; begin for Index := 0 to NotebookList.Count - 1 do if CleanFileName(FileorID) = NotebookList.Items[Index]^.Template then exit(NotebookList.Items[Index]^.Name); //debugln('TNoteLister.GetNotebookName ALERT - asked to find a notebook name but cannot find it : ' + FileorID); // thats not an error, sometimes sync systems asks, just in case ..... result := ''; end; procedure TNoteLister.DeleteNoteBookwithID(FileorID: AnsiString); var Index : integer; begin for Index := 0 to NotebookList.Count - 1 do begin if CleanFileName(FileorID) = NotebookList.Items[Index]^.Template then begin NotebookList.Items[Index]^.Notes.free; dispose(NotebookList.Items[Index]); NotebookList.Delete(Index); exit(); end; end; debugln('TNoteLister.DeleteNoteBookwithID ERROR - asked to delete a notebook by ID but cannot find it : ' + FileorID); end; function TNoteLister.IsATemplate(FileOrID: AnsiString): boolean; var NBArray : TStringArray; begin Result := GetNotebooks(NBArray, CleanFileName(FileOrID)); end; procedure TNoteLister.SetNotebookMembership(const ID : ansistring; const MemberList : TStringList); var Index, BookIndex : integer; begin // First, remove any mention of this ID from data structure for Index := 0 to NotebookList.Count - 1 do begin BookIndex := 0; while BookIndex < NotebookList.Items[Index]^.Notes.Count do begin if ID = NotebookList.Items[Index]^.Notes[BookIndex] then NotebookList.Items[Index]^.Notes.Delete(BookIndex); inc(BookIndex); end; end; // Now, put back the ones we want there. for BookIndex := 0 to MemberList.Count -1 do for Index := 0 to NotebookList.Count - 1 do if MemberList[BookIndex] = NotebookList.Items[Index]^.Name then begin NotebookList.Items[Index]^.Notes.Add(ID); break; end; end; procedure TNoteLister.LoadListNotebooks(const NotebookItems : TStrings; SearchListOnly : boolean); var Index : integer; function FindInSearchList(NB : PNoteBook) : boolean; var X : integer = 0; begin result := true; if Nil = SearchNoteList then exit; while X < NB^.Notes.Count do begin if Nil <> SearchNoteList.FindID(NB^.Notes[X]) then exit; inc(X); end; result := false; end; begin NoteBookItems.Clear; for Index := 0 to NotebookList.Count - 1 do begin if (not SearchListOnly) or FindInSearchList(NotebookList.Items[Index]) then begin NotebookItems.Add(NotebookList.Items[Index]^.Name); //NotebookGrid.InsertRowWithValues(NotebookGrid.RowCount, [NotebookList.Items[Index]^.Name]); end; end; end; function TNoteLister.GetNotebooks(out NBArray: TStringArray; const ID: ANSIString): boolean; var Index, I : Integer; Cnt : Integer = 0; begin Result := false; Setlength(NBArray, 0); Setlength(NBArray, NoteBookList.Count); // Cannot be more than that for Index := 0 to NoteBookList.Count -1 do begin // look at each NoteBook, one by one if ID = '' then NBArray[Index] := NotebookList.Items[Index]^.Name else begin if ID = NotebookList.Items[Index]^.Template then begin // The passed ID is the ID of a Template itself, not a note. // debugln('Looks like we asking about a template ' + ID); //if length(NBArray) > 0 then // debugln('Error, seem to have more than one Notebook Name for template ' + ID); Setlength(NBArray, 1); // truncate after first entry NBArray[0] := NotebookList.Items[Index]^.Name; exit(True); end; // OK, if its not a Template, its a note, what notebooks is it a member of ? // Each NotebookList item has a list of the notes that are members of that item. // if the ID is mentioned in the items note list, copy name to Array. // Iterate over the Notes list associated with this particular Notebook entry. for I := 0 to NotebookList.Items[Index]^.Notes.Count -1 do if ID = NotebookList.Items[Index]^.Notes[I] then begin NBArray[Cnt] := NotebookList.Items[Index]^.Name; inc(Cnt); // debugln('TNoteLister.GetNotebooks Insert ' + NotebookList.Items[Index]^.Name); end; end; end; // if we are still here, its either ID='' or ID is that of a note, not a notebook if ID <> '' then setlength(NBArray, Cnt); // almost certainly less than we set above. (* debugln('TNoteLister.GetNotebooks ID = ' + ID); debugln('TNoteLister.GetNotebooks LENGTH ' + inttostr(length(NBArray))); debugln('TNoteLister.GetNotebooks HIGH ' + inttostr(high(NBArray))); for i := 0 to high(NBArray) do debugln('TNoteLister.GetNotebooks Array ' + NBArray[i]); *) end; { -------------- Things relating to Notes -------------------- } // Address of this function is passed to note list sort. Newest notes at end of list. (*function LastChangeSorter( Item1: Pointer; Item2: Pointer) : Integer; begin // test its way of comparing before trashing ! // Also ANSICompareStr but we are just looking at date numbers here result := CompareStr(PNote(Item1)^.LastChange, PNote(Item2)^.LastChange); end; *) function NotebookSorter( Item1 : pointer; Item2 : pointer) : integer; begin result := CompareStr(PNoteBook(Item1)^.Name, PNoteBook(Item2)^.Name); end; procedure TNoteLister.RewriteBadChangeDate(const Dir, FileName, LCD : ANSIString); var InFile, OutFile: TextFile; InString, NewLCD : String; {$ifdef WINDOWS} ErrorMsg : ANSIString; {$endif} begin // Bad format looks like this 2020-03-06 21:25:18 // But it Should be like this 2020-02-15T12:07:41.0000000+00:00 AssignFile(InFile, Dir + FileName); AssignFile(OutFile, Dir + Filename + '-Dated'); try try Reset(InFile); Rewrite(OutFile); while not eof(InFile) do begin readln(InFile, InString); if (Pos('<last-change-date>', InString) > 0) then if length(LCD) = 19 then begin NewLCD := LCD + copy(TB_GetLocalTime(), 20, 14); NewLCD[11] := 'T'; writeln(OutFile, ' <last-change-date>' + NewLCD + '</last-change-date>'); end else begin writeln(OutFile, ' <last-change-date>' + TB_GetLocalTime() + '</last-change-date>'); end else writeln(OutFile, InString); end; finally CloseFile(OutFile); CloseFile(InFile); end; except on E: EInOutError do begin debugln('File handling error occurred updating clean note location. Details: ' + E.Message); exit; end; end; {$ifdef WINDOWS} if FileExists(Dir + FileName) then // will not be there if its a new note. if not SafeWindowsDelete(Dir + FileName, ErrorMsg) then // In syncutils, maybe over kill but ...... exit; {$endif} RenameFileUTF8(Dir + Filename + '-Dated', Dir + FileName); // Unix ok to over write, windows is not ! end; procedure TNoteLister.GetNoteDetails(const Dir, FileName: ANSIString; DontTestName : boolean; TheLister : TNoteLister); // This is how we search for XML elements, attributes are different. // Note : we used to do seaching here as well as indexing, now just indexing // Note that this method is not Multithread aware, calling method must setup // CriticalSection even if it is single threaded. var NoteP : PNote; Doc : TXMLDocument; Node : TDOMNode; J : integer; PossibleError : string = ''; begin // if FileName[1] = '1' then exit; // ToDo : remove if DebugMode then debugln('TNoteLister.GetNoteDetails - indexing ' + Dir + FileName); if not DontTestName then if not IDLooksOK(copy(FileName, 1, 36)) then begin // In syncutils !!!! EnterCriticalSection(CriticalSection); try ErrorNotes.Append(FileName + ', ' + 'Invalid ID in note filename'); XMLError := True; finally LeaveCriticalSection(CriticalSection); end; exit; end; if FileExistsUTF8(Dir + FileName) then begin new(NoteP); NoteP^.IsTemplate := False; NoteP^.ID:=FileName; try ReadXMLFile(Doc, Dir + FileName); except on E: EXMLReadError do begin //debugln('GetNoteDetails - XMLReadError ' + E.ErrorMessage); //debugln('GetNoteDetails - Invalid XML in ' + Dir + FileName); EnterCriticalSection(CriticalSection); try ErrorNotes.Append(FileName + ', ' + E.ErrorMessage); XMLError := True; finally LeaveCriticalSection(CriticalSection); end; Doc.Free; Dispose(NoteP); exit; end; end; try try Node := Doc.DocumentElement.FindNode('title'); if not assigned(Node.FirstChild) then PossibleError := 'XML ERROR, blank Title'; // Catch it as an EObjectException further down // If title is blank, next line will trigger a EObjectCheck Exception. NoteP^.Title := Node.FirstChild.NodeValue; // This restores & etc. NoteP^.TitleLow := lowercase(NoteP^.Title); //if DebugMode then Debugln('Title is [' + Node.FirstChild.NodeValue + '] ID is ' + FileName); Node := Doc.DocumentElement.FindNode('last-change-date'); if not assigned(Node.FirstChild) then PossibleError := 'XML ERROR, blank last-change-date'; // Catch it as an EObjectException further down NoteP^.LastChange := Node.FirstChild.NodeValue; {if (length(NoteP^.LastChange) <> 33) or (length(NoteP^.LastChange) <> 27) then begin RewriteBadChangeDate(Dir, FileName, NoteP^.LastChange); inc(TryCount); if TryCount > 2 then begin debugln('Failed to fix bad last-change-date in ' + NoteP^.Title); break; // sad but life must go on. end; Doc.free; end else break; until false; } if DontTestName or (not Sett.AutoSearchUpdate) then NoteP^.Content := '' // silly to record content for, eg, help notes. else begin Node := Doc.DocumentElement.FindNode('text'); if assigned(Node) then begin {$ifdef TOMBOY_NG} if Sett.SearchCaseSensitive then NoteP^.Content := Node.TextContent else {$endif} NoteP^.Content := lowercase(Node.TextContent); end else debugln('TNoteLister.GetNoteDetails ======== ERROR unable to find text in ' + FileName); end; (* if DontTestName or (not Sett.AutoSearchUpdate) then NoteP^.Content := '' // silly to record content for, eg, help notes. else begin Node := Doc.DocumentElement.FindNode('text'); if assigned(Node) then begin {$ifdef TOMBOY_NG} if Sett.SearchCaseSensitive then // Should we have a wrapper ifdef TOMBOY_NG ?? NoteP^.Content := Node.TextContent else {$endif} NoteP^.Content := lowercase(Node.TextContent); end else debugln('TNoteLister.GetNoteDetails ======== ERROR unable to find text in ' + FileName); end; *) // Crazy, why this block twice ?? NoteP^.OpenNote := nil; NoteP^.InSearch := True; Node := Doc.DocumentElement.FindNode('create-date'); if not assigned(Node.FirstChild) then PossibleError := 'XML ERROR, blank create-date'; // Catch it as an EObjectException further down NoteP^.CreateDate := Node.FirstChild.NodeValue; try // this because GNote leaves out 'open-on-startup' ! Node := Doc.DocumentElement.FindNode('open-on-startup'); if Node = nil then NoteP^.OpenOnStart:= False else NoteP^.OpenOnStart:= (Node.FirstChild.NodeValue = 'True'); except on E: EObjectCheck do NoteP^.OpenOnStart:= False; end; Node := Doc.DocumentElement.FindNode('tags'); if Assigned(Node) then begin for J := 0 to Node.ChildNodes.Count-1 do if UTF8pos('system:template', Node.ChildNodes.Item[J].TextContent) > 0 then NoteP^.IsTemplate := True; for J := 0 to Node.ChildNodes.Count-1 do if UTF8pos('system:notebook', Node.ChildNodes.Item[J].TextContent) > 0 then begin EnterCriticalSection(CriticalSection); try TheLister.NoteBookList.Add(Filename, UTF8Copy(Node.ChildNodes.Item[J].TextContent, 17, 1000), NoteP^.IsTemplate); finally LeaveCriticalSection(CriticalSection); end; // debugln('Notelister #691 ' + UTF8Copy(Node.ChildNodes.Item[J].TextContent, 17,1000)); end; // Node.ChildNodes.Item[J].TextContent) may be something like - // * system:notebook:DavosNotebook - this note belongs to DavosNotebook // * system:template - this note is a template, if does not also have a // Notebook tag its the StartHere note, otherwise its the Template for // for the mentioned Notebook. end; except on E: EXMLReadError do begin // Invalid XML EnterCriticalSection(CriticalSection); try DebugLn('XML ERROR ' + E.Message); Debugln('Offending File ' + Dir + FileName); XMLError := True; dispose(NoteP); TheLister.ErrorNotes.Append(FileName + ', ' + E.Message); finally LeaveCriticalSection(CriticalSection); end; exit(); end; on E: EObjectCheck do begin // Triggered by, valid xml but empty field accessed EnterCriticalSection(CriticalSection); try DebugLn('XML ERROR ' + E.Message + ' - ' + PossibleError); Debugln('Offending File ' + Dir + FileName); XMLError := True; dispose(NoteP); TheLister.ErrorNotes.Append(FileName + ', ' + E.Message + ' - ' + PossibleError); finally LeaveCriticalSection(CriticalSection); end; exit(); end; on E: EAccessViolation do begin // I don't think we see this happen, but just in case EnterCriticalSection(CriticalSection); try DebugLn('Access Violation ' + E.Message); Debugln('Offending File ' + Dir + FileName); XMLError := True; dispose(NoteP); TheLister.ErrorNotes.Append(FileName + ', ' + E.Message); finally LeaveCriticalSection(CriticalSection); end; exit(); end; end; if NoteP^.IsTemplate then begin // Don't show templates in normal note list dispose(NoteP); exit(); end; EnterCriticalSection(CriticalSection); try NoteList.Add(NoteP); finally LeaveCriticalSection(CriticalSection); end; finally Doc.free; end; end else DebugLn('Error, found a note and lost it ! ' + Dir + FileName); end; procedure TNoteLister.IndexThisNote(const ID: String); // While not using threads, this method must init critical section because GetNoteDetails expects it. // This is used to index imported, newly download synced notes and newly recovered (from backup) notes. begin //DebugMode := True; //debugln('TNoteLister.IndexThisNote'); InitCriticalSection(CriticalSection); // ToDo : how hard would this be to do in background thread ? GetNoteDetails(WorkingDir, CleanFileName(ID), false, self); // while single call, must setup critical DoneCriticalSection(CriticalSection); //DebugMode := False; end; function TNoteLister.GetLastChangeDate(const ID: String) : string; var index : integer; FileName : string; eStr : string = ''; begin Result := ''; if not assigned(NoteList) then exit(''); FileName := CleanFileName(ID); //for Index := 0 to NoteList.Count -1 do for Index := NoteList.Count -1 downto 0 do if NoteList.Items[Index]^.ID = FileName then begin exit(NoteList.Items[Index]^.LastChange); // debugln('NoteLister #759 from list ' + NoteList.Items[Index]^.LastChange); end; // if to here, did not find that ID in Notes List. I wonder if its a Notebook ? if FileExists(WorkingDir + ID + '.note') then begin Result := GetNoteLastChangeSt(WorkingDir + ID + '.note', EStr); if EStr <> '' then DebugLn('TGithubSync.LocalLastChangeDate - detected error in ' + ID); end; end; function TNoteLister.GetTitle(const ID: String) : string; var index : integer; FileName : string; begin Result := ''; if not assigned(NoteList) then exit(''); FileName := CleanFileName(ID); for Index := NoteList.Count -1 downto 0 do //for Index := 0 to NoteList.Count -1 do if NoteList.Items[Index]^.ID = FileName then exit(NoteList.Items[Index]^.Title); end; function TNoteLister.IsIDPresent(ID: string): boolean; var FileName : string; index : integer; begin Result := False; FileName := CleanFileName(ID); for Index := NoteList.Count -1 downto 0 do //for Index := 0 to NoteList.Count -1 do if NoteList.Items[Index]^.ID = FileName then exit(True); end; function TNoteLister.FindFirstOpenNote(): TForm; begin OpenNoteIndex:=0; while OpenNoteIndex < NoteList.Count do if NoteList.Items[OpenNoteIndex]^.OpenNote <> nil then exit(NoteList.Items[OpenNoteIndex]^.OpenNote) else inc(OpenNoteIndex); result := nil; OpenNoteIndex := -1; end; function TNoteLister.FindNextOpenNote(): TForm; begin if OpenNoteIndex < 0 then exit(Nil); inc(OpenNoteIndex); while OpenNoteIndex < NoteList.Count do if NoteList.Items[OpenNoteIndex]^.OpenNote <> nil then exit(NoteList.Items[OpenNoteIndex]^.OpenNote) else inc(OpenNoteIndex); result := nil; OpenNoteIndex := -1; end; function TNoteLister.FindFirstOOSNote(out NTitle, NID : ANSIstring): boolean; begin OpenNoteIndex:=0; while OpenNoteIndex < NoteList.Count do if NoteList.Items[OpenNoteIndex]^.OpenOnStart then begin NTitle := NoteList.Items[OpenNoteIndex]^.Title; NID := NoteList.Items[OpenNoteIndex]^.ID; exit(True) end else inc(OpenNoteIndex); result := False; OpenNoteIndex := -1; end; function TNoteLister.FindNextOOSNote(var NTitle, NID : ANSIstring): boolean; begin if OpenNoteIndex < 0 then exit(False); inc(OpenNoteIndex); while OpenNoteIndex < NoteList.Count do if NoteList.Items[OpenNoteIndex]^.OpenOnStart then begin NTitle := NoteList.Items[OpenNoteIndex]^.Title; NID := NoteList.Items[OpenNoteIndex]^.ID; exit(True) end else inc(OpenNoteIndex); result := False; OpenNoteIndex := -1; end; // ----------------- Search Related Methods ----------------------------------- function TNoteLister.RefineSearch(STermList: TstringList): integer; //var // T1, T2, T3, T4, T5 : qword; begin // We remove from the indexes any entries that correspond to NoteList entries // that don't match the passed search term. //T1 := GetTickCount64(); result := 0; // Iterate over the Index, for each entry, the value stored is the index into NoteList while result < TitleSearchIndex.Count do begin if not CheckSearchTerms(STermList, TitleSearchIndex[result]) then TitleSearchIndex.Delete(result) else inc(result); end; result := 0; //T2 := GetTickCount64(); while result < DateSearchIndex.count do begin if not CheckSearchTerms(STermList, DateSearchIndex[result]) then // ToDo : value to be had in seperate threads ? DateSearchIndex.Delete(result) else inc(result); end; //T3 := GetTickCount64(); //debugln('TNoteLister.RefineSearch() ' + inttostr(T2-T1) + 'mS ' + inttostr(T3-T2) + 'mS'); end; function TNoteLister.BuildDateAllIndex() : integer; var i : integer; begin Result := 0; if DateAllIndex = nil then DateAllIndex := TSortList.Create else DateAllIndex.Clear; for i := 0 to NoteList.Count-1 do begin if not NoteList[i]^.IsTemplate then begin DateAllIndex.Add(i); inc(Result); end; end; DateAllIndex.sort(@SortOnDate); end; { This should ret the number of items, not the zero based index of the last item. So, if we do '0', one pass, it should ret 1 If the list is empty, ret 0; } function TNoteLister.ClearSearch(): integer; var i : integer; //T1, T2, T3, T4, T5, T6 : qword; begin //T1 := GetTickCount64(); //DumpNoteNoteList('Called from ClearSearch'); result := 0; if TitleSearchIndex = nil then TitleSearchIndex := TSortList.Create else TitleSearchIndex.Clear; if DateSearchIndex = nil then DateSearchIndex := TSortList.Create else DateSearchIndex.Clear; for i := 0 to NoteList.Count-1 do begin if not NoteList[i]^.IsTemplate then begin TitleSearchIndex.add(i); DateSearchIndex.Add(i); inc(Result); end; end; //T2 := GetTickCount64(); TitleSearchIndex.sort(@SortOnTitle); //T3 := GetTickCount64(); DateSearchIndex.sort(@SortOnDate); // Ends up with the most recent at the bottom of list //T4 := GetTickCount64(); { debugln('TNoteLister.ClearSearch() build=' + inttostr(T2-T1) + 'mS Tsort=' + inttostr(T3-T2) + 'mS DSort=' + inttostr(T4-T3) ); debugln('Top ' + ' ' + NoteList[TitleSearchIndex[0]]^.LastChange); debugln('Bot ' + ' ' + NoteList[TitleSearchIndex[TitleSearchIndex.Count-1]]^.LastChange); } // debugln('TNoteLister.ClearSearch() returning ' + inttostr(REsult) + ' and ' + inttostr(NoteList.Count)); end; function TNoteLister.CheckSearchTerms(const STermList : TStringList; const Index : integer) : boolean; inline; var St : string; begin // if NoteList[index]^.Title = 'tomboy-ng Release Process' then // debugln('TNoteLister.CheckSearchTerms - found tomboy-ng Release Process'); for St in STermList do begin if St = '' then continue; if pos(St, NoteList[index]^.Content) = 0 then exit(False); end; result := true; end; function TNoteLister.NewSearch(STerm : string; NoteBook: string): integer; var STL : TStringList; begin STL := TStringList.Create; if not ((STerm = '') {or (STerm = rsMenuSearch)}) then // else we pass an empty list if no valid search term if Sett.SearchCaseSensitive then STL.AddDelimitedtext(STerm, ' ', false) else STL.AddDelimitedtext(lowercase(STerm), ' ', false); result := NewSearch(STL, NoteBook); STL.Free; end; { NewSearch can be called in three modes - Just STermList, Just a Notebook, or Both. Not neither. } function TNoteLister.NewSearch(STermList : TstringList; NoteBook: string): integer; var NBStrL : TStringList = nil; // gets set to a pre-existing list, dont create or free ! //T1, T2, T3, T4, T5 : qword; // St : string; function SearchNoteBook() : integer; var i, j : integer; begin result := 0; j:= 0; if GetNotesInNoteBook(NBStrL, NoteBook) then begin // check each line in NBStrL for this note instance while j < NBStrL.Count do begin if NoteList.FindID(i, NBStrL[j]) then begin // this the time consuming part. 4mS 2000 notes if CheckSearchTerms(STermList, i) then begin TitleSearchIndex.add(i); DateSearchIndex.Add(i); inc(Result); end; inc(j); end; end; end; end; function OnlySTerm() : integer; var ii : integer; begin result := 0;; for ii := 0 to NoteList.Count-1 do begin if not CheckSearchTerms(STermList, ii) then continue; if not NoteList[ii]^.IsTemplate then begin TitleSearchIndex.add(ii); DateSearchIndex.Add(ii); inc(Result); end; end; end; begin // debugln('TNoteLister.NewSearch() STerm=' + STermList.Text + ' >> ' + NoteBook); //T1 := GetTickCount64(); TitleSearchIndex.Clear; DateSearchIndex.Clear; TitleSearchIndex.Capacity := NoteList.Count; DateSearchIndex.Capacity := NoteList.Count; //T2 := GetTickCount64(); if (NoteBook <> '') then Result := SearchNoteBook() else Result := OnlySTerm(); // TitleSearchIndex.pack(); // Causes an unidentified crash after GTK loop resumes.... // DateSearchIndex.pack(); //T3 := GetTickCount64(); TitleSearchIndex.sort(@SortOnTitle); // ToDo : running each sort in its own thread ? //T4 := GetTickCount64(); DateSearchIndex.sort(@SortOnDate); //T5 := GetTickCount64(); {debugln('TNoteLister.NewSearch() clear=' + inttostr(T2-T1) + 'mS Search=' + inttostr(T3-T2) + 'mS ' + ' TSort=' + inttostr(T4-T3) + ' mS DSort=' + inttostr(T5-T4) + ' ' + inttostr(TitleSearchIndex.Count)); } (* debugln('as above -- ' + STermList.text + ' -- ' + Notebook); for St in STermList do debugln('TNoteLister.NewSearch() STermList Item [' + St + ']'); debugln('as above -- content >> ' + copy(NoteList[0]^.Content, 50, 1)); *) { debugln(' TNoteLister.NewSearch() Top Index=' + NoteList[DateSearchIndex[0]]^.LastChange); debugln(' TNoteLister.NewSearch Botton Index=' + NoteList[DateSearchIndex[DateSearchIndex.Count - 1]]^.LastChange); } end; function TNoteLister.NoteIndexCount(): integer; begin if TitleSearchIndex = nil then result := 0 else result := TitleSearchIndex.Count; end; // Pass this function a TStringList each line of which must be matched for a 'hit' // Moved out of class so that the threaded search can find and use it. function NoteContains(const TermList : TStringList; FullFileName: ANSIString; const CaseSensitive : boolean): boolean; var SLNote : TStringList; I, Index : integer; begin Result := False; SLNote := TStringList.Create; SlNote.LoadFromFile(FullFileName); for Index := 0 to SLNote.Count - 1 do SLNote.Strings[Index] := RemoveXML(SLNote.Strings[Index]); for I := 0 to TermList.Count -1 do begin // Iterate over search terms Result := False; for Index := 0 to SLNote.Count - 1 do begin // Check each line of note for a match against current word. if CaseSensitive then begin if (UTF8Pos(TermList.Strings[I], SLNote.Strings[Index]) > 0) then begin Result := True; break; end; end else if (UTF8Pos(UTF8LowerString(TermList.Strings[I]), UTF8LowerString(SLNote.Strings[Index])) > 0) then begin Result := True; break; end; end; if not Result then break; // if failed to turn Result on for first word, no point in continuing end; // when we get here, if Result is true, run finished without a fail. FreeandNil(SLNote); end; { With 2000 notes, on my Dell, linux, search for 'and'. Before multithreading - 250mS - 280mS With Multithreading, cthreads and cmem - 6 : 90ms to 110ms; 4 : 100mS - 134ms; 3 : 110ms - 130mS; 2 : 155ms - 180ms; 1 : 255ms - 280mS However, noted on Windows Vista (!), significent slow down ! Windows10, similar to Linux Under new search model, August 2022, down to 68mS ! } const ThreadCount = 3; // The number of extra threads set searching. 3 seems reasonable... procedure TNoteLister.UnLoadContent(); var P : PNote; begin for P in NoteList do P^.Content := ''; end; function TNoteLister.LoadContentForPressEnter() : longint; var //P : PNote; ThreadIndex : integer = 0; SearchThread : TGetContentThread; begin if EnterDateSearchIndex = Nil then EnterDateSearchIndex := TSortList.Create else EnterDateSearchIndex.Clear; if EnterTitleSearchIndex = Nil then EnterTitleSearchIndex := TSortList.Create else EnterTitleSearchIndex.clear; // for P in NoteList do begin FinishedThreads := 0; ThreadLock := -1; while ThreadIndex < ThreadCount do begin SearchThread := TGetContentThread.Create(True); // Threads clean themselves up. SearchThread.NoteLister := self; SearchThread.ThreadBlockSize := NoteList.Count div ThreadCount; // SearchThread.Term_List := Terms; SearchThread.WorkDir := WorkingDir; //SearchThread.ResultsList1 := EnterDateSearchIndex; //SearchThread.ResultsList2 := EnterTitleSearchIndex; SearchThread.TIndex := ThreadIndex; {$ifdef TOMBOY_NG} //SearchThread.CaseSensitive := Sett.SearchCaseSensitive; {$endif} SearchThread.start(); inc(ThreadIndex); end; while FinishedThreads < ThreadCount do sleep(1); // ToDo : some sort of 'its taken too long ..." // SearchNoteList.Sort(@LastChangeSorter); // end; EnterDateSearchIndex.sort(@SortOnDate); EnterTitleSearchIndex.sort(@SortOnTitle); result := EnterDateSearchIndex.Count; end; procedure TNoteLister.SearchContent(const St : string; Stl : TstringList); // St is Title of note asking for search. We seach all note's content for St but it must surrounded by suitable deliminators // Hard to see this method used for anything else var i, TitleL, Offset, FoundIndex, CLen : integer; Title : string; begin TitleL := length(St); for i := 0 to NoteList.Count -1 do begin Title := NoteList.Items[i]^.TitleLow; if St = Title then Continue; CLen := length(NoteList.Items[i]^.Content); FoundIndex := 0; // ToDo : Done but confirm - NoteContent is always lowercase, don't bother to lowercase() it here. Offset := 0; while ((Offset+TitleL) < CLen) and (FoundIndex > -1) do begin // loop over Content, break out if found a hit or got to end // FoundIndex := (lowercase(NoteList.Items[i]^.Content)).IndexOf(St, Offset); // Zero base result. -1 if not present FoundIndex := (NoteList.Items[i]^.Content).IndexOf(St, Offset); // Zero base result. -1 if not present if FoundIndex > -1 then begin // FoundIndex cannot be zero, that would be title, checked above // debugln('TNoteLister.SearchContent target=' + copy(NoteList.Items[i]^.Content, FoundIndex+1, TitleL)); // debugln('FoundIndex=' + inttostr(FoundIndex) + ' CLen=' + inttostr(CLen)); // debugln('ch-before=' + (NoteList.Items[i]^.Content)[FoundIndex]); // debugln('ch-after=' + (NoteList.Items[i]^.Content)[FoundIndex+TitleL+1]); if ((NoteList.Items[i]^.Content)[FoundIndex] in [' ', #10, ',', '.']) // char before potential target and (((FoundIndex+TitleL) = CLen) // nothing in note after link content or ((NoteList.Items[i]^.Content)[FoundIndex+TitleL+1] in [#10, ' ', ',', '.'])) then // char after potential target begin Stl.Add(NoteList.Items[i]^.Title); FoundIndex := -1; // force our way out of inner loop continue; // On to the next title end; end; // Nothing to see here folks. OffSet := Offset + FoundIndex + 1; // +1 to move past just tested one end; end; end; procedure TNoteLister.AddNote(const FileName, Title, LastChange : ANSIString); var NoteP : PNote; begin new(NoteP); NoteP^.IsTemplate := False; NoteP^.ID := CleanFilename(FileName); NoteP^.LastChange := LastChange; {copy(LastChange, 1, 19); } //NoteP^.LastChange[11] := ' '; NoteP^.CreateDate := LastChange; {copy(LastChange, 1, 19); } //NoteP^.CreateDate[11] := ' '; NoteP^.Title:= Title; NoteP^.TitleLow:= lowercase(Title); NoteP^.OpenNote := nil; NoteList.Add(NoteP); // We don't need to re-sort here, the new note is added at the end, and our // list is sorted, newest towards the end. All good. end; function TNoteLister.GetTitle(Index : integer) : string; begin Result := PNote(NoteList.get(Index))^.Title; end; function TNoteLister.GetNote(Index : integer) : PNote; // ToDo : Used by sync, might be faster to just give it access to NoteList begin Result := nil; if (Index > -1) and (Index < NoteList.Count) then Result := NoteList[Index]; end; function TNoteLister.GetNote(Index: integer; mode: TLVSortMode): PNote; begin Result := Nil; if NoteList.Count <= Index then exit; case Mode of smRecentDown : result := NoteList[DateSearchIndex[Index]]; smRecentUp : result := NoteList[DateSearchIndex[DateSearchIndex.Count - Index -1]]; smAATitleUp : result := NoteList[TitleSearchIndex[Index]]; smAATitleDown : result := NoteList[TitleSearchIndex[TitleSearchIndex.Count - Index -1]]; smAllRecentUp : result := NoteList[DateAllIndex[DateAllIndex.Count - Index -1]]; end; end; function TNoteLister.IndexNotes(DontTestName : boolean = false): longint; var //Info : TSearchRec; cnt : integer = 4; IndexThread : TIndexThread; //T1, T2, T3, T4, T5 : qword; //i : integer; begin // DebugMode := true; // ToDo : remove //T1 := gettickcount64(); XMLError := False; if DontTestName then begin cnt := 1; // Just one thread. FinishedThreads := 3; end else FinishedThreads := 0; if NoteList <> nil then NoteList.Free; NoteList := TNoteList.Create; if NoteBookList <> nil then NoteBookList.Free; NoteBookList := TNoteBookList.Create; if DebugMode then debugln('Empty Note and Book Lists created'); FreeandNil(ErrorNotes); ErrorNotes := TStringList.Create; if DebugMode then debugln('IndexNotes : Looking for notes in [' + WorkingDir + ']'); InitCriticalSection(CriticalSection); // +++++++++++ while Cnt > 0 do begin //debugln('Making thread ' + inttostr(Cnt)); IndexThread := TIndexThread.Create(True); // Threads clean themselves up. IndexThread.GetNoteDetailsProc := @GetNoteDetails; // pass the address of the proc to the Thread class. IndexThread.WorkingDir := WorkingDir; IndexThread.OneThread := DontTestName; IndexThread.TheLister := self; case Cnt of // This is ignored in OneThread mode {$ifdef WINDOWS} 1 : IndexThread.StartsWith:= ['0', '1', '2', '3']; 2 : IndexThread.StartsWith:= ['4', '5', '6', '7']; 3 : IndexThread.StartsWith:= ['8', '9', 'A', 'B']; 4 : IndexThread.StartsWith:= ['C', 'D', 'E', 'F']; {$else} 1 : IndexThread.StartsWith:= ['0', '1', '2', '3', '4']; 2 : IndexThread.StartsWith:= ['5', '6', '7', '8', '9']; 3 : IndexThread.StartsWith:= ['a', 'B', 'c', 'D', 'e', 'F']; 4 : IndexThread.StartsWith:= ['A', 'b', 'C', 'd', 'E', 'f']; {$endif} end; IndexThread.start(); dec(Cnt); end; while FinishedThreads < 4 do sleep(1); // ToDo : some sort of 'its taken too long ..." DoneCriticalSection(CriticalSection); // ++++++++++++ if DebugMode then begin debugLn('Finished indexing notes'); DumpNoteNoteList('TNoteLister.IndexNotes'); end; NotebookList.CleanList(); Result := NoteList.Count; //T2 := gettickcount64(); NoteBookList.Sort(@NotebookSorter); //T3 := gettickcount64(); //debugln('TNoteLister.IndexNotes() called for ' + WorkingDir + ' count=' + inttostr(NoteList.Count)); if TheMainNoteLister = self then BuildDateAllIndex(); //if TheMainNoteLister <> nil then BuildDateAllIndex(); // Initialized below, set in Searchform, must be the MAIN notelister //T4 := gettickcount64(); //debugln('TNoteLister.IndexNotes read=' + inttostr(T2-T1) + 'mS, NoteBook Sort= ' + inttostr(T3-T2) + ' DateAllIndex=' + inttostr(T4-T3)); end; procedure TNoteLister.LoadStGrid(const Grid : TStringGrid; NoCols : integer; SearchMode : boolean = false); var Index : integer; // used by Snapshot manager. Sigh .... TheList : TNoteList; LCDst : string; CDst : string; //T1, T2, T3 : qword; begin //T1 := gettickcount64(); if SearchMode then TheList := SearchNoteList else TheList := NoteList; while Grid.RowCount > 1 do Grid.DeleteRow(Grid.RowCount-1); //T2 := gettickcount64(); Index := TheList.Count; while Index > 0 do begin dec(Index); LCDst := TheList.Items[Index]^.LastChange; if length(LCDst) > 11 then // looks prettier, dates are stored in ISO std LCDst[11] := ' '; // with a 'T' between date and time if length(LCDst) > 16 then LCDst := copy(LCDst, 1, 16); // we only want hours and minutes CDst := TheList.Items[Index]^.CreateDate; if length(CDst) > 11 then CDst[11] := ' '; if length(CDst) > 16 then CDst := copy(CDst, 1, 16); case NoCols of 2 : Grid.InsertRowWithValues(Grid.RowCount, [TheList.Items[Index]^.Title, LCDst]); 3 : Grid.InsertRowWithValues(Grid.RowCount, [TheList.Items[Index]^.Title, LCDst, CDst]); 4 : Grid.InsertRowWithValues(Grid.RowCount, [TheList.Items[Index]^.Title, LCDst, CDst, TheList.Items[Index]^.ID]); end; end; if Grid.SortColumn > -1 then Grid.SortColRow(True, Grid.SortColumn); // T3 := gettickcount64(); // debugln('Note_Lister - LoadStGrid ' + inttostr(T2 - T1) + ' ' + inttostr(T3 - T2)); end; (* function TNoteLister.NewLVItem(const LView : TListView; const Title, DateSt, FileName: string): TListItem; var TheItem : TListItem; DT : TDateTime; begin TheItem := LView.Items.Add; TheItem.Caption := Title; if MyTryISO8601ToDate(DateSt, DT) then TheItem.SubItems.Add(MyFormatDateTime(DT, True) + ' ') else TheItem.SubItems.Add('ERROR bad date string '); TheItem.SubItems.Add(FileName); Result := TheItem; end; procedure TNoteLister.LoadListView(const LView : TListView; const SearchMode : boolean); var Index : integer; TheList : TNoteList; //LCDst : string; //T1, T2, T3 : qword; // Full list mode, 2000 notes, Dell 7mS to clear, 20-40mS to load. begin //T1 := gettickcount64(); LView.Clear; if SearchMode then TheList := SearchNoteList else TheList := NoteList; //T2 := gettickcount64(); Index := TheList.Count; while Index > 0 do begin dec(Index); NewLVItem(LView, TheList.Items[Index]^.Title, TheList.Items[Index]^.LastChange, TheList.Items[Index]^.ID); end; //T3 := gettickcount64(); //debugln('TNoteLister.LoadListView Clear=' + dbgs(T2 - T1) + ' Fill=' + dbgs(T3 - T2)); end; *) procedure TNoteLister.LoadStrings(const TheStrings: TStrings); var Index : integer; begin Index := NoteList.Count; while Index > 0 do begin dec(Index); TheStrings.AddObject(NoteList.Items[Index]^.Title, tObject(NoteList.Items[Index]^.ID)); end; end; { New model, Aug 2022, now need to manage the Index Files. We will deal with what ever is needed here, alter existing, create new. We need to ret a value that tells SearchUnit it needs to - 1. Do nothing 2. update display. 3. rerun last search (and, update display) Ret value is either do nothing (false) or do something, True. We pass an Out Var, that will be false if the something is just update display and True if its a full rerun of search. ReRunSearch : boolean. This function first looks for the note ID in NoteList, if its there, update LCD and then look to see if its in Title has changed. If it has, rebuild DateAllIndex and return True. SearchUnit will trigger a repeat search. If its just a LCD job, we look to see if its mentioned in DateSearchIndex, if not, ret false. Its its there, ret true and set ReRunSearch to False. If its a new note, add to NoteList, update DateAllIndex, return True and set ReRunSearch=True. Present Ret ReRun Actions Just LCD No f f Update NoteList, update DateAllIndex Just LCD Yes T f Update NoteList, update DateAllIndex and DateSearchIndex LCD + Title No f f Update NoteList, update all 3 indexes LCD + Title Yes T T Update NoteList New Note T T Add to NoteList (still might not be displayed but too hard to tell) } function TNoteLister.AlterOrAddNote(out ReRunSearch : boolean; const FFName, LCD, Title : string) : boolean; var ID : string; i : integer = 0; // Is an index into NoteList // PresentInIndex : boolean = false; // If it finds the i entry in Index, moves it to last entry, that being most recent. function UpdateIndex(TheIndex : TSortList) : boolean; // i is an index to NoteList var j : integer; begin (* j := 0; Result := False; // False, if returned, means i does not exist in Index, reindex is needed while j < TheIndex.Count do begin if TheIndex[j] = i then begin TheIndex.Delete(j); TheIndex.add(i); exit(True); // We found and entry in the index and updated it. end; inc(j); end; *) j := TheIndex.Count; Result := False; // False, if returned, means i does not exist in Index, reindex is needed while j > 0 do begin dec(j); if TheIndex[j] = i then begin TheIndex.Delete(j); TheIndex.add(i); exit(True); // We found an entry in the index and updated it. end; end; end; { This gets called every time we update the datestamp on a note, so, as a user edits a note, they constently trigger a save. But the note is at the end of the Index after the first call, assume its called several time and start searching at end of list } begin Result := False; ReRunSearch := True; ID := CleanFilename(FFName); while i < NoteList.Count do begin // try to find ID in NoteList if ID = NoteList.Items[i]^.ID then break; // Found it inc(i); end; (* while ID <> NoteList.Items[i]^.ID do begin // ToDo : can this cannot handle empty list? inc(i); end; *) if i = NoteList.count then begin // Drop through, must be a new note. AddNote(ID, Title, LCD); // Add to NoteList DateAllIndex.Add(NoteList.Count -1); // Added at the end of DateAllIndex, most recent. result := true; // ReRunSearch is set to True so calling process must re run an existing search end else begin // Else its already in NoteList, maybe just a LCD but possible also Title change NoteList.Items[i]^.LastChange := LCD; if Title = NoteList.Items[i]^.Title then begin // Its just a LCD update, update DateSearchIndex and advise a re-Display ReRunSearch := False; result := UpdateIndex(DateSearchIndex); // False if not currently DateSearchIndex, its not being displayed anyway end else begin // Ah, a new title, must rerun search. NoteList.Items[i]^.Title := Title; NoteList.Items[i]^.TitleLow := lowercase(Title); end; UpdateIndex(DateAllIndex); // Always update DateAllIndex, its not done by Search methods end; end; function TNoteLister.AlterNote(ID, Change: ANSIString; Title: ANSIString): boolean; var Index : integer; begin result := False; for Index := NoteList.Count -1 downto 0 do begin //for Index := 0 to NoteList.Count -1 do begin if CleanFilename(ID) = NoteList.Items[Index]^.ID then begin if Title <> '' then begin NoteList.Items[Index]^.Title := Title; NoteList.Items[Index]^.TitleLow := lowercase(Title); end; if Change <> '' then begin NoteList.Items[Index]^.LastChange := Change; {copy(Change, 1, 19);} // check if note is already at the bottom of the list, don't need to re-sort. (* if (Index < (NoteList.Count -1)) then NoteList.Sort(@LastChangeSorter); *) // we don't do this any more ..... end; exit(True); end; end; end; function TNoteLister.IsThisATitle(const Title: ANSIString): boolean; var Index : integer; begin Result := False; for Index := NoteList.Count -1 downto 0 do begin //for Index := 0 to NoteList.Count -1 do begin if Title = NoteList.Items[Index]^.TitleLow then begin Result := True; break; end; end; end; function TNoteLister.CleanFileName(const FileOrID : AnsiString) : ANSIString; begin if length(ExtractFileNameOnly(FileOrID)) = 36 then Result := ExtractFileNameOnly(FileOrID) + '.note' else Result := ExtractFileNameOnly(FileOrID); end; function TNoteLister.IsThisNoteOpen(const ID: ANSIString; out TheForm : TForm): boolean; var Index : integer; begin Result := False; TheForm := Nil; for Index := NoteList.Count -1 downto 0 do begin //for Index := 0 to NoteList.Count -1 do begin if CleanFileName(ID) = NoteList.Items[Index]^.ID then begin TheForm := NoteList.Items[Index]^.OpenNote; Result := not (NoteList.Items[Index]^.OpenNote = Nil); break; end; end; end; function TNoteLister.ThisNoteIsOpen(const ID : ANSIString; const TheForm: TForm) : boolean; var Index : integer; //cnt : integer; JustID : string; begin result := false; if NoteList = NIl then exit; JustID := CleanFileName(ID); if NoteList.Count < 1 then begin //DebugLn('Called ThisNoteIsOpen() with empty but not NIL list. Count is ' // + inttostr(NoteList.Count) + ' ' + ID); // Occasionally I think we see a non reproducable error here. // I believe is legal to start the for loop below with an empty list but .... // When we are creating the very first note in a dir, this happens. Count should be exactly zero. end; //cnt := NoteList.Count; for Index := NoteList.Count -1 downto 0 do begin // for Index := 0 to NoteList.Count -1 do begin //writeln('ID = ', ID, ' ListID = ', NoteList.Items[Index]^.ID); if JustID = NoteList.Items[Index]^.ID then begin NoteList.Items[Index]^.OpenNote := TheForm; exit(true); end; end; // if Index = (NoteList.Count -1) then DebugLn('Failed to find ID in List ', ID); end; function TNoteLister.FileNameForTitle(const Title: ANSIString; out FileName : ANSIstring): boolean; var Index : integer; begin FileName := ''; Result := False; for Index := NoteList.Count -1 downto 0 do begin //for Index := 0 to NoteList.Count -1 do begin if lowercase(Title) = lowercase(NoteList.Items[Index]^.Title) then begin FileName := NoteList.Items[Index]^.ID; Result := True; break; end; end; end; procedure TNoteLister.StartSearch(); begin SearchIndex := 0; end; function TNoteLister.NextNoteTitle(out SearchTerm: ANSIString): boolean; begin Result := False; if SearchIndex < NoteList.Count then begin SearchTerm := NoteList.Items[SearchIndex]^.Title; inc(SearchIndex); Result := True; end; end; function TNoteLister.DeleteNote(const ID: ANSIString): boolean; var Index : integer; JustID : string; begin result := False; JustID := CleanFileName(ID); //DebugLn('TNoteLister.DeleteNote - asked to delete ', ID); for Index := NoteList.Count -1 downto 0 do begin //for Index := 0 to NoteList.Count -1 do begin if JustID = NoteList.Items[Index]^.ID then begin dispose(NoteList.Items[Index]); NoteList.Delete(Index); Result := True; break; end; end; if Result = false then DebugLn('Failed to remove ref to note in NoteLister ', ID); end; constructor TNoteLister.Create; begin SearchNoteList := nil; NoteList := nil; NoteBookList := Nil; ErrorNotes := Nil; DateSearchIndex := Nil; TitleSearchIndex := Nil; DateAllIndex := nil; EnterDateSearchIndex := Nil; EnterTitleSearchIndex := Nil; end; destructor TNoteLister.Destroy; begin SearchNoteList.Free; SearchNoteList := Nil; FreeAndNil(NoteBookList); FreeAndNil(NoteList); FreeAndNil(ErrorNotes); FreeAndNil(DateAllIndex); FreeAndNil(DateSearchIndex); FreeAndNil(TitleSearchIndex); FreeAndNil(EnterDateSearchIndex); FreeAndNil(EnterTitleSearchIndex); inherited Destroy; end; { ========================= TNoteList ====================== } destructor TNoteList.Destroy; var I : integer; begin for I := 0 to Count-1 do begin dispose(Items[I]); end; inherited Destroy; end; function TNoteList.Add(ANote: PNote): integer; begin result := inherited Add(ANote); end; function TNoteList.FindID(out Index:integer; const ID: ANSIString): boolean; begin Result := False; Index := 0; while Index < Count do begin if Items[Index]^.ID = ID then begin Result := True; exit(); end; inc(Index); end; end; function TNoteList.FindID(const ID: ANSIString): PNote; var Index : longint; begin Result := Nil; for Index := Count-1 downto 0 do begin //for Index := 0 to Count-1 do begin if Items[Index]^.ID = ID then begin Result := Items[Index]; exit() end; end; end; function TNoteList.Get(Index: integer): PNote; begin Result := PNote(inherited get(Index)); end; //initialization // done in SearchUnit // TheMainNoteLister := Nil; // A global that points to the main note list. end. �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������tomboy-ng_0.39-1/source/tb_symbol.pas���������������������������������������������������������������0000644�0001750�0001750�00000017654�14551457644�017453� 0����������������������������������������������������������������������������������������������������ustar �dbannon�������������������������dbannon����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������unit tb_symbol; {$mode ObjFPC}{$H+} { Copyright (C) 2023 David Bannon License: This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html ------------------ This is a unit that manages a list of extended characters, configurable by the user. a four byte char for testing $F09382BA History : 2023-02-19 Initial release. } interface uses Classes, SysUtils, Forms, Controls, Graphics, Dialogs, Grids, StdCtrls, Buttons, LCLIntf, ResourceStr; type Tutf8Char = string[4]; type TSymbolRec = record Sym : TUTF8Char; // will hold a UTF8 1-4 byte string SymStr : string[10]; // will hold a string represation of the UTF8 char end; type { TFormSymbol } TFormSymbol = class(TForm) BitBtnCancel: TBitBtn; BitBtnOK: TBitBtn; BitBtnRevert: TBitBtn; Label1: TLabel; Label2: TLabel; Label3: TLabel; StringGrid1: TStringGrid; procedure BitBtnOKClick(Sender: TObject); procedure BitBtnRevertClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure Label3Click(Sender: TObject); procedure StringGrid1SetEditText(Sender: TObject; ACol, ARow: Integer; const Value: string); private IsChanged : boolean; procedure DefaultSymbolRecArray(); function StrToUtf8(const St: string): TUTF8Char; procedure UpdateGrid; function ValidUTF8(UCh: TUTF8Char): boolean; procedure FChanged(NewState : boolean); property Changed : boolean read IsChanged write fChanged; public // Redraws the symbols in SymArray using SymArray's SymStr data. procedure UpdateSymbols(); end; var FormSymbol: TFormSymbol; SymArray : array[0..9] of TSymbolRec; implementation {$R *.lfm} // Initial, default values for Symbol Array, user can edit. procedure TFormSymbol.DefaultSymbolRecArray(); var i : integer; begin SymArray[0].SymStr := 'CEA9'; // OMEGA SymArray[1].SymStr := 'CE94'; // Delta SymArray[2].SymStr := 'CF80'; // Pi SymArray[3].SymStr := 'CEBC'; // Micro SymArray[4].SymStr := 'C2B0'; // Degree SymArray[5].SymStr := 'C3A6'; // LATIN SMALL LETTER AE SymArray[6].SymStr := 'C3A4'; // LATIN SMALL LETTER A WITH DIAERESIS SymArray[7].SymStr := 'C3AB'; // LATIN SMALL LETTER E WITH DIAERESIS SymArray[8].SymStr := 'C3B6'; // LATIN SMALL LETTER O WITH DIAERESIS SymArray[9].SymStr := 'C3BC'; // LATIN SMALL LETTER U WITH DIAERESIS for i := 0 to high(SymArray) do begin SymArray[i].Sym := StrToUTF8(SymArray[i].SymStr); end; end; // Converts a valid string with a UTF8 representation to a UTF8 string, returns // empty str if passed string is cannot be so converted. Errror tolerant. function TFormSymbol.StrToUtf8(const St : string) : TUTF8Char; // St should hold hex characters only, an even number, 2..8 function CharOK() : boolean; var i : integer = 1; begin while i <= length(St) do begin if St[i] in ['0'..'9', 'A'..'F', 'a'..'f'] then inc(i) else exit(false); end; result := true; end; var Buff : integer = 0; J : integer = 1; begin result := ''; if (byte(length(St)) in [2,4,6,8]) and CharOK() then begin // C3BC while J < length(St) do begin Buff := strtointdef('$' + St[j] + St[j+1], -1); Result := Result + char(Buff); inc(J, 2); end; end; if not ValidUTF8(Result) then Result := ''; end; (* function TFormSymbol.LongToUtf8(const ANumb : longint) : TUTF8Char; // Can handle ONLY 1..3 byte UTF8 char var Numb : longint; AByte : byte = 0; begin Result := ''; Numb := ANumb; while true do begin AByte := Numb mod 256; Numb := Numb div 256; // shr faster ... Result := char(AByte) + Result; if Numb < 256 then begin Result := char(Numb) + Result; break; end; end; end; *) function TFormSymbol.ValidUTF8(UCh : TUTF8Char) : boolean; // returns true if the TheBit'th from right is set. 110xxxxx function BitSet(Value : char; TheBit : integer) : boolean; // theBit 0-7 begin Result := ((byte(Value) shr TheBit) and 1) = 1; end; begin result := false; case length(Uch) of 0 : exit(false); 1 : exit(not BitSet(Uch[1], 7)); // 0xxxxxxx 2 : exit(BitSet(Uch[1], 7) and BitSet(Uch[1], 6) // 110xxxxx 10xxxxxx and (not BitSet(Uch[1], 5)) and BitSet(Uch[2], 7) and (not BitSet(Uch[2], 6))); 3 : exit(BitSet(Uch[1], 7) and BitSet(Uch[1], 6) // 1110xxxx 10xxxxxx 10xxxxxx and BitSet(Uch[1], 5) and (not BitSet(Uch[1], 4)) and BitSet(Uch[2], 7) and (not BitSet(Uch[2], 6)) and BitSet(Uch[3], 7) and (not BitSet(Uch[3], 6))); 4 : exit(BitSet(Uch[1], 7) and BitSet(Uch[1], 6) // 11110xxx 10xxxxxx 10xxxxxx 10xxxxxx and BitSet(Uch[1], 5) and BitSet(Uch[1], 4) and (not BitSet(Uch[1], 3)) and BitSet(Uch[2], 7) and (not BitSet(Uch[2], 6)) and BitSet(Uch[3], 7) and (not BitSet(Uch[3], 6)) and BitSet(Uch[3], 7) and (not BitSet(Uch[3], 6))); end; end; procedure TFormSymbol.FChanged(NewState : boolean); begin BitBtnOK.Enabled := NewState; BitBtnRevert.Enabled := NewState; IsChanged := NewState; end; procedure TFormSymbol.UpdateSymbols(); var I : integer; begin for i := 0 to high(SymArray) do begin SymArray[i].Sym := StrToUtf8(SymArray[i].SymStr); //writeln('TFormSymbol.UpdateSymbols ' + SymArray[i].Sym); end; UpdateGrid(); end; procedure TFormSymbol.UpdateGrid(); var i : integer; begin for i := 0 to high(SymArray) do begin StringGrid1.Cells[0, i] := SymArray[i].Sym; StringGrid1.Cells[1, i] := SymArray[i].SymStr; end; end; { TFormSymbol } procedure TFormSymbol.FormCreate(Sender: TObject); begin // in StringGrid, tick goAlwaysShowEditor, goEditing Label1.Caption := rsEnterHexValue; Label2.caption := rsHexCharRequired; Label3.Caption := 'Click here to browse to full list'; DefaultSymbolRecArray(); UpdateGrid(); BitBtnOk.Enabled := False; BitBtnRevert.Enabled := False; end; procedure TFormSymbol.Label3Click(Sender: TObject); begin // open the users browser at https://www.utf8-chartable.de/unicode-utf8-table.pl OpenURL('https://www.utf8-chartable.de/unicode-utf8-table.pl'); end; procedure TFormSymbol.BitBtnRevertClick(Sender: TObject); begin UpdateGrid(); Changed := False; end; procedure TFormSymbol.BitBtnOKClick(Sender: TObject); var i : integer; St : string; begin if Changed then begin for i := 0 to high(SymArray) do begin St := StringGrid1.Cells[1, i]; if (length(St) > 0) and (St[1] in ['x', 'X', '$']) then delete(St, 1, 1); // silently forgive inclusion of a hex symbol SymArray[i].SymStr := St; SymArray[i].Sym := StrToUTF8(St); end; end; end; { we expect 0..8 hex digits, will remove a leading $ or x. Must work as string, not numerically because for hex bytes might be bigger than longint. } procedure TFormSymbol.StringGrid1SetEditText(Sender: TObject; ACol, ARow: Integer; const Value: string); var St : string; begin St := StringGrid1.Cells[ACol, ARow]; if (length(St) > 0) and (St[1] in ['x', 'X', '$']) then delete(St, 1, 1); // silently forgive inclusion of a hex symbol StringGrid1.Cells[0, ARow] := StrToUTF8(St); // try $F09382BA if St <> SymArray[ARow].SymStr then // A change made Changed := True; end; end. ������������������������������������������������������������������������������������tomboy-ng_0.39-1/source/import_notes.pas������������������������������������������������������������0000644�0001750�0001750�00000052017�14551457644�020173� 0����������������������������������������������������������������������������������������������������ustar �dbannon�������������������������dbannon����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������unit import_notes; { Copyright (C) 2017-2022 David Bannon License: This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html ------------------ } { Will import either plain text or markdown converting content to note. Set DestinationDir, Mode (plaintext, markdown) and optionally FirstLineIsTitle (other wise, file name will beome title). Then pass a List of full file names, that is, including a path and extension, to convert. Things that must be done - 1. Notebook, a string that optionally contains the name of a notebook that will be assigned to each imported note. This will involve looking to see if there is already a notebook of this name, if not creating necessary files. Does not make sense if destination dir is not either Tomboy or tomboy-ng. 2. On completion, send tomboy-ng a hup if its running so it knows to refresh. HISTORY : 2021/08/19 Rewrite much of md import. More use of St.Replace() model. 2021/09/06 Support notebook lists 2021/09/25 Allow [] meaning an empty list of notebooks. 2021/09/25 Fixed an "beyond the end of a line" issue in PosMDTag(), only show up on build machine ??? 2021/09/28 Enable multilevel bullets 2021/10/01 Allow for the fact that a JSON Notebook string may have " or \ escaped. 2021/10/17 Remove four spaces from left of mono line. 2021/10/18 Inline MD Tags now support Flanking rules, https://spec.commonmark.org/0.30/#left-flanking-delimiter-run 2021/10/18 For some reason I was removing embedded underline xml, now I restore it ?? 2021/12/29 Added a single file name for when importing one file at a time. 2021/01/13 Unix only check to see if a passed filename starts with an '~', expand if so. 2022/11/08 Ensure no xml markup in Title. } {$mode objfpc}{$H+} interface uses Classes, SysUtils; type { TImportNotes } TImportNotes = class private function ChangeTag(var St: string; const ChangeFrom, ChangeToLead, ChangeToTrail: string): boolean; procedure ConvertList(var St: string); procedure DoLineHeadings(const STL: TStringList); { Ret True if it finds a matching pair of tags that obay the Flanking rules. If so, sets the out vars to start of each tag. Else rets false. Call until it does ret false. https://spec.commonmark.org/0.30/#left-flanking-delimiter-run } function FindMDTags(const St, Tag: string; out LeftFlank, RightFlank: integer ): boolean; function ImportFile(FullFileName: string) : boolean; function MarkUpMarkDown(Cont: TStringList) : boolean; // Gets passed a List with note content, puts an appropriate // header and footer on. function ProcessPlain(Cont: TStringList; const Title: string; LCD : string = ''; CDate: string = ''): boolean; public ErrorMsg : string; // '' if everything OK, content means something bad happened DestinationDir : string; // Required, dir to save notes to Mode : string; // ie plaintext, markdown .... ImportNames : TStringList; // A list of full file names to import ImportName : string; // Alt to passing a stringlist to ImportNames, single string; FirstLineIsTitle : boolean; // if true, first line of note becomes title, default is filename will become title KeepFileName : boolean; // The note will have same base name as import. NoteBook : string; // Empty is OK, plain text notebook name or JSON array (including []) NewFileName : string; // Only valid for single file import, will have ID.note of imported note. function Execute(): integer; // you know all you need, go do it. // Alt action for this Unit, converts a StringList that contains // markdown to a Note, no file i/o happens, note is returned in // the same stringlist. If LCD, CDate are '' then defaults are used. function MDtoNote(Content: TStringList; const LCD, CDate: string): boolean; constructor Create; destructor Destroy; override; end; implementation { TImportNotes } uses LazFileUtils, LazUTF8, LCLProc, TB_utils; function TImportNotes.ProcessPlain(Cont: TStringList; const Title: string; LCD: string; CDate : string): boolean; var Start : integer = 1; NBName : string = ''; //DateSt : string; // eg '2020-05-19T18:58:37.9513193+10:00'; // Finds Notebook names on the JSON Notebook string. Even allows for Escaped " and \ // returns string value or empty string if no more available function NextNBName() : string; var InValue : boolean = False; InEsc : boolean = False; //i, Index : integer; begin Result := ''; inc(Start); while Start < length(Notebook)-1 do begin //for i := Start+1 to length(Notebook)-1 do begin case Notebook[Start] of '"' : if InValue and not InEsc then // Ah, thats the end of a value. exit else if not InEsc then begin InValue := True; inc(Start); continue; end; // if we are inEsc, let it go through to keeper. '\' : if not InEsc then begin InEsc := True; // Must be first. inc(Start); continue; end; end; // In every case, if we are InEsc, we allow the use of the char InEsc := False; if InValue then Result := Result + NoteBook[Start]; inc(Start); end; end; begin if LCD = '' then LCD := TB_GetLocalTime(); if CDate = '' then CDate := TB_GetLocalTime(); //LCDateSt := TB_GetLocalTime(); Cont.Insert(0, ' <text xml:space="preserve"><note-content version="0.1">' + Title); Cont.Insert(0, ' <title>' + Title + ''); Cont.Insert(0, ''); Cont.Insert(0, ''); Cont.Add(' '); Cont.Add(' ' + LCD + ''); Cont.Add(' ' + LCD + ''); Cont.Add(' ' + CDate + ''); Cont.Add(' 1'); Cont.Add(' 1000'); Cont.Add(' 626'); Cont.Add(' 20'); Cont.Add(' 30'); Cont.Add(' '); // notebook may contain just the name of a notebook, My NoteBook or a json array, eg // [] or ["template","Man Pages"] or ["Man Pages"] or ["Man Pages", "Other Notebook"] // But Notebook names may have backslash or double inverted commas, escaped with backslash if (Notebook <> '') and (Notebook <> '[]') then begin if (NoteBook[1] = '[') then begin // its a JSON array NBName := NextNBName; // Uses the regional, 'Start' to keep track while NBName <> '' do begin if NBName = 'template' then Cont.Add(' system:template:' + '') else Cont.Add(' system:notebook:' + RemoveBadXMLCharacters(NBName) + ''); NBName := NextNBName; end; end else // if not an array, just use it as it is, one notebook if NoteBook <> '' then Cont.Add(' system:notebook:' + RemoveBadXMLCharacters(NoteBook) + ''); end; Cont.Add(' '); Cont.Add(' False'); Cont.Add(''); result := True; end; { Markdown Rules A line starting with a asterik and a space is a bullet. Or some whitespace first might be a multilevel bullet. Bold text is wrapped in ** at either end. Or __ (that is two underscores) at either end. Italics is wrapped in * at either end. Again, the underscore at either end will work as well. Highlight is wrapped in ~~ at either end, Stikeout is supported with ~~ at either end. a line starting with ###space is a bold, large line a line starting with ##space is a bold, huge line A line that is followed by some ===== or ------ are headings, huge and Large we ignore #space, have other ways of finding title. A line starting with four or more spaces is all monospace, remove exactly four spaces and add tags. In line text that is wrapped in backticks is in line mono, remove ticks and add tags. All the inline tags follow Flanking rules, eg LeftFlank must have something immediatly to the right. } // Iterates over list looking for a line that is either "------" or "======" and if // it finds one, removes that line and makes line ABOVE a header. // Setext - one or more = or - with up to three leading spaces and any number of training whitespace // Sigh .... procedure TImportNotes.DoLineHeadings(const STL : TStringList); var i : integer = 1; // Line 0 is the heading // Ret true if passed line is a SeText line, https://spec.commonmark.org/ function IsSeText(const St : string; Se : char) : boolean; var j : integer = 1; SeCount : integer = 0; begin Result := false; while j <= St.length do begin if St[j] = Se then begin inc(SeCount); inc(j); continue; end; // If its not a Se, nor whitespace, cannot be a heading. if (not (St[j] in [ ' ', #10, #13])) then exit(false); // only allowed 3 spaces at left if (J > 3) and (SeCount = 0) then exit(false); inc(j); end; result := SeCount > 0; end; // Will remove current line and make previous line a Heading. procedure MakeHeading(IsHuge : boolean); var St : string; begin StL.Delete(i); if i > 1 then begin St := StL[i-1]; if IsHuge then St := '' + St + '' else St := '' + St + ''; StL.Delete(i-1); StL.Insert(i-1, St); end; end; begin while I < STL.Count do begin // Must be while, we will alter count as we go if IsSeText(Stl[i], '=') then MakeHeading(True) else if IsSeText(Stl[i], '-') then MakeHeading(False) else inc(i); end; end; // ToDo : the flanking rules are grossly incomplete. We must ignore intermediate tags and test for real content. // ToDo : when we decide its a pair of MD Tags, we should ensure there are no unmatched xml tags between. function TImportNotes.FindMDTags(const St, Tag : string; out LeftFlank, RightFlank : integer) : boolean; begin LeftFlank := pos(Tag, St, 1); if LeftFlank = 0 then exit(False); while true do begin // OK, is it really a LeftFlank ? These tests must be improved significently ! if (St.Length < (LeftFlank + 1 + (2*Tag.Length))) // no room for content and trailing tag or (St[LeftFlank+Tag.Length] = ' ') then begin // not left flanking, need check better than this !! LeftFlank := pos(Tag, St, LeftFlank+1); if LeftFlank = 0 then exit(False); continue; end; break; end; // OK, we do have a LeftFlank, should look at any xml tags we step over here but for now, lets find a RightFlank RightFlank := pos(Tag, St, LeftFlank + Tag.Length); if (RightFlank = 0) then exit(False); while true do begin if (St[RightFlank -1] = ' ') then begin RightFlank := pos(Tag, St, RightFlank + Tag.Length); if (RightFlank = 0) then exit(False); continue; end; exit(True); end; result := False; end; (* function TImportNotes.FindMDTags(const St, Tag : string; out LeftFlank, RightFlank : integer) : boolean; begin LeftFlank := pos(Tag, St, 1); if LeftFlank = 0 then exit(False); while LeftFlank > 0 do begin // OK, is it really a LeftFlank ? These tests must be improved significently ! if (St.Length < (LeftFlank + 1 + (2*Tag.Length))) // no room for content and trailing tag or (St[LeftFlank+Tag.Length] = ' ') then begin // not left flanking, need check better than this !! LeftFlank := pos(Tag, St, LeftFlank+1); continue; end; // OK, we do have a LeftFlank, should test for matched tags here but for now, lets find a RightFlank RightFlank := pos(Tag, St, LeftFlank + Tag.Length); if (RightFlank = 0) then exit(False); // no point in looking further. if (St[RightFlank -1] = ' ') then begin RightFlank := pos(Tag, St, RightFlank + Tag.Length); continue; end; exit(True); end; result := False; end; *) function TImportNotes.ChangeTag(var St : string; const ChangeFrom, ChangeToLead, ChangeToTrail : string) : boolean; var LFlank, RFlank : integer; begin Result := False; if FindMDTags(St, ChangeFrom, LFlank, RFlank) then begin delete(St, RFlank, ChangeFrom.Length); insert(ChangeToTrail, St, RFlank); delete(St, LFlank, ChangeFrom.Length); insert(ChangeToLead, St, LFlank); result := True; end; end; { For our purpose, here, a level one list line starts with an * followed by a space. For every three spaces before the * its one level deeper. While MD lets you use other characters, its only a * here folks. } procedure TImportNotes.ConvertList(var St : string); var Spaces : integer = 1; // How many leading spaces. I : integer; xmltags : string = ''; begin while Spaces <= st.length do begin if St[Spaces] <> ' ' then break; inc(Spaces); end; // here, number of spaces is Spaces-1; We are here because either not (Spaces <= St.Length) or St[Spaces] <> ' '. if (Spaces > st.length) or (St[Spaces] <> '*') then exit; // either not a * or no room for one. // If to here, we know its a (0-n spaces)*, if its a space next, definitly list item. inc(Spaces); if (Spaces > st.length) or (St[Spaces] <> ' ') then exit; dec(Spaces, 2); //debugln('TImportNotes.ConvertList Spaces=' + inttostr(Spaces) + ' and St=' + St); // So, remove Spaces spaces, the * and one more space. delete(St, 1, Spaces+2); Spaces := Spaces div 3; // 0 div 3 = 0 for i := 0 to Spaces do xmltags := xmltags + ''; St := xmltags + St; xmltags := ''; for i := 0 to Spaces do // When Spaces = 0, we must add one set of tags. xmltags := xmltags + ''; St := St + xmltags; //debugln('TImportNotes.ConvertList St=' + St); end; // huge heading function TImportNotes.MarkUpMarkDown(Cont : TStringList) : boolean; var Index : integer = 0; St : string; DropNewLine : boolean = True; begin Result := True; while Index < Cont.Count do begin St := Cont.Strings[Index]; if (St = '') then begin if DropNewLine then begin Cont.Delete(Index); DropNewLine := False; continue; end else DropNewLine := True; end else DropNewLine := True; // DebugLn('Start [' + St + ']'); if copy(St, 1, 4) = '### ' then begin delete(St, 1, 4); St := '' + St + '' end else if copy(St, 1, 3) = '## ' then begin delete(St, 1, 3); St := '' + St + '' end else ConvertList(St); (* end else if copy(St, 1, 2) = '* ' then begin delete(St, 1, 2); //Line one St := '' + St + ''; end; *) St := St.Replace('<sub>', '', [rfReplaceAll]); St := St.Replace('</sub>', '', [rfReplaceAll]); St := St.Replace('<underline>', '', [rfReplaceAll]); St := St.Replace('</underline>', '', [rfReplaceAll]); St := St.Replace('<highlight>', '', [rfReplaceAll]); St := St.Replace('</highlight>', '', [rfReplaceAll]); // DebugLn('Middle [' + St + ']'); while ChangeTag(St, '***', '', '') do; while ChangeTag(St, '**', '', '') do; while ChangeTag(St, '__', '', '') do; while ChangeTag(St, '*', '', '') do; while ChangeTag(St, '_', '', '') do; while ChangeTag(St, '`', '', '') do; while ChangeTag(St, '~~', '', '') do; if copy(St, 1, 4) = ' ' then begin // Ah, thats leading space mono St := St.Remove(0, 4); if length(St) > 0 then St := '' + St + ''; end; // DebugLn('Finish [' + St + ']'); Cont.Strings[Index] := St; inc(Index); end; DoLineHeadings(Cont); end; function TImportNotes.ImportFile(FullFileName: string): boolean; var Content : TStringList; GUID : TGUID; //NewFileName : string; Title : string = ''; Index : integer = 0; begin Result := True; {$ifdef UNIX} if FullFileName[1] = '~' then FullFileName := GetEnvironmentVariable('HOME') + FullFileName.Remove(0,1); {$endif} if FileExists(FullFileName) then begin try Content := TStringList.Create; Content.LoadFromFile(FullFileName); while Index < Content.Count do begin Content.Strings[Index] := RemoveBadXMLCharacters(Content.Strings[Index]); inc(Index); end; if Mode = 'markdown' then MarkUpMarkDown(Content); if FirstLineIsTitle then begin while (Content.Count > 0) and (Title = '') do begin // title is first non-empty line Title := Content.Strings[0]; Content.Delete(0); end; end else Title := ExtractFileNameOnly(FullFileName); if Mode = 'markdown' then begin if copy(Title, 1, 2) = '# ' then delete(Title, 1, 2); if copy(Title, 1, 2) = '## ' then delete(Title, 1, 3); if copy(Title, 1, 2) = '### ' then delete(Title, 1, 4); end; Title := RemoveXml(Title); if Title = '' then Title := 'Unknown Title'; ProcessPlain(Content, Title); CreateGUID(GUID); if KeepFileName then NewFileName := ExtractFileNameOnly(FullFileName) + '.note' else NewFileName := copy(GUIDToString(GUID), 2, 36) + '.note'; Content.SaveToFile(AppendPathDelim(DestinationDir) + NewFileName); //NewSimpleFileName := NewFileName; finally freeandnil(Content); end; end else begin ErrorMsg := 'Failed to open import file' + #10 + FullFileName; Result := False; end; end; function TImportNotes.Execute(): integer; var St : string; begin Result := 0; if ImportName <> '' then begin // ImportName - a single string, one file. if ImportFile(ImportName) then exit(1) else exit(0); end; if ImportNames = nil then // ImportNames - a string list. exit; for St in ImportNames do begin if not ImportFile(St) then exit; inc(Result); end; end; function TImportNotes.MDtoNote(Content: TStringList; const LCD, CDate: string): boolean; var Title : string; Index : integer = 0; begin Result := True; while Index < Content.Count do begin Content.Strings[Index] := RemoveBadXMLCharacters(Content.Strings[Index]); inc(Index); end; MarkUpMarkDown(Content); Title := Content.Strings[0]; Title := Title.Replace('', ''); Title := Title.Replace('', ''); Content.Delete(0); Title.Replace('#', '', [rfReplaceAll]); ProcessPlain(Content, Title, LCD, CDate); end; constructor TImportNotes.Create; begin end; destructor TImportNotes.Destroy; begin inherited Destroy; end; end. tomboy-ng_0.39-1/source/syncgui.lrj0000644000175000017500000000245714551457644017141 0ustar dbannondbannon{"version":1,"strings":[ {"hash":372803,"name":"tformsync.caption","sourcebytes":[83,121,110,99],"value":"Sync"}, {"hash":86477809,"name":"tformsync.label1.caption","sourcebytes":[76,97,98,101,108,49],"value":"Label1"}, {"hash":86477810,"name":"tformsync.label2.caption","sourcebytes":[76,97,98,101,108,50],"value":"Label2"}, {"hash":187059587,"name":"tformsync.labelprogress.caption","sourcebytes":[76,97,98,101,108,80,114,111,103,114,101,115,115],"value":"LabelProgress"}, {"hash":77089212,"name":"tformsync.buttoncancel.caption","sourcebytes":[67,97,110,99,101,108],"value":"Cancel"}, {"hash":4863637,"name":"tformsync.buttonclose.caption","sourcebytes":[67,108,111,115,101],"value":"Close"}, {"hash":233429619,"name":"tformsync.buttonsave.caption","sourcebytes":[83,97,118,101,32,97,110,100,32,83,121,110,99],"value":"Save and Sync"}, {"hash":90721267,"name":"tformsync.panel3.caption","sourcebytes":[80,97,110,101,108,51],"value":"Panel3"}, {"hash":75149406,"name":"tformsync.listviewreport.columns[0].caption","sourcebytes":[65,99,116,105,111,110],"value":"Action"}, {"hash":5966629,"name":"tformsync.listviewreport.columns[1].caption","sourcebytes":[84,105,116,108,101],"value":"Title"}, {"hash":90862724,"name":"tformsync.listviewreport.columns[2].caption","sourcebytes":[78,111,116,101,32,73,68],"value":"Note ID"} ]} tomboy-ng_0.39-1/source/hunspell.inc0000644000175000017500000001242714551457644017272 0ustar dbannondbannon { This include file provides the basic Object Pascal bindings to the Hunspell spelling library. It was built with reference to the hunspell.h, please see https://github.com/hunspell/hunspell/blob/master/src/hunspell/hunspell.h and so inherits the Hunspell license. The author of this particular file is David Bannon but the file contains no original code, just the names and parameter lists of the public hunspell functions so no copyright is claimed. Nor is any warranty of any kind expressed or implied. } (* ***** BEGIN LICENSE BLOCK ***** * Version: MPL 1.1/GPL 2.0/LGPL 2.1 * * The contents of this file are subject to the Mozilla Public License Version * 1.1 (the "License"); you may not use this file except in compliance with * the License. You may obtain a copy of the License at * http://www.mozilla.org/MPL/ * * Software distributed under the License is distributed on an "AS IS" basis, * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License * for the specific language governing rights and limitations under the * License. * * The Original Code is Hunspell, based on MySpell. * * The Initial Developers of the Original Code are * Kevin Hendricks (MySpell) and Németh László (Hunspell). * Portions created by the Initial Developers are Copyright (C) 2002-2005 * the Initial Developers. All Rights Reserved. * * Contributor(s): David Einstein, Davide Prina, Giuseppe Modugno, * Gianluca Turconi, Simon Brouwer, Noll János, Bíró Árpád, * Goldman Eleonóra, Sarlós Tamás, Bencsáth Boldizsár, Halácsy Péter, * Dvornik László, Gefferth András, Nagy Viktor, Varga Dániel, Chris Halls, * Rene Engelhard, Bram Moolenaar, Dafydd Jones, Harri Pitkänen * * Alternatively, the contents of this file may be used under the terms of * either the GNU General Public License Version 2 or later (the "GPL"), or * the GNU Lesser General Public License Version 2.1 or later (the "LGPL"), * in which case the provisions of the GPL or the LGPL are applicable instead * of those above. If you wish to allow use of your version of this file only * under the terms of either the GPL or the LGPL, and not to allow others to * use your version of this file under the terms of the MPL, indicate your * decision by deleting the provisions above and replace them with the notice * and other provisions required by the GPL or the LGPL. If you do not delete * the provisions above, a recipient may use your version of this file under * the terms of any one of the MPL, the GPL or the LGPL. * * ***** END LICENSE BLOCK ***** *) { These types will be used, elsewhere, to declare pointer variables that will be set to point to the various functions in the library. They are, therefore just pointers to a function. String parameters must be PChar because thats how Pascal passes strings to C code and they are marked cdecl. In the C code they apparently return a pointer to a Hunhandle structure, thats not our business, all we need to know is the pointer returned by create points to something. } type THunspell_create = function(affpath: PChar; dpath: PChar): Pointer; cdecl; THunspell_create_key = function(affpath, dpath, key : PChar) : Pointer; cdecl; // UNTESTED THunspell_destroy = procedure(spell: Pointer); cdecl; { load extra dictionaries (only dic files), returns 0 if additional dictionary slots available, 1 if slots are now full } THunspell_add_dic = function(pHunspell : Pointer; dpath : PChar) : integer; cdecl; // UNTESTED { spellcheck word, ret 0 is bad spelling, non zero good to go } THunspell_spell = function(pHunspell: Pointer; word: PChar): Boolean; cdecl; THunspell_get_dic_encoding = function(pHunspell: Pointer): PChar; cdecl; // UNTESTED { pass a misspelt word and get back an array of suggestions, you must free (unless no suggestions offered) the list when done with it. } THunspell_suggest = function(pHunspell: Pointer; out slst: PPChar; word: PChar): Integer; cdecl; { morphological functions, I will leave that to someone who understands } THunspell_analyze = function(pHunspell: Pointer; var slst: PPChar; word: PChar): Integer; cdecl; // UNTESTED { stemmer function ?? } THunspell_stem = function(pHunspell: Pointer; var slst: PPChar; word: PChar): Integer; cdecl; // UNTESTED // int Hunspell_stem2(Hunhandle* pHunspell, char*** slst, char** desc, int n); // int Hunspell_generate2(Hunhandle* pHunspell, char*** slst, const char* word, char** desc, int n); { Add to run time dictionary } THunspell_add = function(pHunspell: Pointer; word: PChar): Integer; cdecl; { add word to the run-time dictionary with affix flags of the example (a dictionary word): Hunspell will recognize affixed forms of the new word, too. } // int Hunspell_add_with_affix(Hunhandle* pHunspell, const char* word, const char* example); { remove word from the run-time dictionary } THunspell_remove = function(spell: Pointer; word: PChar): Integer; cdecl; { free suggestion lists } THunspell_free_list = procedure(spell: Pointer; var slst: PPChar; n: integer); cdecl; tomboy-ng_0.39-1/source/index.lrj0000644000175000017500000000110614551457644016555 0ustar dbannondbannon{"version":1,"strings":[ {"hash":231754757,"name":"tformindex.caption","sourcebytes":[72,101,97,100,105,110,103,32,105,110,32,116,104,105,115,32,78,111,116,101],"value":"Heading in this Note"}, {"hash":59365493,"name":"tformindex.panel1.caption","sourcebytes":[83,105,110,103,108,101,32,108,105,110,101,115,44,32,97,108,108,32,72,117,103,101,44,32,76,97,114,103,101,32,66,111,108,100,32,111,114,32,76,97,114,103,101],"value":"Single lines, all Huge, Large Bold or Large"}, {"hash":86477809,"name":"tformindex.label1.caption","sourcebytes":[76,97,98,101,108,49],"value":"Label1"} ]} tomboy-ng_0.39-1/source/k_prn.pas0000644000175000017500000002233314551457644016560 0ustar dbannondbannonunit K_Prn; { Copyright (C) 2017-2020 David Bannon License: This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html ------------------ Intended specificially to print tomboy-ng notes but will not too far from a generic (text only) KMemo print unit. Note tomboy-ng won't ever have a blank line at the top, could be messy if you try and print a KMemo with a leading TKMemoParagraph. See KMemoRead() } {$mode objfpc}{$H+} interface uses Classes, SysUtils, Graphics, kmemo; type PWord=^TWord; TWord= record AWord : ANSIString; Size : integer; Bold, Italic, NewLine : boolean; Colour : TColor; FName : string; // PDF only ABullet : TKMemoParaNumbering; // PDF only end; type { TWordList } TWordList = class(TList) private function Get(Index : Integer) : PWord; public destructor Destroy; Override; procedure Add(TheWord: ANSIString; S: integer; B, I, NL: boolean; Colour: TColor; FName: string = ''); //function SameStyle(const S1, S2 : integer) : boolean; procedure Dump(); property Items[Index : integer] : PWord read Get; default; end; type { TKPrn } TKPrn = class private FirstLine : Boolean; WordList : TWordList; CurrentY : Integer; MaxY : Integer; LeftEdge, RightEdge : integer; BlankLineHeight : integer; { Determines a suitable height for blank lines } function BlankLineH(): integer; { Copies the interesting font characteristics } procedure CopyFont(FromFont, ToFont: TFont); { Copies the KMemo into WordList, one word per item } function KMemoRead(const TheKMemo: TKMemo) : boolean; { returns the height of higest char in Line between passed params } function LineHeight(const SWord, EWord: integer): integer; { Prints, at CurrentY, the Line between passed params } procedure LinePrint(const SWord, EWord: integer); { Indicates width, in display pixels, of words between passed params } function LineWidth(const SWord, EWord: integer): integer; { set the style of the printer to that of the the Item in WordList } procedure SetPrinter(ItemNo: integer); public { call this to print the KMemo via previously setup Printer } function PrintKmemo(KM1 : TKMemo) : boolean; destructor Destroy; Override; constructor Create(); end; implementation uses Printers, LazUTF8; Const VNudge = 0.85; // Vert align of different font sizes. Small value pulls // larger fonts lower compared to small characters. // So, if big fonts appear to sit above base line, drop // this number down a bit. Margin = 0.05; // Fraction of page width and height reserved for margins. { TLumpList } function TWordList.Get(Index: Integer): PWord; begin Result := PWord(inherited get(Index)); end; destructor TWordList.Destroy; var I : integer; begin for I := 0 to Count-1 do begin dispose(Items[I]); end; inherited Destroy; end; procedure TWordList.Add(TheWord: ANSIString; S: integer; B, I, NL: boolean; Colour : TColor; FName : string = ''); var PL : PWord; begin new(PL); PL^.AWord:=TheWord; PL^.Size:=S; PL^.Bold:=B; PL^.Italic:=I; PL^.Colour:=Colour; PL^.NewLine:= NL; PL^.FName := FName; // Only used by PDF writer PL^.ABullet := pnuNone; // Only used by PDF writer inherited Add(PL); end; procedure TWordList.Dump(); var I : integer; begin {$ifdef LINUX} // usable in linux only for I := 0 to Count-1 do writeln('NL=' + booltostr(Items[I]^.NewLine, True) + ' [' + Items[I]^.AWord + '] f=' + Items[I]^.FName ); // + ' Bullet=' + booltostr(Items[I]^.Bullet, True) {$endif} end; { ====================== T KPrn ======================= } { TKPrn } function TKPrn.PrintKmemo(KM1: TKMemo): boolean; var StartWord : integer = 0; EndWord : integer = 0; begin if not KMemoRead(KM1) then exit(False); try Printer.BeginDoc; BlankLineHeight := BlankLineH(); while EndWord < WordList.Count do begin inc(Endword); if EndWord = WordList.Count then break; if WordList.Items[EndWord]^.NewLine then begin if WordList.Items[EndWord-1]^.AWord = '' then inc(CurrentY, BlankLineHeight) else LinePrint(StartWord, EndWord); StartWord := EndWord; continue; end; if Linewidth(StartWord, EndWord) > (RightEdge-LeftEdge) then begin dec(EndWord); LinePrint(StartWord, EndWord); StartWord := EndWord; end; end; finally Printer.EndDoc; end; end; destructor TKPrn.Destroy; begin FreeandNil(WordList); inherited Destroy; end; constructor TKPrn.Create(); begin inherited Create(); LeftEdge := round(Printer.PageWidth * Margin); RightEdge := Printer.PageWidth - (2 * LeftEdge); MaxY := round(Printer.PageHeight * (1-(2*Margin))); CurrentY := round(Printer.PageHeight * Margin); FirstLine := True; end; function TKPrn.BlankLineH() : integer; begin Printer.Canvas.Font.Size := 10; Printer.Canvas.Font.Bold := False; Printer.Canvas.Font.Italic := False; Result := Printer.Canvas.TextHeight('I'); end; procedure TKPrn.SetPrinter(ItemNo : integer); begin Printer.Canvas.Font.Size := WordList.Items[ItemNo]^.Size; Printer.Canvas.Font.Color := WordList.Items[ItemNo]^.Colour; Printer.Canvas.Font.Bold := WordList.Items[ItemNo]^.Bold; Printer.Canvas.Font.Italic := WordList.Items[ItemNo]^.Italic; end; // Up to but not inc EWord. procedure TKPrn.LinePrint(const SWord, EWord : integer); var ItemNo, XOffset, YOffset : integer; begin ItemNo := SWord; XOffset := LeftEdge; CurrentY := CurrentY + LineHeight(SWord, EWord); While ItemNo < EWord do begin SetPrinter(ItemNo); YOffset := CurrentY - round(VNudge * Printer.Canvas.TextHeight('I')); // nudge factor to get all sizes font on same baseline Printer.Canvas.TextOut(XOffset, YOffset, WordList.Items[ItemNo]^.AWord); //printer.canvas.Line(XOffset, CurrentY, XOffset + 50, CurrentY); //printer.canvas.Line(XOffset, YOffset, XOffset + 50, YOffset); XOffset := XOffset + Printer.Canvas.TextWidth(WordList.Items[ItemNo]^.AWord); //St := St + WordList.Items[ItemNo]^.AWord; inc(ItemNo); end; if FirstLine then begin printer.canvas.Line(LeftEdge, CurrentY, RightEdge, CurrentY); printer.canvas.Line(LeftEdge, CurrentY+1, RightEdge, CurrentY+1); CurrentY := CurrentY + round(0.5 * BlankLineHeight); FirstLine := False; end; if CurrentY > MaxY then begin Printer.EndDoc; Printer.BeginDoc; CurrentY := round(Printer.PageHeight * Margin); end; // Memo1.Append('Line at ' + inttostr(CurrentY) + '=[' + St + ']'); end; // Up to but not inc EWord. function TKPrn.LineWidth(const SWord, EWord : integer) : integer; var ItemNo : integer; begin Result := 0; ItemNo := SWord; While ItemNo < EWord do begin SetPrinter(ItemNo); Result := Result + Printer.Canvas.TextWidth(WordList.Items[ItemNo]^.AWord); inc(ItemNo); end; end; function TKPrn.LineHeight(const SWord, EWord: integer): integer; var ItemNo : integer; begin ItemNo := SWord; Result := 0; While ItemNo < EWord do begin SetPrinter(ItemNo); if Printer.Canvas.TextHeight('I') > Result then Result := Printer.Canvas.TextHeight('I'); inc(ItemNo); end; Result := Result + Round(0.2 * BlankLineHeight); //writeln('Line Height=' + inttostr(Result)); end; procedure TKPrn.CopyFont(FromFont, ToFont : TFont); begin ToFont.Bold := FromFont.Bold; ToFont.Italic := FromFont.Italic; ToFont.Size := FromFont.Size; ToFont.Color := FromFont.Color; end; function TKPrn.KMemoRead(const TheKMemo : TKMemo) : boolean; var BlockNo : integer = 0; I : integer; ExFont : TFont; St : ANSIString = ''; begin if WordList <> Nil then WordList.Free; WordList := TWordList.Create; ExFont := TFont.Create(); CopyFont(TKMemoTextBlock(TheKmemo.Blocks.Items[0]).TextStyle.Font, ExFont); // Carefull, what if its a Para ? for BlockNo := 0 to TheKMemo.Blocks.Count-1 do begin if not TheKMemo.Blocks.Items[BlockNo].ClassNameIs('TKMemoParagraph') then begin CopyFont(TKMemoTextBlock(TheKmemo.Blocks.Items[BlockNo]).TextStyle.Font, ExFont); for I := 0 to TheKMemo.Blocks.Items[BlockNo].WordCount-1 do begin St := TheKMemo.Blocks.Items[BlockNo].Words[I]; WordList.Add(St, ExFont.Size, ExFont.Bold, ExFont.Italic, False, ExFont.Color); end; end else WordList.Add('', ExFont.Size, ExFont.Bold, ExFont.Italic, True, ExFont.Color); end; FreeandNil(ExFont); result := (WordList.Count > 1); //WordList.Dump(); end; end. tomboy-ng_0.39-1/source/jsontools.pas0000644000175000017500000010412714551457644017503 0ustar dbannondbannon(********************************************************) (* *) (* Json Tools Pascal Unit *) (* A small json parser with no dependencies *) (* *) (* http://www.getlazarus.org/json *) (* Dual licence GPLv3 LGPLv3 released August 2019 *) (* *) (********************************************************) unit JsonTools; {$mode delphi} interface uses Classes, SysUtils; { EJsonException is the exception type used by TJsonNode. It is thrown during parse if the string is invalid json or if an attempt is made to access a non collection by name or index. } type EJsonException = class(Exception); { TJsonNodeKind is 1 of 6 possible values described below } TJsonNodeKind = ( { Object such as { } nkObject, { Array such as [ ] } nkArray, { The literal values true or false } nkBool, { The literal value null } nkNull, { A number value such as 123, 1.23e2, or -1.5 } nkNumber, { A string such as "hello\nworld!" } nkString); TJsonNode = class; { TJsonNodeEnumerator is used to enumerate 'for ... in' statements } TJsonNodeEnumerator = record private FNode: TJsonNode; FIndex: Integer; public procedure Init(Node: TJsonNode); function GetCurrent: TJsonNode; function MoveNext: Boolean; property Current: TJsonNode read GetCurrent; end; { TJsonNode is the class used to parse, build, and navigate a json document. You should only create and free the root node of your document. The root node will manage the lifetime of all children through methods such as Add, Delete, and Clear. When you create a TJsonNode node it will have no parent and is considered to be the root node. The root node must be either an array or an object. Attempts to convert a root to anything other than array or object will raise an exception. Note: The parser supports unicode by converting unicode characters escaped as values such as \u20AC. If your json string has an escaped unicode character it will be unescaped when converted to a pascal string. See also: JsonStringDecode to convert a JSON string to a normal string JsonStringEncode to convert a normal string to a JSON string } TJsonNode = class private FStack: Integer; FParent: TJsonNode; FName: string; FKind: TJsonNodeKind; FValue: string; FList: TList; procedure ParseObject(Node: TJsonNode; var C: PChar); procedure ParseArray(Node: TJsonNode; var C: PChar); procedure Error(const Msg: string = ''); function Format(const Indent: string): string; function FormatCompact: string; function Add(Kind: TJsonNodeKind; const Name, Value: string): TJsonNode; overload; function GetRoot: TJsonNode; procedure SetKind(Value: TJsonNodeKind); function GetName: string; procedure SetName(const Value: string); function GetValue: string; function GetCount: Integer; function GetAsJson: string; function GetAsArray: TJsonNode; function GetAsObject: TJsonNode; function GetAsNull: TJsonNode; function GetAsBoolean: Boolean; procedure SetAsBoolean(Value: Boolean); function GetAsString: string; procedure SetAsString(const Value: string); function GetAsNumber: Double; procedure SetAsNumber(Value: Double); public { A parent node owns all children. Only destroy a node if it has no parent. To destroy a child node use Delete or Clear methods instead. } destructor Destroy; override; { GetEnumerator adds 'for ... in' statement support } function GetEnumerator: TJsonNodeEnumerator; { Loading and saving methods } procedure LoadFromStream(Stream: TStream); procedure SaveToStream(Stream: TStream); procedure LoadFromFile(const FileName: string); procedure SaveToFile(const FileName: string); { Convert a json string into a value or a collection of nodes. If the current node is root then the json must be an array or object. } procedure Parse(const Json: string); { The same as Parse, but returns true if no exception is caught } function TryParse(const Json: string): Boolean; { Add a child node by node kind. If the current node is an array then the name parameter will be discarded. If the current node is not an array or object the Add methods will convert the node to an object and discard its current value. Note: If the current node is an object then adding an existing name will overwrite the matching child node instead of adding. } function Add(const Name: string; K: TJsonNodeKind = nkObject): TJsonNode; overload; function Add(const Name: string; B: Boolean): TJsonNode; overload; function Add(const Name: string; const N: Double): TJsonNode; overload; function Add(const Name: string; const S: string): TJsonNode; overload; { Convert to an array and add an item } function Add: TJsonNode; overload; { Delete a child node by index or name } procedure Delete(Index: Integer); overload; procedure Delete(const Name: string); overload; { Remove all child nodes } procedure Clear; { Get a child node by index. EJsonException is raised if node is not an array or object or if the index is out of bounds. See also: Count } function Child(Index: Integer): TJsonNode; overload; { Get a child node by name. If no node is found nil will be returned. } function Child(const Name: string): TJsonNode; overload; { Search for a node using a path string and return true if exists } function Exists(const Path: string): Boolean; { Search for a node using a path string } function Find(const Path: string): TJsonNode; overload; { Search for a node using a path string and return true if exists } function Find(const Path: string; out Node: TJsonNode): Boolean; overload; { Force a series of nodes to exist and return the end node } function Force(const Path: string): TJsonNode; { Format the node and all its children as json } function ToString: string; override; { Root node is read only. A node the root when it has no parent. } property Root: TJsonNode read GetRoot; { Parent node is read only } property Parent: TJsonNode read FParent; { Kind can also be changed using the As methods. Note: Changes to Kind cause Value to be reset to a default value. } property Kind: TJsonNodeKind read FKind write SetKind; { Name is unique within the scope } property Name: string read GetName write SetName; { Value of the node in json e.g. '[]', '"hello\nworld!"', 'true', or '1.23e2' } property Value: string read GetValue write Parse; { The number of child nodes. If node is not an object or array this property will return 0. } property Count: Integer read GetCount; { AsJson is the more efficient version of Value. Text returned from AsJson is the most compact representation of the node in json form. Note: If you are writing a services to transmit or receive json data then use AsJson. If you want friendly human readable text use Value. } property AsJson: string read GetAsJson write Parse; { Convert the node to an array } property AsArray: TJsonNode read GetAsArray; { Convert the node to an object } property AsObject: TJsonNode read GetAsObject; { Convert the node to null } property AsNull: TJsonNode read GetAsNull; { Convert the node to a bool } property AsBoolean: Boolean read GetAsBoolean write SetAsBoolean; { Convert the node to a string } property AsString: string read GetAsString write SetAsString; { Convert the node to a number } property AsNumber: Double read GetAsNumber write SetAsNumber; end; { JsonValidate tests if a string contains a valid json format } function JsonValidate(const Json: string): Boolean; { JsonNumberValidate tests if a string contains a valid json formatted number } function JsonNumberValidate(const N: string): Boolean; { JsonStringValidate tests if a string contains a valid json formatted string } function JsonStringValidate(const S: string): Boolean; { JsonStringEncode converts a pascal string to a json string } function JsonStringEncode(const S: string): string; { JsonStringEncode converts a json string to a pascal string } function JsonStringDecode(const S: string): string; { JsonStringEncode converts a json string to xml } function JsonToXml(const S: string): string; implementation resourcestring SNodeNotCollection = 'Node is not a container'; SRootNodeKind = 'Root node must be an array or object'; SIndexOutOfBounds = 'Index out of bounds'; SParsingError = 'Error while parsing text'; type TJsonTokenKind = (tkEnd, tkError, tkObjectOpen, tkObjectClose, tkArrayOpen, tkArrayClose, tkColon, tkComma, tkNull, tkFalse, tkTrue, tkString, tkNumber); TJsonToken = record Head: PChar; Tail: PChar; Kind: TJsonTokenKind; function Value: string; end; const Hex = ['0'..'9', 'A'..'F', 'a'..'f']; function TJsonToken.Value: string; begin case Kind of tkEnd: Result := #0; tkError: Result := #0; tkObjectOpen: Result := '{'; tkObjectClose: Result := '}'; tkArrayOpen: Result := '['; tkArrayClose: Result := ']'; tkColon: Result := ':'; tkComma: Result := ','; tkNull: Result := 'null'; tkFalse: Result := 'false'; tkTrue: Result := 'true'; else SetString(Result, Head, Tail - Head); end; end; function NextToken(var C: PChar; out T: TJsonToken): Boolean; begin if C^ > #0 then if C^ <= ' ' then repeat Inc(C); if C^ = #0 then Break; until C^ > ' '; T.Head := C; T.Tail := C; T.Kind := tkEnd; if C^ = #0 then Exit(False); if C^ = '{' then begin Inc(C); T.Tail := C; T.Kind := tkObjectOpen; Exit(True); end; if C^ = '}' then begin Inc(C); T.Tail := C; T.Kind := tkObjectClose; Exit(True); end; if C^ = '[' then begin Inc(C); T.Tail := C; T.Kind := tkArrayOpen; Exit(True); end; if C^ = ']' then begin Inc(C); T.Tail := C; T.Kind := tkArrayClose; Exit(True); end; if C^ = ':' then begin Inc(C); T.Tail := C; T.Kind := tkColon; Exit(True); end; if C^ = ',' then begin Inc(C); T.Tail := C; T.Kind := tkComma; Exit(True); end; if (C[0] = 'n') and (C[1] = 'u') and (C[2] = 'l') and (C[3] = 'l') then begin Inc(C, 4); T.Tail := C; T.Kind := tkNull; Exit(True); end; if (C[0] = 'f') and (C[1] = 'a') and (C[2] = 'l') and (C[3] = 's') and (C[4] = 'e') then begin Inc(C, 5); T.Tail := C; T.Kind := tkFalse; Exit(True); end; if (C[0] = 't') and (C[1] = 'r') and (C[2] = 'u') and (C[3] = 'e') then begin Inc(C, 4); T.Tail := C; T.Kind := tkTrue; Exit(True); end; if C^ = '"' then begin repeat Inc(C); if C^ = '\' then begin Inc(C); if C^ < ' ' then begin T.Tail := C; T.Kind := tkError; Exit(False); end; if C^ = 'u' then if not ((C[1] in Hex) and (C[2] in Hex) and (C[3] in Hex) and (C[4] in Hex)) then begin T.Tail := C; T.Kind := tkError; Exit(False); end; end else if C^ = '"' then begin Inc(C); T.Tail := C; T.Kind := tkString; Exit(True); end; until C^ in [#0, #10, #13]; T.Tail := C; T.Kind := tkError; Exit(False); end; if C^ in ['-', '0'..'9'] then begin if C^ = '-' then Inc(C); if C^ in ['0'..'9'] then begin while C^ in ['0'..'9'] do Inc(C); if C^ = '.' then begin Inc(C); if C^ in ['0'..'9'] then begin while C^ in ['0'..'9'] do Inc(C); end else begin T.Tail := C; T.Kind := tkError; Exit(False); end; end; if C^ in ['E', 'e'] then begin Inc(C); if C^ = '+' then Inc(C) else if C^ = '-' then Inc(C); if C^ in ['0'..'9'] then begin while C^ in ['0'..'9'] do Inc(C); end else begin T.Tail := C; T.Kind := tkError; Exit(False); end; end; T.Tail := C; T.Kind := tkNumber; Exit(True); end; end; T.Kind := tkError; Result := False; end; { TJsonNodeEnumerator } procedure TJsonNodeEnumerator.Init(Node: TJsonNode); begin FNode := Node; FIndex := -1; end; function TJsonNodeEnumerator.GetCurrent: TJsonNode; begin if FNode.FList = nil then Result := nil else if FIndex < 0 then Result := nil else if FIndex < FNode.FList.Count then Result := TJsonNode(FNode.FList[FIndex]) else Result := nil; end; function TJsonNodeEnumerator.MoveNext: Boolean; begin Inc(FIndex); if FNode.FList = nil then Result := False else Result := FIndex < FNode.FList.Count; end; { TJsonNode } destructor TJsonNode.Destroy; begin Clear; inherited Destroy; end; function TJsonNode.GetEnumerator: TJsonNodeEnumerator; begin Result.Init(Self); end; procedure TJsonNode.LoadFromStream(Stream: TStream); var S: string; I: Int64; begin I := Stream.Size - Stream.Position; S := ''; SetLength(S, I); Stream.Read(PChar(S)^, I); Parse(S); end; procedure TJsonNode.SaveToStream(Stream: TStream); var S: string; I: Int64; begin S := Value; I := Length(S); Stream.Write(PChar(S)^, I); end; procedure TJsonNode.LoadFromFile(const FileName: string); var F: TFileStream; begin F := TFileStream.Create(FileName, fmOpenRead); try LoadFromStream(F); finally F.Free; end; end; procedure TJsonNode.SaveToFile(const FileName: string); var F: TFileStream; begin F := TFileStream.Create(FileName, fmCreate); try SaveToStream(F); finally F.Free; end; end; const MaxStack = 1000; procedure TJsonNode.ParseObject(Node: TJsonNode; var C: PChar); var T: TJsonToken; N: string = ''; begin Inc(FStack); if FStack > MaxStack then Error; while NextToken(C, T) do begin case T.Kind of tkString: N := JsonStringDecode(T.Value); tkObjectClose: begin Dec(FStack); Exit; end else Error; end; NextToken(C, T); if T.Kind <> tkColon then Error; NextToken(C, T); case T.Kind of tkObjectOpen: ParseObject(Node.Add(nkObject, N, ''), C); tkArrayOpen: ParseArray(Node.Add(nkArray, N, ''), C); tkNull: Node.Add(nkNull, N, 'null'); tkFalse: Node.Add(nkBool, N, 'false'); tkTrue: Node.Add(nkBool, N, 'true'); tkString: Node.Add(nkString, N, T.Value); tkNumber: Node.Add(nkNumber, N, T.Value); else Error; end; NextToken(C, T); if T.Kind = tkComma then Continue; if T.Kind = tkObjectClose then begin Dec(FStack); Exit; end; Error; end; Error; end; procedure TJsonNode.ParseArray(Node: TJsonNode; var C: PChar); var T: TJsonToken; begin Inc(FStack); if FStack > MaxStack then Error; while NextToken(C, T) do begin case T.Kind of tkObjectOpen: ParseObject(Node.Add(nkObject, '', ''), C); tkArrayOpen: ParseArray(Node.Add(nkArray, '', ''), C); tkNull: Node.Add(nkNull, '', 'null'); tkFalse: Node.Add(nkBool, '', 'false'); tkTrue: Node.Add(nkBool, '', 'true'); tkString: Node.Add(nkString, '', T.Value); tkNumber: Node.Add(nkNumber, '', T.Value); tkArrayClose: begin Dec(FStack); Exit; end else Error; end; NextToken(C, T); if T.Kind = tkComma then Continue; if T.Kind = tkArrayClose then begin Dec(FStack); Exit; end; Error; end; Error; end; procedure TJsonNode.Parse(const Json: string); var C: PChar; T: TJsonToken; begin Clear; C := PChar(Json); if FParent = nil then begin if NextToken(C, T) and (T.Kind in [tkObjectOpen, tkArrayOpen]) then begin try if T.Kind = tkObjectOpen then begin FKind := nkObject; ParseObject(Self, C); end else begin FKind := nkArray; ParseArray(Self, C); end; NextToken(C, T); if T.Kind <> tkEnd then Error; except Clear; raise; end; end else Error(SRootNodeKind); end else begin NextToken(C, T); case T.Kind of tkObjectOpen: begin FKind := nkObject; ParseObject(Self, C); end; tkArrayOpen: begin FKind := nkArray; ParseArray(Self, C); end; tkNull: begin FKind := nkNull; FValue := 'null'; end; tkFalse: begin FKind := nkBool; FValue := 'false'; end; tkTrue: begin FKind := nkBool; FValue := 'true'; end; tkString: begin FKind := nkString; FValue := T.Value; end; tkNumber: begin FKind := nkNumber; FValue := T.Value; end; else Error; end; NextToken(C, T); if T.Kind <> tkEnd then begin Clear; Error; end; end; end; function TJsonNode.TryParse(const Json: string): Boolean; begin try Parse(Json); Result := True; except Result := False; end; end; procedure TJsonNode.Error(const Msg: string = ''); begin FStack := 0; if Msg = '' then raise EJsonException.Create(SParsingError) else raise EJsonException.Create(Msg); end; function TJsonNode.GetRoot: TJsonNode; begin Result := Self; while Result.FParent <> nil do Result := Result.FParent; end; procedure TJsonNode.SetKind(Value: TJsonNodeKind); begin if Value = FKind then Exit; case Value of nkObject: AsObject; nkArray: AsArray; nkBool: AsBoolean; nkNull: AsNull; nkNumber: AsNumber; nkString: AsString; end; end; function TJsonNode.GetName: string; begin if FParent = nil then Exit('0'); if FParent.FKind = nkArray then Result := IntToStr(FParent.FList.IndexOf(Self)) else Result := FName; end; procedure TJsonNode.SetName(const Value: string); var N: TJsonNode; begin if FParent = nil then Exit; if FParent.FKind = nkArray then Exit; N := FParent.Child(Value); if N = Self then Exit; FParent.FList.Remove(N); FName := Value; end; function TJsonNode.GetValue: string; begin if FKind in [nkObject, nkArray] then Result := Format('') else Result := FValue; end; function TJsonNode.GetAsJson: string; begin if FKind in [nkObject, nkArray] then Result := FormatCompact else Result := FValue; end; function TJsonNode.GetAsArray: TJsonNode; begin if FKind <> nkArray then begin Clear; FKind := nkArray; FValue := ''; end; Result := Self; end; function TJsonNode.GetAsObject: TJsonNode; begin if FKind <> nkObject then begin Clear; FKind := nkObject; FValue := ''; end; Result := Self; end; function TJsonNode.GetAsNull: TJsonNode; begin if FParent = nil then Error(SRootNodeKind); if FKind <> nkNull then begin Clear; FKind := nkNull; FValue := 'null'; end; Result := Self; end; function TJsonNode.GetAsBoolean: Boolean; begin if FParent = nil then Error(SRootNodeKind); if FKind <> nkBool then begin Clear; FKind := nkBool; FValue := 'false'; Exit(False); end; Result := FValue = 'true'; end; procedure TJsonNode.SetAsBoolean(Value: Boolean); begin if FParent = nil then Error(SRootNodeKind); if FKind <> nkBool then begin Clear; FKind := nkBool; end; if Value then FValue := 'true' else FValue := 'false'; end; function TJsonNode.GetAsString: string; begin if FParent = nil then Error(SRootNodeKind); if FKind <> nkString then begin Clear; FKind := nkString; FValue := '""'; Exit(''); end; Result := JsonStringDecode(FValue); end; procedure TJsonNode.SetAsString(const Value: string); begin if FParent = nil then Error(SRootNodeKind); if FKind <> nkString then begin Clear; FKind := nkString; end; FValue := JsonStringEncode(Value); end; function TJsonNode.GetAsNumber: Double; begin if FParent = nil then Error(SRootNodeKind); if FKind <> nkNumber then begin Clear; FKind := nkNumber; FValue := '0'; Exit(0); end; Result := StrToFloatDef(FValue, 0); end; procedure TJsonNode.SetAsNumber(Value: Double); begin if FParent = nil then Error(SRootNodeKind); if FKind <> nkNumber then begin Clear; FKind := nkNumber; end; FValue := FloatToStr(Value); end; function TJsonNode.Add: TJsonNode; begin Result := AsArray.Add(''); end; function TJsonNode.Add(Kind: TJsonNodeKind; const Name, Value: string): TJsonNode; var S: string; begin Result := Nil; // DRB if not (FKind in [nkArray, nkObject]) then if Name = '' then AsArray else AsObject; if FKind in [nkArray, nkObject] then begin if FList = nil then FList := TList.Create; if FKind = nkArray then S := IntToStr(FList.Count) else S := Name; Result := Child(S); if Result = nil then begin Result := TJsonNode.Create; Result.FName := S; FList.Add(Result); end; if Kind = nkNull then Result.FValue := 'null' else if Kind in [nkBool, nkString, nkNumber] then Result.FValue := Value else begin Result.FValue := ''; Result.Clear; end; Result.FParent := Self; Result.FKind := Kind; end else Error(SNodeNotCollection); end; function TJsonNode.Add(const Name: string; K: TJsonNodeKind = nkObject): TJsonNode; overload; begin Result := nil; // DRB case K of nkObject, nkArray: Result := Add(K, Name, ''); nkNull: Result := Add(K, Name, 'null'); nkBool: Result := Add(K, Name, 'false'); nkNumber: Result := Add(K, Name, '0'); nkString: Result := Add(K, Name, '""'); end; end; function TJsonNode.Add(const Name: string; B: Boolean): TJsonNode; overload; const Bools: array[Boolean] of string = ('false', 'true'); begin Result := Add(nkBool, Name, Bools[B]); end; function TJsonNode.Add(const Name: string; const N: Double): TJsonNode; overload; begin Result := Add(nkNumber, Name, FloatToStr(N)); end; function TJsonNode.Add(const Name: string; const S: string): TJsonNode; overload; begin Result := Add(nkString, Name, JsonStringEncode(S)); end; procedure TJsonNode.Delete(Index: Integer); var N: TJsonNode; begin N := Child(Index); if N <> nil then begin FList.Delete(Index); if FList.Count = 0 then begin FList.Free; FList := nil; end; end; end; procedure TJsonNode.Delete(const Name: string); var N: TJsonNode; begin N := Child(Name); if N <> nil then begin FList.Remove(N); if FList.Count = 0 then begin FList.Free; FList := nil; end; end; end; procedure TJsonNode.Clear; var I: Integer; begin if FList <> nil then begin for I := 0 to FList.Count - 1 do TObject(FList[I]).Free; FList.Free; FList := nil; end; end; function TJsonNode.Child(Index: Integer): TJsonNode; begin result := Nil; // DRB if FKind in [nkArray, nkObject] then begin if FList = nil then Error(SIndexOutOfBounds); if (Index < 0) or (Index > FList.Count - 1) then Error(SIndexOutOfBounds); Result := TJsonNode(FList[Index]); end else Error(SNodeNotCollection); end; function TJsonNode.Child(const Name: string): TJsonNode; var N: TJsonNode; I: Integer; begin Result := nil; if (FList <> nil) and (FKind in [nkArray, nkObject]) then if FKind = nkArray then begin I := StrToIntDef(Name, -1); if (I > -1) and (I < FList.Count) then Exit(TJsonNode(FList[I])); end else for I := 0 to FList.Count - 1 do begin N := TJsonNode(FList[I]); if N.FName = Name then Exit(N); end; end; function TJsonNode.Exists(const Path: string): Boolean; begin Result := Find(Path) <> nil; end; function TJsonNode.Find(const Path: string): TJsonNode; var N: TJsonNode; A, B: PChar; S: string; begin Result := nil; if Path = '' then Exit(Child('')); if Path[1] = '/' then begin N := Self; while N.Parent <> nil do N := N.Parent; end else N := Self; A := PChar(Path); if A^ = '/' then begin Inc(A); if A^ = #0 then Exit(N); end; if A^ = #0 then Exit(N.Child('')); B := A; while B^ > #0 do begin if B^ = '/' then begin SetString(S, A, B - A); N := N.Child(S); if N = nil then Exit(nil); A := B + 1; B := A; end else begin Inc(B); if B^ = #0 then begin SetString(S, A, B - A); N := N.Child(S); end; end; end; Result := N; end; function TJsonNode.Find(const Path: string; out Node: TJsonNode): Boolean; begin Node := Find(Path); Result := Node <> nil; end; function TJsonNode.Force(const Path: string): TJsonNode; var N: TJsonNode; A, B: PChar; S: string; begin Result := nil; // AsObject; if Path = '' then begin N := Child(''); if N = nil then N := Add(''); Exit(N); end; if Path[1] = '/' then begin N := Self; while N.Parent <> nil do N := N.Parent; end else N := Self; A := PChar(Path); if A^ = '/' then begin Inc(A); if A^ = #0 then Exit(N); end; if A^ = #0 then begin N := Child(''); if N = nil then N := Add(''); Exit(N); end; B := A; while B^ > #0 do begin if B^ = '/' then begin SetString(S, A, B - A); if N.Child(S) = nil then N := N.Add(S) else N := N.Child(S); A := B + 1; B := A; end else begin Inc(B); if B^ = #0 then begin SetString(S, A, B - A); if N.Child(S) = nil then N := N.Add(S) else N := N.Child(S); end; end; end; Result := N; end; function TJsonNode.Format(const Indent: string): string; function EnumNodes: string; var I, J: Integer; S: string; begin if (FList = nil) or (FList.Count = 0) then Exit(' '); Result := #10; J := FList.Count - 1; S := Indent + #9; for I := 0 to J do begin Result := Result + TJsonNode(FList[I]).Format(S); if I < J then Result := Result + ','#10 else Result := Result + #10 + Indent; end; end; var Prefix: string; begin Result := ''; if (FParent <> nil) and (FParent.FKind = nkObject) then Prefix := JsonStringEncode(FName) + ': ' else Prefix := ''; case FKind of nkObject: Result := Indent + Prefix +'{' + EnumNodes + '}'; nkArray: Result := Indent + Prefix + '[' + EnumNodes + ']'; else Result := Indent + Prefix + FValue; end; end; function TJsonNode.FormatCompact: string; function EnumNodes: string; var I, J: Integer; begin Result := ''; if (FList = nil) or (FList.Count = 0) then Exit; J := FList.Count - 1; for I := 0 to J do begin Result := Result + TJsonNode(FList[I]).FormatCompact; if I < J then Result := Result + ','; end; end; var Prefix: string; begin Result := ''; if (FParent <> nil) and (FParent.FKind = nkObject) then Prefix := JsonStringEncode(FName) + ':' else Prefix := ''; case FKind of nkObject: Result := Prefix + '{' + EnumNodes + '}'; nkArray: Result := Prefix + '[' + EnumNodes + ']'; else Result := Prefix + FValue; end; end; function TJsonNode.ToString: string; begin Result := Format(''); end; function TJsonNode.GetCount: Integer; begin if FList <> nil then Result := FList.Count else Result := 0; end; { Json helper routines } function JsonValidate(const Json: string): Boolean; var N: TJsonNode; begin N := TJsonNode.Create; try Result := N.TryParse(Json); finally N.Free; end; end; function JsonNumberValidate(const N: string): Boolean; var C: PChar; T: TJsonToken; begin C := PChar(N); Result := NextToken(C, T) and (T.Kind = tkNumber) and (T.Value = N); end; function JsonStringValidate(const S: string): Boolean; var C: PChar; T: TJsonToken; begin C := PChar(S); Result := NextToken(C, T) and (T.Kind = tkString) and (T.Value = S); end; { Convert a pascal string to a json string } function JsonStringEncode(const S: string): string; function Len(C: PChar): Integer; var I: Integer; begin I := 0; while C^ > #0 do begin if C^ < ' ' then if C^ in [#8..#13] then Inc(I, 2) else Inc(I, 6) else if C^ in ['"', '\'] then Inc(I, 2) else Inc(I); Inc(C); end; Result := I + 2; end; const EscapeChars: PChar = '01234567btnvfr'; HexChars: PChar = '0123456789ABCDEF'; var C: PChar; R: string; I: Integer; begin if S = '' then Exit('""'); C := PChar(S); R := ''; SetLength(R, Len(C)); R[1] := '"'; I := 2; while C^ > #0 do begin if C^ < ' ' then begin R[I] := '\'; Inc(I); if C^ in [#8..#13] then R[I] := EscapeChars[Ord(C^)] else begin R[I] := 'u'; R[I + 1] := '0'; R[I + 2] := '0'; R[I + 3] := HexChars[Ord(C^) div $10]; R[I + 4] := HexChars[Ord(C^) mod $10]; Inc(I, 4); end; end else if C^ in ['"', '\'] then begin R[I] := '\'; Inc(I); R[I] := C^; end else R[I] := C^; Inc(I); Inc(C); end; R[Length(R)] := '"'; Result := R; end; { Convert a json string to a pascal string } function UnicodeToString(C: LongWord): string; inline; begin if C = 0 then Result := #0 else if C < $80 then Result := Chr(C) else if C < $800 then Result := Chr((C shr $6) + $C0) + Chr((C and $3F) + $80) else if C < $10000 then Result := Chr((C shr $C) + $E0) + Chr(((C shr $6) and $3F) + $80) + Chr((C and $3F) + $80) else if C < $200000 then Result := Chr((C shr $12) + $F0) + Chr(((C shr $C) and $3F) + $80) + Chr(((C shr $6) and $3F) + $80) + Chr((C and $3F) + $80) else Result := ''; end; function UnicodeToSize(C: LongWord): Integer; inline; begin if C = 0 then Result := 1 else if C < $80 then Result := 1 else if C < $800 then Result := 2 else if C < $10000 then Result := 3 else if C < $200000 then Result := 4 else Result := 0; end; function HexToByte(C: Char): Byte; inline; const Zero = Ord('0'); UpA = Ord('A'); LoA = Ord('a'); begin if C < 'A' then Result := Ord(C) - Zero else if C < 'a' then Result := Ord(C) - UpA + 10 else Result := Ord(C) - LoA + 10; end; function HexToInt(A, B, C, D: Char): Integer; inline; begin Result := HexToByte(A) shl 12 or HexToByte(B) shl 8 or HexToByte(C) shl 4 or HexToByte(D); end; function JsonStringDecode(const S: string): string; function Len(C: PChar): Integer; var I, J: Integer; begin if C^ <> '"' then Exit(0); Inc(C); I := 0; while C^ <> '"' do begin if C^ = #0 then Exit(0); if C^ = '\' then begin Inc(C); if C^ = 'u' then begin if (C[1] in Hex) and (C[2] in Hex) and (C[3] in Hex) and (C[4] in Hex) then begin J := UnicodeToSize(HexToInt(C[1], C[2], C[3], C[4])); if J = 0 then Exit(0); Inc(I, J - 1); Inc(C, 4); end else Exit(0); end else if C^ = #0 then Exit(0) end; Inc(C); Inc(I); end; Result := I; end; const Escape = ['b', 't', 'n', 'v', 'f', 'r']; var C: PChar; R: string; I, J: Integer; H: string; begin C := PChar(S); I := Len(C); if I < 1 then Exit(''); R := ''; SetLength(R, I); I := 1; Inc(C); while C^ <> '"' do begin if C^ = '\' then begin Inc(C); if C^ in Escape then case C^ of 'b': R[I] := #8; 't': R[I] := #9; 'n': R[I] := #10; 'v': R[I] := #11; 'f': R[I] := #12; 'r': R[I] := #13; end else if C^ = 'u' then begin H := UnicodeToString(HexToInt(C[1], C[2], C[3], C[4])); for J := 1 to Length(H) - 1 do begin R[I] := H[J]; Inc(I); end; R[I] := H[Length(H)]; Inc(C, 4); end else R[I] := C^; end else R[I] := C^; Inc(C); Inc(I); end; Result := R; end; function JsonToXml(const S: string): string; const Kinds: array[TJsonNodeKind] of string = (' kind="object"', ' kind="array"', ' kind="bool"', ' kind="null"', ' kind="number"', ''); Space = ' '; function Escape(N: TJsonNode): string; begin Result := N.Value; if N.Kind = nkString then begin Result := JsonStringDecode(Result); Result := StringReplace(Result, '<', '<', [rfReplaceAll]); Result := StringReplace(Result, '>', '>', [rfReplaceAll]); end; end; function EnumNodes(P: TJsonNode; const Indent: string): string; var N: TJsonNode; S: string; begin Result := ''; if P.Kind = nkArray then S := 'item' else S := ''; for N in P do begin Result := Result + Indent + '<' + S + N.Name + Kinds[N.Kind]; case N.Kind of nkObject, nkArray: if N.Count > 0 then Result := Result + '>'#10 + EnumNodes(N, Indent + Space) + Indent + ''#10 else Result := Result + '/>'#10; nkNull: Result := Result + '/>'#10; else Result := Result + '>' + Escape(N) + ''#10; end; end; end; var N: TJsonNode; begin Result := ''; N := TJsonNode.Create; try if N.TryParse(S) then begin Result := ''#10 + ' 0 then Result := Result + '>'#10 + EnumNodes(N, Space) + '' else Result := Result + '/>'; end; finally N.Free; end; end; end. tomboy-ng_0.39-1/source/tb_sdiff.lfm0000644000175000017500000004326114551457644017225 0ustar dbannondbannonobject FormSDiff: TFormSDiff Left = 596 Height = 478 Top = 166 Width = 683 VertScrollBar.Visible = False Caption = 'A Note Sync Clash has been Detected' ClientHeight = 478 ClientWidth = 683 OnShow = FormShow LCLVersion = '2.2.0.2' object Panel1: TPanel AnchorSideLeft.Control = Owner AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = BitBtnUseLocal Left = 2 Height = 58 Top = 378 Width = 681 Anchors = [akLeft, akRight, akBottom] BorderSpacing.Left = 2 ClientHeight = 58 ClientWidth = 681 TabOrder = 0 object LabelRemote: TLabel AnchorSideLeft.Control = Label3 AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = Label3 Left = 146 Height = 21 Top = 6 Width = 106 BorderSpacing.Left = 3 Caption = 'LabelRemote' end object LabelLocal: TLabel AnchorSideLeft.Control = LabelRemote AnchorSideTop.Control = Label4 Left = 146 Height = 21 Top = 27 Width = 84 Caption = 'LabelLocal' end object Label3: TLabel AnchorSideLeft.Control = Panel1 AnchorSideTop.Control = Panel1 Left = 6 Height = 21 Top = 6 Width = 137 BorderSpacing.Left = 5 BorderSpacing.Top = 5 Caption = 'Remote Changed' end object Label4: TLabel AnchorSideLeft.Control = Label3 AnchorSideTop.Control = Label3 AnchorSideTop.Side = asrBottom Left = 6 Height = 21 Top = 27 Width = 115 Caption = 'Local Changed' end object RadioLong: TRadioButton Left = 488 Height = 23 Hint = 'Maybe necessary to show difference' Top = 24 Width = 107 Caption = 'Long Lines' OnChange = RadioLongChange ParentShowHint = False ShowHint = True TabOrder = 0 end object RadioShort: TRadioButton Left = 488 Height = 23 Hint = 'Easier to read' Top = 1 Width = 111 Caption = 'Short Lines' Checked = True ParentShowHint = False ShowHint = True TabOrder = 1 TabStop = True end end object Label1: TLabel AnchorSideBottom.Control = ButtAllRemote Left = 16 Height = 21 Top = 431 Width = 334 Anchors = [akBottom] Caption = 'Or make a choice for remainder of this run' end object ButtAllOldest: TButton AnchorSideRight.Control = BitBtnUseRemote AnchorSideBottom.Control = Owner AnchorSideBottom.Side = asrBottom Left = 322 Height = 25 Top = 452 Width = 101 Anchors = [akRight, akBottom] BorderSpacing.Bottom = 1 Caption = 'Oldest' ModalResult = 11 TabOrder = 1 end object ButtAllNewest: TButton AnchorSideRight.Control = ButtAllOldest AnchorSideBottom.Control = Owner AnchorSideBottom.Side = asrBottom Left = 222 Height = 25 Top = 452 Width = 100 Anchors = [akRight, akBottom] BorderSpacing.Bottom = 1 Caption = 'Newest' ModalResult = 8 TabOrder = 2 end object ButtAllLocal: TButton AnchorSideRight.Control = ButtAllNewest AnchorSideBottom.Control = Owner AnchorSideBottom.Side = asrBottom Left = 147 Height = 25 Top = 452 Width = 75 Anchors = [akRight, akBottom] BorderSpacing.Bottom = 1 Caption = 'Local' ModalResult = 9 TabOrder = 3 end object ButtAllRemote: TButton AnchorSideRight.Control = ButtAllLocal AnchorSideBottom.Control = Owner AnchorSideBottom.Side = asrBottom Left = 72 Height = 25 Top = 452 Width = 75 Anchors = [akRight, akBottom] BorderSpacing.Bottom = 1 Caption = 'Remote' ModalResult = 10 TabOrder = 4 end object BitBtnUseLocal: TBitBtn AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = Owner AnchorSideBottom.Side = asrBottom Left = 553 Height = 42 Top = 436 Width = 130 Anchors = [akRight, akBottom] Caption = 'Use Local' Color = clAqua Glyph.Data = { 760B0000424D760B000000000000360000002800000014000000240000000100 200000000000400B000064000000640000000000000000000000FFFF00EAFFFF 00F3FFFF00F3FFFF00F3FFFF00F3FFFF00F3FFFF00F3FFFF00F3FFFF00F3FFFF 00F3FFFF00F3FFFF00F3FFFF00F3FFFF00F3FFFF00F3FFFF00F3FFFF00F3FFFF 00F3FFFF00F3FFFF00EAFFFF00F3FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00F3FFFF00F3FFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00F3FFFF00F3FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00F3FFFF00F3FFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00F3FFFF00F3FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00F3FFFF00F3FFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00F3FFFF00F3FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00F3FFFF00F3FFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00F3FFFF00F3FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00F3FFFF00F3FFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00F3FFFF00F3FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00F3FFFF00F3FFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00F3FFFF00F3FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00F3FFFF00F3FFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00F3FFFF00F3FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00F3FFFF00F3FFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00F3FFFF00F3FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00F3FFFF00F3FFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00F3FFFF00F3FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00F3FFFF00F3FFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00F3FFFF00F3FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00F3FFFF00F3FFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00F3FFFF00F3FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00F3FFFF00F3FFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00F3FFFF00F3FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00F3FFFF00F3FFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00F3FFFF00F3FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00F3FFFF00F3FFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00F3FFFF00F3FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00F3FFFF00F3FFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00F3FFFF00F3FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00F3FFFF00F3FFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00F3FFFF00F3FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00F3FFFF00F3FFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF 00FFFFFF00FFFFFF00F3FFFF00EAFFFF00F3FFFF00F3FFFF00F3FFFF00F3FFFF 00F3FFFF00F3FFFF00F3FFFF00F3FFFF00F3FFFF00F3FFFF00F3FFFF00F3FFFF 00F3FFFF00F3FFFF00F3FFFF00F3FFFF00F3FFFF00F3FFFF00EA } ModalResult = 7 TabOrder = 5 end object BitBtnUseRemote: TBitBtn AnchorSideRight.Control = BitBtnUseLocal AnchorSideBottom.Control = Owner AnchorSideBottom.Side = asrBottom Left = 423 Height = 42 Top = 436 Width = 130 Anchors = [akRight, akBottom] Caption = 'Use Remote' Color = clYellow Glyph.Data = { 760B0000424D760B000000000000360000002800000014000000240000000100 200000000000400B00006400000064000000000000000000000039FFC6EA1DFF E2F31DFFE2F31DFFE2F31DFFE2F31DFFE2F31DFFE2F31DFFE2F31DFFE2F31DFF E2F31DFFE2F31DFFE2F31DFFE2F31DFFE2F31DFFE2F31DFFE2F31DFFE2F31DFF E2F31DFFE2F339FFC6EA1DFFE2F300FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF1DFFE2F31DFFE2F300FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF1DFFE2F31DFFE2F300FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF1DFFE2F31DFFE2F300FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF1DFFE2F31DFFE2F300FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF1DFFE2F31DFFE2F300FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF1DFFE2F31DFFE2F300FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF1DFFE2F31DFFE2F300FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF1DFFE2F31DFFE2F300FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF1DFFE2F31DFFE2F300FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF1DFFE2F31DFFE2F300FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF1DFFE2F31DFFE2F300FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF1DFFE2F31DFFE2F300FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF1DFFE2F31DFFE2F300FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF1DFFE2F31DFFE2F300FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF1DFFE2F31DFFE2F300FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF1DFFE2F31DFFE2F300FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF1DFFE2F31DFFE2F300FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF1DFFE2F31DFFE2F300FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF1DFFE2F31DFFE2F300FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF1DFFE2F31DFFE2F300FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF1DFFE2F31DFFE2F300FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF1DFFE2F31DFFE2F300FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF1DFFE2F31DFFE2F300FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF1DFFE2F31DFFE2F300FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF1DFFE2F31DFFE2F300FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF1DFFE2F31DFFE2F300FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF1DFFE2F31DFFE2F300FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF1DFFE2F31DFFE2F300FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF1DFFE2F31DFFE2F300FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF1DFFE2F31DFFE2F300FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF1DFFE2F31DFFE2F300FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF1DFFE2F31DFFE2F300FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF1DFFE2F31DFFE2F300FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF FFFF00FFFFFF1DFFE2F339FFC6EA1DFFE2F31DFFE2F31DFFE2F31DFFE2F31DFF E2F31DFFE2F31DFFE2F31DFFE2F31DFFE2F31DFFE2F31DFFE2F31DFFE2F31DFF E2F31DFFE2F31DFFE2F31DFFE2F31DFFE2F31DFFE2F339FFC6EA } ModalResult = 6 TabOrder = 6 end object KMemo1: TKMemo AnchorSideLeft.Control = Owner AnchorSideTop.Control = Owner AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = Panel1 Left = 0 Height = 378 Top = 0 Width = 683 Anchors = [akTop, akLeft, akRight, akBottom] ContentPadding.Left = 5 ContentPadding.Top = 5 ContentPadding.Right = 5 ContentPadding.Bottom = 5 ParentFont = False TabOrder = 7 Visible = True OnChange = KMemo1Change end end tomboy-ng_0.39-1/source/notebook.pas0000644000175000017500000006245614551457644017301 0ustar dbannondbannonunit Notebook; { Copyright (C) 2017-2021 David Bannon License: This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html ------------------ This GUI based unit has a form to allow user to see and select what notebooks the current note is a member of. It looks at settings to see if we are allowing a particular note to be a member of more than one notebook. If not, will cancel a previous choice if a user selects a new notebook. This form is created dynamically and shown modal, the user can only open one at a time. If shown non-modal, there is a danger form will get lost .... History - 2018/01/30 -replaced the function that cancels previous Notebook selection when a new one is made (if settings so demand). This one works on Macs and is a better job on the other platforms too. 2018/04/13 Now call NotebookPick Form dynamically and ShowModal to ensure two notes don't share. 2018/05/12 Extensive changes - MainUnit is now just that. Only change here relates to naming of MainUnit and SearchUnit. 2019/05/18 Corrected alignment Label1 and 3 2019/05/19 Display strings all (?) moved to resourcestrings 2020/02/19 Do not escape new notebook title as sent to notelister. 2020/05/19 Do not go through ButtonOKOnClick if ModalResult is already set to mrOK 2020/08/10 In Windows, SetFocus was setting ModalRes to 1, so, would immediatly close ?? 2021/11/04 Extensive changes to support new Notebook management model from SearchForm 2021/12/26 MakeNewNoteBook may have returned random bool. } {$mode objfpc}{$H+} interface uses Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, CheckLst, ExtCtrls, StdCtrls, Buttons, ComCtrls; type NotebookMode = ( // Changing name of a notebook, need Name in .... nbChangeName, // Open in TabChangeName, hide all others. Call from Search // Set the Notebooks a note is in, need FullFileName, Title. Call from nbSetNoteBooks, // the note itself. Open in TabExisting, also show TabNewNoteBook, hide others // Make a new NoteBook, nbMakeNewNoteBook, // Open in TabNewNoteBook, also show but disable TabSetNotes, hide others // Set the notes that are a member of this noteook, need NBName nbSetNotesInNoteBook // Open in TabSetNotes, hide all others ); type { TNoteBookPick } TNoteBookPick = class(TForm) Button1: TButton; ButtonOK: TButton; CheckListBox1: TCheckListBox; CheckListAddNotes: TCheckListBox; EditNewNotebookName: TEdit; EditNewNotebook: TEdit; Label1: TLabel; Label2: TLabel; Label3: TLabel; Label4: TLabel; Label5: TLabel; Label6: TLabel; Label7: TLabel; Label8: TLabel; Label9: TLabel; PageControl1: TPageControl; Panel1: TPanel; TabExisting: TTabSheet; TabNewNoteBook: TTabSheet; TabChangeName: TTabSheet; TabSetNotes: TTabSheet; procedure ButtonOKClick(Sender: TObject); procedure CheckListBox1ItemClick(Sender: TObject; Index: integer); procedure EditNewNotebookKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure EditNewNotebookNameEditingDone(Sender: TObject); procedure FormShow(Sender: TObject); procedure SetupForAddNotes(); procedure TabNewNoteBookShow(Sender: TObject); private { A list pointer that will point to list of notes that are members of the notebook who's name we are about to change } NBIDList : TStringList; { Actually do all the stuff necessary when we change a notebook name } procedure AdjustNBookNotes(); function ChangeNoteBookName(NewName: string): boolean; procedure InsertNoteBookTag(const FullFileName, NB: string); function MakeNewNoteBook: boolean; function RewriteTempate(const FileName, NewName: string ): boolean; function RewriteWithNewNotebookName(FileName: string): boolean; procedure SetNoteBooks; { User wants to change the name of a Notebook, Title is name of Notebook } procedure SetupForChange(); { Allow user to select an existing Notebook or make a new one } procedure SetupForNewSelect(); public TheMode : NoteBookMode; // Just what are we doing here ? FullFileName : ANSIString; // The filename of the Note that invoked self. So, apply to this note oonly. Title : ANSIString; // Title of note that invoked self. NBName : string; // Notebook Name, means we are working with just this notebook. ChangeMode : boolean; // Indicates we wish to rename existing notebook. end; {var NoteBookPick: TNoteBookPick; } implementation {$R *.lfm} { TNoteBookPick } uses SearchUnit, LazFileUtils, LCLProc, LCLType, Settings, SaveNote, EditBox, resourcestr, tb_utils, note_lister {$ifdef WINDOWS}, SyncUtils{$endif}; // SafeWindowsDelete procedure TNoteBookPick.SetupForNewSelect(); var //SL : TStringList; NBArray : TStringArray; Index, I : Integer; begin PageControl1.ActivePage := TabExisting; TabExisting.TabVisible := True; TabNewNotebook.TabVisible := True; TabSetNotes.TabVisible := False; TabChangeName.TabVisible := False; Label1.Caption := Title; Label3.Caption := rsSetTheNotebooks; TheMainNoteLister.GetNotebooks(NBArray, ''); for i := 0 to High(NBArray) do CheckListBox1.Items.Add(NBArray[i]); TheMainNoteLister.GetNotebooks(NBArray, ExtractFileNameOnly(FullFileName) + '.note'); for I := 0 to CheckListBox1.Count-1 do CheckListBox1.Checked[I] := False; for Index := 0 to High(NBArray) do for I := 0 to CheckListBox1.Count-1 do if NBArray[Index] = CheckListBox1.Items[I] then CheckListBox1.Checked[I] := True; end; procedure TNoteBookPick.SetupForChange(); {var NoteID : String;} begin // Note : NBIDList does not need to be created or freed. Just a pointer. PageControl1.ActivePage := TabChangeName; TabNewNotebook.TabVisible := False; TabSetNotes.TabVisible := False; TabChangeName.TabVisible := True; TabExisting.TabVisible := False; Label3.Caption := rsChangeNameofNotebook; Label7.Caption := Title; if not TheMainNoteLister.GetNotesInNoteBook(NBIDList, Title) then debugln('ERROR - Notebook.pas #152 No member notes found'); Label1.Caption := format(rsNumbNotesAffected, [NBIDList.Count]); EditNewNotebookName.SetFocus; end; procedure TNoteBookPick.SetupForAddNotes(); var STL : TStringList=Nil; // does not require create/free Index, I : integer; begin PageControl1.ActivePage := TabSetNotes; TabSetNotes.Enabled := True; TabExisting.TabVisible := False; TabNewNotebook.TabVisible := False; TabChangeName.TabVisible := False; Label1.Caption := NBName; Label3.Caption := rsAddNotesToNotebook; TheMainNoteLister.LoadStrings(CheckListAddNotes.Items); TheMainNoteLister.GetNotesInNoteBook(STL, NBName); // Might set STL to nil if (STL <> Nil) and (STL.Count > 0) then begin for Index := 0 to CheckListAddNotes.Count -1 do begin for i := 0 to STL.Count-1 do begin if CheckListAddNotes.Items[Index] = TheMainNoteLister.GetTitle(STL[i]) then begin CheckListAddNotes.Checked[Index] := True; continue; end; end; end; end; end; procedure TNoteBookPick.TabNewNoteBookShow(Sender: TObject); begin EditNewNotebook.SetFocus; end; { If ChangeMode we are changing the name of a notebook. Messy. Else - If FullFileName has something in it, then we are managing the NoteBooks that note is in. If its neither ChangeMode nor FullFileName then its one of If NBName has something, we are managing the notes that are in that NoteBook. } procedure TNoteBookPick.FormShow(Sender: TObject); begin if Sett.CheckManyNotebooks.Checked then Label2.Caption := rsMultipleNoteBooks else Label2.Caption := rsOneNoteBook; case TheMode of nbSetNoteBooks : SetupForNewSelect(); nbMakeNewNoteBook : begin Label5.Caption := rsEnterNewNotebook; PageControl1.ActivePage := TabNewNotebook; TabExisting.TabVisible := False; TabNewNotebook.TabVisible := True; TabSetNotes.Visible := True; TabChangeName.TabVisible := False; TabSetNotes.Enabled := False; end; nbSetNotesInNoteBook : SetupForAddNotes(); nbChangeName : SetUpForChange(); end; ModalResult := 0; // On windows, 'something' in setfocus sets this to 1 ! end; procedure TNoteBookPick.CheckListBox1ItemClick(Sender: TObject; Index: integer); var I : integer; begin if Sett.CheckManyNotebooks.Checked then exit; // ensure only one clicked. if (Sender as TCheckListBox).Checked[Index] then begin for I := 0 to CheckListBox1.Count -1 do CheckListBox1.Checked[I] := False; CheckListBox1.Checked[Index] := True; end; end; procedure TNoteBookPick.EditNewNotebookKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin if Key = VK_RETURN then begin key := 0; ButtonOK.Click; end; end; procedure TNoteBookPick.EditNewNotebookNameEditingDone(Sender: TObject); // this one for change begin ButtonOK.Click; end; function TNoteBookPick.RewriteWithNewNotebookName(FileName : string) : boolean; var InFile, OutFile: TextFile; {NoteDateSt, }InString, TempName, NextSeekString : string; begin if not fileexists(Sett.NoteDirectory + FileName) then exit(false); // if its not there, the note has just been deleted TempName := AppendPathDelim(Sett.NoteDirectory) + 'tmp'; if not DirectoryExists(TempName) then CreateDir(AppendPathDelim(tempname)); TempName := tempName + pathDelim + FileName; AssignFile(InFile, Sett.NoteDirectory + FileName); AssignFile(OutFile, TempName); try try Reset(InFile); Rewrite(OutFile); NextSeekString := ''; while not eof(InFile) do begin readln(InFile, InString); if (Pos(NextSeekString, InString) > 0) then begin case NextSeekString of '' : begin writeln(outFile, ' ' + TB_GetLocalTime() + ''); NextSeekString := ''; end; '' : begin writeln(outFile, ' ' + TB_GetLocalTime() + ''); NextSeekString := ''; end; '' : begin writeln(OutFile, InString); write(OutFile, TheMainNoteLister.NoteBookTags(Filename)); NextSeekString := ''; end; '' : begin readln(InFile, InString); // Danger, wot if we hit EOF ? while pos('', Instring) > 0 do readln(InFile, InString); // now we have the line. NextSeekString := '321-blar-blar-blar-blar-123'; end; end; end else writeln(OutFile, InString); end; // end of while loop. //writeln(OutFile, ''); finally CloseFile(OutFile); CloseFile(InFile); end; except on E: EInOutError do begin debugln('File handling error occurred updating clean note location. Details: ' + E.Message); exit(False); end; end; {$ifdef WINDOWS} if not SafeWindowsDelete(Sett.NoteDirectory + FileName, NextSeekstring) then begin showmessage(NextSeekString); exit(false); end; {$endif} result := CopyFile(TempName, Sett.NoteDirectory + FileName); end; function TNoteBookPick.RewriteTempate(const FileName, NewName : string) : boolean; var InFile, OutFile: TextFile; InString, TempName, NextSeekString : string; begin if not fileexists(Sett.NoteDirectory + FileName) then exit(false); // if its not there, the note has just been deleted TempName := AppendPathDelim(Sett.NoteDirectory) + 'tmp'; if not DirectoryExists(TempName) then CreateDir(AppendPathDelim(tempname)); TempName := tempName + pathDelim + FileName; AssignFile(InFile, Sett.NoteDirectory + FileName); AssignFile(OutFile, TempName); try try Reset(InFile); Rewrite(OutFile); NextSeekString := ''; while not eof(InFile) do begin readln(InFile, InString); if (Pos(NextSeekString, InString) > 0) then begin case NextSeekString of '<title>' : begin writeln(outFile, '<title>' + NewName + ' Template'); NextSeekString := '' + NewName + ' Template'); NextSeekString := ''; end; '' : begin writeln(outFile, ' ' + TB_GetLocalTime() + ''); NextSeekString := ''; end; '' : begin writeln(outFile, ' ' + TB_GetLocalTime() + ''); NextSeekString := ''; end; '' : begin writeln(OutFile, InString); writeln(OutFile, ' '); writeln(OutFile, ' system:template'); writeln(OutFile, ' system:notebook:' + NewName + ''); writeln(OutFile, ' '); NextSeekString := ''; end; '' : begin // just drop on floor. readln(InFile, InString); // Danger, wot if we hit EOF ? while pos('', Instring) > 0 do readln(InFile, InString); // now we have the line. NextSeekString := '321-blar-blar-blar-blar-123'; // wow, if we find that ??? end; end; end else writeln(OutFile, InString); end; // end of while loop. finally CloseFile(OutFile); CloseFile(InFile); end; except on E: EInOutError do begin debugln('File handling error occurred updating template. Details: ' + E.Message); exit(False); end; end; {$ifdef WINDOWS} if not SafeWindowsDelete(Sett.NoteDirectory + FileName, NextSeekstring) then begin showmessage(NextSeekString); exit(false); end; {$endif} result := CopyFile(TempName, Sett.NoteDirectory + FileName); end; function TNoteBookPick.ChangeNoteBookName(NewName : string) : boolean; { 1. We have a list of all the notes that are members of this notebook. 2. Change the Notebook name stored in the Notebook data structure. 3. For notes that are open, just force a write, reach in and mark dirty.... 4. For notes that are not open, we rewrite them, setting a new list of notebook tags according to the data structure, a new last-change-date and a last-metadata-change-date. 5. Rewrite Template, give it a new Title (which is new Notebook Name plus ' Template') which needs to be written twice, updated last-change-date and last-metadata-change-date, finally remove its one Notebook name and replace it with new notebook name. VERY IMPORTANT that end user has fully sync'ed before doing this. Else we might leave notes on remote machine that believe they belong to a missing notebook. } var IDstr, TemplateID : string; OpenForm : TForm; //TEditBoxForm; begin result := true; TemplateID := TheMainNoteLister.NotebookTemplateID(Title); if TemplateID = '' then begin showmessage('Failed to ID Template [' + Title + '] (' + NewName + ')'); exit(false); end; TheMainNoteLister.AlterNotebook(Title, NewName); for IDstr in NBIDList do begin if TheMainNoteLister.IsThisNoteOpen(IDStr, OpenForm) then TEditBoxForm(OpenForm).Dirty:= true else RewriteWithNewNotebookName(IDstr); end; // OK, now change template ...... // debugln('template is ' + SearchForm.notelister.NotebookTemplateID(Title)); RewriteTempate(TemplateID, RemoveBadXMLCharacters(NewName)); ModalResult := mrOK; close; end; { After use presses OK on AddNotes tab, we need to make the file/notelister notebook status agree with the displayed CheckListBox. Its for one particular Notebook, so I ask notelister for a list of notes it believes belong to this NoteBook } procedure TNoteBookPick.InsertNoteBookTag(const FullFileName, NB : string); var InFile, OutFile: TextFile; InString : string; begin AssignFile(InFile, FullFileName); AssignFile(OutFile, FullFileName + '-temp'); try try Reset(InFile); Rewrite(OutFile); while not eof(InFile) do begin readln(InFile, InString); if (Pos('', InString) > 0) then begin // OK, next line may already have .... writeln(OutFile, InString); readln(InFile, InString); if (Pos('', InString) > 0) then begin // Already has , we add ours writeln(outFile, InString); // Thats writeln(outFile, ' system:notebook:' + NB + ''); end else begin // we need to add the lot writeln(outFile, ' '#10' system:notebook:' + NB + ' '#10''); writeln(outFile, InString); // whatever it is end; end else writeln(OutFile, InString); end; finally CloseFile(OutFile); CloseFile(InFile); end; except on E: EInOutError do debugln('File handling error occurred. Details: ' + E.Message); end; if not TB_ReplaceFile(FullFileName + '-temp', FullFileName) then debugln('ERROR, TNoteBookPick.InsertNoteBookTag failed to mv ' + FullFileName + '-temp to ' + FullFileName); end; { Will adjust on disk note file and NoteLister to agree with NoteBook content shown in CheckListAddNotes. } procedure TNoteBookPick.AdjustNBookNotes(); var STL : TStringList; // gets set to point to a list of FNames of notes in NBName Index, i : integer; InNoteList, InCheckList : boolean; // if true, Note is a member of NBName (in relevent view) FName : string; Dummy : TForm; begin TheMainNoteLister.GetNotesInNoteBook(STL, NBName); // Might set STL to nil for Index := 0 to CheckListAddNotes.Count -1 do begin // A list of note Titles // So, of the IDs in STL, does one of them have a title to match the one in CheckListAddNotes[Index] ? InNoteList := False; i := 0; while i < STL.count do begin //for i := 0 to STL.count - 1 do if TheMainNoteLister.GetTitle(STL[i]) = CheckListAddNotes.Items[Index] then begin InNoteList := True; break; end; inc(i); end; InCheckList := CheckListAddNotes.Checked[Index]; if InNoteList and InCheckList then continue; if not (InNoteList or InCheckList) then continue; // OK, some action is required FName := string(CheckListAddNotes.Items.Objects[Index]); // Thats the short file name, ID.note if InNoteList and (not InCheckList) then begin // remove tag from note and notelister STL.Delete(i); // Remove the NoteLister entry RemoveNoteBookTag(Sett.NoteDirectory+FName, NBName); end; if (not InNoteList) and InCheckList then begin // add tag to note and notelister TheMainNoteLister.AddNoteBook(FName, NBName, false); // Update internal data view if not TheMainNoteLister.IsThisNoteOpen(FName, Dummy) then // update on disk files InsertNoteBookTag(Sett.NoteDirectory+FName, NBName); end; end; end; // Makes a new NoteBook from TabNewNoteBook function TNoteBookPick.MakeNewNoteBook : boolean; begin Result := True; if TheMainNoteLister.IsANotebookTitle(EditNewNotebook.Text) then begin showmessage('That notebook already exists.'); exit(false); end; if EditNewNotebook.Text = '' then begin showmessage(rsEnterNewNotebook); exit(false); end; SaveNewTemplate(EditNewNotebook.Text); // that will also add the notebook to Note_Lister NBName := EditNewNotebook.Text; if TheMode = nbMakeNewNoteBook then SetupForAddNotes() else begin TheMainNoteLister.AddNoteBook(ExtractFileNameOnly(FullFileName) + '.note', EditNewNotebook.Text, False); // that adds the current note to the newly created notebook. SearchForm.RefreshNotebooks(); end; end; // Sets one note to be a member of the Notebooks checked in TabExisting. procedure TNotebookPick.SetNoteBooks; var SL : TStringList; Index : Integer; begin SL := TStringList.Create; // That is TabExisting try for Index := 0 to CheckListBox1.Count -1 do if CheckListBox1.Checked[Index] then SL.Add(CheckListBox1.Items[Index]); TheMainNoteLister.SetNotebookMembership(ExtractFileNameOnly(FullFileName) + '.note', SL); finally Sl.Free; end; end; procedure TNoteBookPick.ButtonOKClick(Sender: TObject); begin if ModalResult = mrOK then exit; case TheMode of nbSetNoteBooks : if PageControl1.ActivePage = TabExisting then SetNoteBooks else MakeNewNoteBook; nbMakeNewNoteBook : if not MakeNewNoteBook then exit; // Exit if invalid NB name nbSetNotesInNoteBook : AdjustNBookNotes; // Make file/notelister agree with user selctions nbChangeName : if EditNewNotebookName.Text <> '' then if not ChangeNoteBookName(EditNewNotebookName.Text) then exit; end; if TheMode = nbMakeNewNoteBook then begin // don't close, mv to SetNotes mode TheMode := nbSetNotesInNoteBook; exit; end; ModalResult := mrOK; end; end. tomboy-ng_0.39-1/source/backupview.lfm0000644000175000017500000000706314551457644017605 0ustar dbannondbannonobject FormBackupView: TFormBackupView Left = 541 Height = 472 Top = 259 Width = 587 Caption = 'View, recover or delete Backup Files' ClientHeight = 472 ClientWidth = 587 OnClose = FormClose OnCreate = FormCreate OnDestroy = FormDestroy OnShow = FormShow LCLVersion = '2.2.0.2' object Memo1: TMemo AnchorSideLeft.Control = Owner AnchorSideTop.Control = Owner AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = Panel1 Left = 5 Height = 168 Top = 270 Width = 575 Anchors = [akLeft, akRight, akBottom] BorderSpacing.Left = 5 BorderSpacing.Right = 7 BorderSpacing.Bottom = 5 Lines.Strings = ( 'Memo1' ) TabOrder = 0 end object Panel1: TPanel AnchorSideLeft.Control = Owner AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = Owner AnchorSideBottom.Side = asrBottom Left = 0 Height = 29 Top = 443 Width = 587 Anchors = [akLeft, akRight, akBottom] ClientHeight = 29 ClientWidth = 587 TabOrder = 1 object ButtonOpen: TButton AnchorSideLeft.Control = Panel1 AnchorSideTop.Control = Panel1 AnchorSideBottom.Control = Panel1 AnchorSideBottom.Side = asrBottom Left = 1 Height = 27 Hint = 'Open and view the whole note' Top = 1 Width = 100 Anchors = [akTop, akLeft, akBottom] Caption = 'View' OnClick = ButtonOpenClick TabOrder = 0 end object ButtonRecover: TButton AnchorSideLeft.Control = ButtonOpen AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = Panel1 AnchorSideBottom.Control = Panel1 AnchorSideBottom.Side = asrBottom Left = 101 Height = 27 Hint = 'Restore this note to main directory' Top = 1 Width = 100 Anchors = [akTop, akLeft, akBottom] Caption = 'Recover' OnClick = ButtonRecoverClick TabOrder = 1 end object ButtonDelete: TButton AnchorSideLeft.Control = ButtonRecover AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = Panel1 AnchorSideBottom.Control = Panel1 AnchorSideBottom.Side = asrBottom Left = 201 Height = 27 Hint = 'Really, totally delete this note.' Top = 1 Width = 100 Anchors = [akTop, akLeft, akBottom] Caption = 'Delete' OnClick = ButtonDeleteClick TabOrder = 2 end object ButtonOK: TButton AnchorSideTop.Control = Panel1 AnchorSideRight.Control = Panel1 AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = Panel1 AnchorSideBottom.Side = asrBottom Left = 472 Height = 27 Hint = 'My work here is done.' Top = 1 Width = 114 Anchors = [akTop, akRight, akBottom] Caption = 'Close' ModalResult = 1 TabOrder = 3 end end object ListBox1: TListBox AnchorSideLeft.Control = Owner AnchorSideTop.Control = Owner AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = Memo1 Left = 5 Height = 260 Hint = 'Use Ctrl or Shift to select multiple entries' Top = 5 Width = 577 Anchors = [akTop, akLeft, akRight, akBottom] BorderSpacing.Left = 5 BorderSpacing.Top = 5 BorderSpacing.Right = 5 BorderSpacing.Bottom = 5 ItemHeight = 0 MultiSelect = True OnSelectionChange = ListBox1SelectionChange ParentShowHint = False ScrollWidth = 575 ShowHint = True TabOrder = 2 TopIndex = -1 end end tomboy-ng_0.39-1/source/savenote.pas0000644000175000017500000010225014551457644017270 0ustar dbannondbannonunit SaveNote; { Copyright (C) 2017-2020 David Bannon License: This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html ------------------ This unit is responsible for saving a note in the Tomboy XML format. After creation, the class needs to be told the current FontNormal size and the CreatDate if any. If the supplied CreatDate is '', it will stamp it Now(). All the work is done in the Save(..) function, it needs to be passed the name of a file (that may or may not exist) and the KMemo its getting its content from. New Model - Saving is now a threaded operation and that happens in EditBox The class is created in EditBox, then ReadKMemo is called, it puts an XML version of the note into the passed StringList. The class can then be freed. ReadKMemo decides to put xml into either the StringList or a stream (that can be saved from here) on basis of if a StringList is passed or not. ----- Tag order ----- List, Bold, Italics HiLite Underline Strikeout Monospace Fontsize Processing Order is the reverese, so, and and of line might contain (in extreame case) - ListOff BoldOff ItalicsOff HiLiteOff UnderOff StrikeOff MonoOff _FontSize_ MonoSpace Strikeout Underline HiLite Ital Bold List } { HISTORY 20170927 - added Hyperlink to blocks to be saved. 2017/11/4 - replaced GetLocalTime() with one from TB_Sync, it puts minutes into the time offset figure, eg +11:00. Old notes written with previous vesions will fail with file sync until rewritten. 2017/11/12 Added code to replace < and > with char codes. 2017/12/02 Fixed a bug were we were skipping newline where there were 2 in a row 2017/12/02 Extensive changes to ensure font setting spanning part of a bullet list are saved correctly. 2017/12/02 Restructured AddTag to ensure tags laid out in correct order. 2017/12/02 changed the way that we ensure there are no hanging tags at end of a note. 2017/12/10 Fix a bug in BulletList() whereby font changes were not preserving previous queued format changes. Possibly. This is not robust code. 2018/01/01 Yet another bug fix for BulletList(), this time I've got it ! 2018/01/25 Changes to support Notebooks 2018/01/31 Added code to reprocess & 2018/05/12 Extensive changes - MainUnit is now just that. Only change here relates to naming of MainUnit and SearchUnit. 2018/06/26 Some tags an an 's' at the end. Changed the test for when FixedWidth turns on in AddTag(). 2018/07/14 Fixed a misplaced 'end' in BulletList() that was skipping some of its tests. 2018/07/27 Call RemoveBadCharacters(Title) in Header() 2018/08/02 Fix to fixed width, better brackets and a 'not' where needed. 2018/08/15 ReplaceAngles() works with bytes, not char, so don't use UTF8Copy and UTF8Length .... 2018/12/04 Don't save hyperlinks's underline, its not real ! 2018/12/29 Small improvements in time to save a file. 2019/04/29 Restore note's previous previous position and size. 2019/05/06 Support saving pos and open on startup in note. 2019/06/07 Removed unused, historical func to clean xml 2020/07/17 Esc bad XML in Template name. 2020/08/08 Added a BOM, a Byte Order Mark, at start of a note. 2020/08/10 Removed BOM, no advantage I can find, undefined risk. 2021/08/28 Can now save multilevel bullets 2021/10/05 Bug where a line in a monospace block was getting a even if the next line was monospace, Linux. Because that individual line wraping is useful, I now do it in notenormal. 2021/10/15 Serious change, now terminate font size changes at end of line where necessary vastly better xml. 2021/11/04 SaveNewTemplate now gets a current date stamp. } {$mode objfpc}{$H+} interface uses Classes, SysUtils, KMemo, Graphics, LazLogger; {type TNoteLocation = record X, Y, Width, Height : integer; end;} type TNoteUpdateRec = record CPos : shortstring; X, Y : shortstring; Width, Height : shortstring; OOS : shortstring; FFName : string; // path, ID and .note, not used in Single Note Mode LastChangeDate : string; // if '', its a content save, generate a new timestamp CreateDate : string; // if its '', its a new note, use LastChangeDate ErrorStr : string; // '' if all OK, not used everywhere.... // remove the field ErrorStr - why ??? end; type { TBSaveNote } TBSaveNote = class private OutStream:TMemoryStream; ID : ANSIString; FSize : integer; // Current Font Size, compare to Sett.Font* Bold : boolean; Italics : boolean; HiLight : boolean; Underline : boolean; Strikeout : boolean; FixedWidth : boolean; PrevFSize : integer; PrevBold : boolean; PrevItalics : boolean; PrevHiLight : boolean; PrevUnderline : boolean; PrevStrikeout : boolean; PrevFixedWidth : boolean; InList : boolean; KM : TKMemo; { This function key to whole parser. It uses a set of regional vars that remember the current style attributes and compare it to a newly arriving block, writing tags accordingly. Special case when CloseOnly is true, we terminate all active styles and reactivate them (NoteNormal will move the reactivated tags to next line later). Absolutly vital that tag order be observed, crossed ove r tgas are a very bad thing.} function AddTag(const FT : TKMemoTextBlock; var Buff : ANSIString; CloseOnly : boolean = False) : ANSIString; function BlockAttributes(Bk: TKMemoBlock): AnsiString; procedure BulletList(Level: TKMemoParaNumbering; var Buff: ANSIString); procedure CopyLastFontAttr(); function SetFontXML(Size : integer; TurnOn : boolean) : string; public // TimeStamp : string; // abandonded in SaveThread mode // Title : ANSIString; // set to orig createdate if available, if blank, we'll use now() CreateDate : ANSIString; procedure ReadKMemo(FileName: ANSIString; Title: string; KM1: TKMemo; STL: TStringList = nil); function WriteToDisk(const FileName: ANSIString; var NoteLoc: TNoteUpdateRec ): boolean; constructor Create; destructor Destroy; override; end; function Footer(Loc : TNoteUpdateRec) : string; function Header(Title : String) : ANSIstring; procedure SaveNewTemplate(NotebookName: ANSIString); implementation uses FileUtil // Graphics needed for font style defines ,LazUTF8 ,Settings // User settings and some defines across units. // ,SearchUnit // So we have access to NoteBookList ,LazFileUtils // For ExtractFileName... ,tb_utils , Note_Lister {$ifdef WINDOWS},SyncUtils{$endif} ; // For SafeWindowsDelete const {$ifdef LINUX} MonospaceFont = 'Monospace'; // until Oct 2021, this was monospace, caused each line in a mono block to be individually wrapped on Linux {$ifend} {$ifdef WINDOWS} MonospaceFont = 'Lucida Console'; {$ifend} {$ifdef DARWIN} MonospaceFont = 'Lucida Console'; {$ifend} constructor TBSaveNote.Create; begin OutStream := Nil; end; destructor TBSaveNote.Destroy; begin if OutStream <> Nil then begin debugln('ERROR - ID=' + ID + ' outstream was not routinly freed .....'); OutStream.Free; OutStream := Nil; end; end; function TBSaveNote.SetFontXML(Size : integer; TurnOn : boolean) : string; begin Result := ''; if Size = Sett.FontHuge then if TurnOn then Result := '' else Result := ''; if Size = sett.FontLarge then if TurnOn then Result := '' else Result := ''; if Size = Sett.FontSmall then if TurnOn then Result := '' else Result := ''; end; function TBSaveNote.AddTag(const FT : TKMemoTextBlock; var Buff : ANSIString; CloseOnly : boolean = False) : ANSIString; {var TestVar : Boolean;} begin // Important that we keep the tag order consistent. Good xml requires no cross over // tags. If the note is to be readable by Tomboy, must comply. (EditBox does not care) // Tag order - // List, Bold, Italics HiLite Underline Strikeout Monospace Fontsize // Processing Order is the reverese - // ListOff BoldOff ItalicsOff HiLiteOff UnderOff StrikeOff MonoOff FontSize MonoSpace Strikeout Underline HiLite Ital Bold List //debugln(BlockAttributes(FT)); // When Bold Turns OFF if (Bold and (not (fsBold in FT.TextStyle.Font.Style))) then begin Buff := Buff + ''; Bold := false; end; // When Italic turns OFF if (Italics and (not (fsItalic in FT.TextStyle.Font.Style))) then begin if Bold then Buff := Buff + ''; Buff := Buff + ''; if Bold then Buff := Buff + ''; Italics := false; end; // When Highlight turns OFF if (HiLight and (not (FT.TextStyle.Brush.Color = Sett.HiColour))) then begin if Bold then Buff := Buff + ''; if Italics then Buff := Buff + ''; Buff := Buff + ''; if Italics then Buff := Buff + ''; if Bold then Buff := Buff + ''; HiLight := false; end; // When Underline turns OFF if (Underline and (not (fsUnderline in FT.TextStyle.Font.Style))) then begin if Bold then Buff := Buff + ''; if Italics then Buff := Buff + ''; if HiLight then Buff := Buff + ''; Buff := Buff + ''; if HiLight then Buff := Buff + ''; if Italics then Buff := Buff + ''; if Bold then Buff := Buff + ''; Underline := false; end; // When Strikeout turns OFF if (Strikeout and (not (fsStrikeout in FT.TextStyle.Font.Style))) then begin if Bold then Buff := Buff + ''; if Italics then Buff := Buff + ''; if HiLight then Buff := Buff + ''; if Underline then Buff := Buff + ''; Buff := Buff + ''; if Underline then Buff := Buff + ''; if HiLight then Buff := Buff + ''; if Italics then Buff := Buff + ''; if Bold then Buff := Buff + ''; Strikeout := false; end; // When FixedWidth turns OFF //if (FixedWidth <> (FT.TextStyle.Font.Pitch = fpFixed) or (FT.TextStyle.Font.Name = MonospaceFont)) then begin // if we are currently in fixedwidth AND the next block is not. Not because either Pitch is not pfFixed OR Name is not Monospace if (FixedWidth and ((FT.TextStyle.Font.Pitch <> fpFixed) or (FT.TextStyle.Font.Name <> MonospaceFont))) then begin if Bold then Buff := Buff + ''; if Italics then Buff := Buff + ''; if HiLight then Buff := Buff + ''; if Underline then Buff := Buff + ''; if Strikeout then Buff := Buff + ''; Buff := Buff + ''; if Strikeout then Buff := Buff + ''; if Underline then Buff := Buff + ''; if HiLight then Buff := Buff + ''; if Italics then Buff := Buff + ''; if Bold then Buff := Buff + ''; FixedWidth := false; end; // When Font size changes OR end of line where we cloe off any pending, we rely on // notenormal to later move the re-turn ons down to next line. if CloseOnly OR ((FSize <> FT.TextStyle.Font.Size) and (FT.TextStyle.Font.Size <> Sett.FontTitle)) then begin if Bold then Buff := Buff + ''; if Italics then Buff := Buff + ''; if HiLight then Buff := Buff + ''; if Underline then Buff := Buff + ''; if Strikeout then Buff := Buff + ''; if FixedWidth then Buff := Buff + ''; // we need to do this if FSize is Small, Large or Huge OR Font has changed if (FSize in [Sett.FontSmall, Sett.FontLarge, Sett.FontHuge]) or ((FSize <> FT.TextStyle.Font.Size) and (FT.TextStyle.Font.Size <> Sett.FontTitle)) then begin Buff := Buff + SetFontXML(FSize, false); // better for pretty tags but generates invalid tags ! See below .... Buff := Buff + SetFontXML(FT.TextStyle.Font.Size, true); end; if FixedWidth then Buff := Buff + ''; if Strikeout then Buff := Buff + ''; if Underline then Buff := Buff + ''; if HiLight then Buff := Buff + ''; if Italics then Buff := Buff + ''; if Bold then Buff := Buff + ''; FSize := FT.TextStyle.Font.Size; end; if CloseOnly then exit(Buff); // if CloseOnly, ie end of line, nothing is turning on. // This comment no longer applies, leave hear until well tested !!!!!!! // this is not ideal, it should happen after we have closed all fonts, before // we write new sizes but that difficult as we have only one flag, "FSize" // difficulity is that font size change is two step, other things are On/Off // Result is that xml tag for a new font jumps up blank lines. Not pretty // be nice to find another way..... DRB // FixedWidth turns ON if ((not FixedWidth) and ((FT.TextStyle.Font.Name = MonospaceFont) or (FT.TextStyle.Font.Pitch = fpFixed))) then begin //TestVar := (FT.TextStyle.Font.Name = MonospaceFont); //TestVar := (FT.TextStyle.Font.Pitch = fpFixed); if Bold then Buff := Buff + ''; if Italics then Buff := Buff + ''; if HiLight then Buff := Buff + ''; if Underline then Buff := Buff + ''; if Strikeout then Buff := Buff + ''; Buff := Buff + ''; if Strikeout then Buff := Buff + ''; if Underline then Buff := Buff + ''; if HiLight then Buff := Buff + ''; if Italics then Buff := Buff + ''; if Bold then Buff := Buff + ''; FixedWidth := true; end; // Strikeout turns ON if ((not Strikeout) and (fsStrikeout in FT.TextStyle.Font.Style)) then begin if Bold then Buff := Buff + ''; if Italics then Buff := Buff + ''; if HiLight then Buff := Buff + ''; if Underline then Buff := Buff + ''; Buff := Buff + ''; if Underline then Buff := Buff + ''; if HiLight then Buff := Buff + ''; if Italics then Buff := Buff + ''; if Bold then Buff := Buff + ''; Strikeout := true; end; // Underline turns ON if ((not Underline) and (fsUnderline in FT.TextStyle.Font.Style)) then begin if not FT.ClassNameIs('TKMemoHyperlink') then begin // Hyperlinks also have underline, don't save if Bold then Buff := Buff + ''; if Italics then Buff := Buff + ''; if HiLight then Buff := Buff + ''; Buff := Buff + ''; if HiLight then Buff := Buff + ''; if Italics then Buff := Buff + ''; if Bold then Buff := Buff + ''; Underline := true; end; end; // Highlight turns ON if ((not HiLight) and (FT.TextStyle.Brush.Color = Sett.HiColour)) then begin if Bold then Buff := Buff + ''; if Italics then Buff := Buff + ''; Buff := Buff + ''; if Italics then Buff := Buff + ''; if Bold then Buff := Buff + ''; HiLight := true; end; // Italic turns On if ((not Italics) and (fsItalic in FT.TextStyle.Font.Style)) then begin if Bold then Buff := Buff + ''; Buff := Buff + ''; if Bold then Buff := Buff + ''; Italics := true; end; // Bold turns On if ((not Bold) and (fsBold in FT.TextStyle.Font.Style)) then begin Buff := Buff + ''; Bold := true; end; Result := Buff; end; { This function takes an existing parsed string and wraps it in the necessary bullet tags but has to resolve any pending formatting tags first and restore then afterwards. Its horrible. If you are debugging this, I am truly sorry. } // ListOff BoldOff ItalicsOff HiLiteOff FontSize HiLite Ital Bold List procedure TBSaveNote.BulletList(Level : TKMemoParaNumbering; var Buff : ANSIString); var StartStartSt, StartEndSt, EndStartSt, EndEndSt : ANSIString; iLevel : integer; begin //writeln('Status Bold=', Bold=True, ' PBold=', PrevBold=True, ' High=', HiLight=True, ' PHigh=', PrevHiLight=True); StartStartSt := ''; StartEndSt := ''; EndStartSt := ''; EndEndSt := ''; if PrevBold then begin StartStartSt := ''; // Starting String, Start StartEndSt := ''; // Starting String, End end; if Bold then begin EndStartSt := ''; // End String, start of it EndEndSt := ''; // End String, end of it end; if PrevItalics then begin StartStartSt := StartStartSt + ''; StartEndSt := '' + StartEndSt; end; if Italics then begin EndStartSt := EndStartSt + ''; EndEndSt := '' + EndEndSt; end; if PrevHiLight then begin StartStartSt := StartStartSt + ''; StartEndSt := '' + StartEndSt; end; if HiLight then begin EndStartSt := EndStartSt + ''; EndEndSt := '' + EndEndSt; end; if PrevUnderline then begin StartStartSt := StartStartSt + ''; StartEndSt := '' + StartEndSt; // EndEndSt := '' + EndEndSt; end; if Underline then begin EndStartSt := EndStartSt + ''; EndEndSt := '' + EndEndSt; end; if PrevStrikeout then begin StartStartSt := StartStartSt + ''; StartEndSt := '' + StartEndSt; end; if Strikeout then begin EndStartSt := EndStartSt + ''; EndEndSt := '' + EndEndSt; end; if PrevFixedWidth then begin StartStartSt := StartStartSt + ''; StartEndSt := '' + StartEndSt; // EndEndSt := '' + EndEndSt; end; if FixedWidth then begin EndStartSt := EndStartSt + ''; EndEndSt := '' + EndEndSt; end; if PrevFSize <> Sett.FontNormal then begin StartStartSt := StartStartSt + SetFontXML(PrevFSize, False); StartEndSt := SetFontXML(PrevFSize, True) + StartEndSt; end; if FSize <> Sett.FontNormal then begin EndStartSt := EndStartSt + SetFontXML(FSize, False); EndEndSt := SetFontXML(FSize, True) + EndEndSt; end; // writeLn('Buff at Start [' + Buff + ']'); // writeln('StartStart [' + StartStartSt + ']'); // writeln('StartEnd [' + StartEndSt + ']'); // writeln('EndStart [' + EndStartSt + ']'); // writeln('EndEnd [' + EndEndSt + ']'); Buff := StartEndSt + Buff + EndStartSt; case Level of BulletOne : iLevel := 1; BulletTwo : iLevel := 2; BulletThree : iLevel := 3; BulletFour : iLevel := 4; BulletFive : iLevel := 5; BulletSix : iLevel := 6; BulletSeven : iLevel := 7; BulletEight : iLevel := 8; otherwise iLevel := 8; end; while iLevel > 0 do begin Buff := '' + Buff + ''; dec(iLevel); end; Buff := StartStartSt + Buff + EndEndSt; {Buff := StartStartSt + '' + StartEndSt + Buff + EndStartSt + '' + EndEndSt;} // writeLn('Buff at End [' + Buff + ']'); // ************************************** // writeln('---'); end; // This is just a debug function. function TBSaveNote.BlockAttributes(Bk : TKMemoBlock) : AnsiString; begin Result := TKMemoTextBlock(BK).ClassName; if fsBold in TKMemoTextBlock(BK).TextStyle.Font.Style then Result := Result + ' Bold '; if fsItalic in TKMemoTextBlock(BK).TextStyle.Font.Style then Result := Result + ' Italic '; if TKMemoTextBlock(BK).TextStyle.Brush.Color = Sett.HiColour then Result := Result + ' HighLight '; Result := Result + ' size=' + inttostr(TKMemoTextBlock(BK).TextStyle.Font.Size); if fsUnderline in TKMemoTextBlock(BK).TextStyle.Font.Style then Result := Result + ' Underline '; if fsStrikeout in TKMemoTextBlock(BK).TextStyle.Font.Style then Result := Result + ' Strikeout '; if TKMemoTextBlock(BK).TextStyle.Font.Pitch = fpFixed then Result := Result + ' FixedWidth '; if TKMemoTextBlock(BK).ClassNameIs('TKMemoTextBlock') then Result := Result + ' [' + TKMemoTextBlock(BK).Text + ']'; //else Result := 'Not Text'; end; procedure SaveNewTemplate(NotebookName : ANSIString); var GUID : TGUID; OStream:TFilestream; Buff{, ID} : ANSIString; Loc : TNoteUpdateRec {TNoteLocation}; begin CreateGUID(GUID); //Title := NotebookName + ' Template'; Loc.FFName := copy(GUIDToString(GUID), 2, 36) + '.note'; TheMainNoteLister.AddNoteBook(Loc.FFname, NotebookName, True); Ostream :=TFilestream.Create(Sett.NoteDirectory + Loc.FFName, fmCreate); Loc.Y := '20'; Loc.X := '20'; Loc.Height := '200'; Loc.Width:='300'; Loc.OOS := 'False'; Loc.CPos:='1'; Loc.LastChangeDate := TB_GetLocalTime(); try Buff := Header(RemoveBadXMLCharacters(NotebookName) + ' Template'); OStream.Write(Buff[1], length(Buff)); Buff := RemoveBadXMLCharacters(NotebookName) + ' Template' + #10#10#10; OStream.Write(Buff[1], length(Buff)); Buff := Footer(Loc); OStream.Write(Buff[1], length(Buff)); finally OStream.Free; end; end; procedure TBSaveNote.CopyLastFontAttr(); begin PrevFSize := FSize; PrevBold := Bold; PrevItalics := Italics; PrevHiLight := HiLight; PrevUnderline := Underline; PrevStrikeout := Strikeout; PrevFixedWidth := FixedWidth; PrevFSize := FSize; end; // NEW : if passed a created StringList, we write to the list rather than to the // Memory Buffer. Still need to deal with Header and Footer in a line by line mode. procedure TBSaveNote.ReadKMemo(FileName : ANSIString; Title : string; KM1 : TKMemo; STL : TStringList = nil); var Buff : ANSIstring = ''; // OutStream:TFilestream; BlockNo : integer = 0; Block : TKMemoBlock; NextBlock : integer; // BlankFont : TFont; begin KM := KM1; FSize := Sett.FontNormal; Bold := false; Italics := False; HiLight := False; Underline := False; InList := false; FixedWidth := False; ID := ExtractFileNameOnly(FileName) + '.note'; // ID needs to be set so we can get list of notebooks for the footer. // Must deal with an empty list ! // try if STL = nil then outstream :=TMemoryStream.Create({FileName, fmCreate}); // Write and WriteBuffer accept a buffer, not a string ! Need to start at pos 1 // when sending string or ANSIstring otherwise it uses first byte which makes it look like a binary file. // http://free-pascal-general.1045716.n5.nabble.com/Creating-text-files-with-TFileStream-td2824859.html Buff := Header(Title); if STL = Nil then OutStream.Write(Buff[1], length(Buff)) else STL.Add(Buff); Buff := ''; try repeat CopyLastFontAttr(); repeat Block := KM1.Blocks.Items[BlockNo]; // debugln('Block=' + inttostr(BlockNo) + ' ' +BlockAttributes(Block)); if Block.ClassNameIs('TKMemoParagraph') then break; // discard end prev para if Block.ClassNameIs('TKMemoTextBlock') then begin if Block.Text.Length > 0 then begin AddTag(TKMemoTextBlock(Block), Buff); Buff := Buff + RemoveBadXMLCharacters(Block.Text); end; end; if Block.ClassNameIs('TKMemoHyperlink') then begin AddTag(TKMemoHyperlink(Block), Buff); Buff := Buff + RemoveBadXMLCharacters(Block.Text); end; //debugln('Block=' + inttostr(BlockNo) + ' ' +BlockAttributes(Block)); inc(BlockNo); if BlockNo >= KM1.Blocks.Count then break; // debugln('Inner Buff=[' + Buff + ']'); until KM1.Blocks.Items[BlockNo].ClassNameIs('TKMemoParagraph'); if BlockNo >= KM1.Blocks.Count then break; if TKMemoParagraph(KM1.Blocks.Items[BlockNo]).Numbering <> pnuNone then BulletList(TKMemoParagraph(KM1.Blocks.Items[BlockNo]).Numbering, Buff); {if TKMemoParagraph(KM1.Blocks.Items[BlockNo]).Numbering = pnuBullets then BulletList(Buff); } // Add tags about to terminate to end of line, pretty XML // However does not work for font size changes ! // Note - para blocks CAN have font attributs (eg, underline etc). // debugln('Outer 1 Buff=[' + Buff + ']'); // Now, look ahead and see if we need close things .... // This makes bad decision for font size changes, we end up with empty tags but does no real harm. NextBlock := BlockNo + 1; while NextBlock < KM1.Blocks.Count do begin if KM1.Blocks.Items[NextBlock].ClassNameIs('TKMemoTextBlock') then begin AddTag(TKMemoTextBlock(KM1.Blocks.Items[NextBlock]), Buff, True); break; end else inc(NextBlock); end; if STL = Nil then begin Buff := Buff + LineEnding; OutStream.Write(Buff[1], length(Buff)) end else STL.Add(Buff); Buff := ''; // debugln('Block=' + inttostr(BlockNo) + ' ' +BlockAttributes(KM1.Blocks.Items[BlockNo])); inc(BlockNo); if BlockNo >= KM1.Blocks.Count then break; until false; { At this point we may have unsaved content in Buff cos last block was not a Para. But it cannot be Bullet. If it was a Para, Buff is empty. But we could still have hanging xml tags. So either case, send it to add tag with an empty Font. } if Buff <> '' then begin if STL = Nil then OutStream.Write(Buff[1], length(Buff)) else STL.Add(Buff); end; Buff := ''; if Bold then Buff := ''; if Italics then Buff := Buff + ''; if HiLight then Buff := Buff + ''; if Underline then Buff := Buff + ''; if Strikeout then Buff := Buff + ''; if FixedWidth then Buff := Buff + ''; if FSize <> Sett.FontNormal then Buff := Buff + SetFontXML(FSize, False); if length(Buff) > 0 then begin if STL = Nil then OutStream.Write(Buff[1], length(Buff)) else STL.Add(Buff); end; Except on EListError do begin debugln('ERROR - EListError while writing note to stream.'); { we now do footer in the WriteToDisk() Buff := Footer(); OutStream.Write(Buff[1], length(Buff)); } end; end; { finally OutStream.Free; end; } end; // gets called (from outside) after all content assembled. Its done from outside // as the calling unit has control of KMemo's locking. function TBSaveNote.WriteToDisk(const FileName: ANSIString; var NoteLoc : TNoteUpdateRec) : boolean; var Buff : string = ''; TmpName : string = ''; {$ifdef WINDOWS}FileAttr : longint; ErrorMsg : string; {$endif} begin Result := True; // we write out the footer here so we can do the searching to notebook stuff // after we have released to lock on KMemo. Buff := Footer(NoteLoc); OutStream.Write(Buff[1], length(Buff)); // We save the file in tmp, when closed, // move it over to the actual position. That will prevent, to some extent, poweroff // crashes messing with files. May generate an EStreamError //{$define STAGEDWRITE} //{$ifdef STAGEDWRITE} {$ifdef WINDOWS} // temp kludge until I understand the problem RenameFileUTF has with smb shares. // this will now work OK on all linux file systems but without the write, delete.move process. TmpName := AppendPathDelim(Sett.NoteDirectory) + 'tmp'; if not DirectoryExists(TmpName) then if not CreateDir(AppendPathDelim(tmpname)) then begin NoteLoc.ErrorStr:='Failed Create Dir'; exit(False); end; TmpName := TmpName + pathDelim + extractFileName(FileName); try OutStream.SaveToFile(TmpName); finally OutStream.Free; OutStream := nil; end; {$ifdef WINDOWS} if FileExists(FileName) then // will not be there if its a new note. if not SafeWindowsDelete(FileName, ErrorMsg) then exit(false); {$endif} //showmessage('T=' + TmpName + ' and F=' + FileName); result := RenameFileUTF8(TmpName, FileName); // Unix ok to over write, windows is not ! // ToDo : Note that the above line seems to fail on a smb shared directory. Must get to bottom .... {$else} // thats the ifdef StagedWrite, here we write directly to note file. try OutStream.SavetoFile(FileName); finally OutStream.Free; OutStream := nil; end; {$endif} // thats the ifdef StagedWrite if not Result then NoteLoc.ErrorStr:='Failed Rename T=' + TmpName + ' and F=' + FileName; end; function Header(Title : string): ANSIstring; var S1, S2, S3, S4 : ANSIString; begin // Add a BOM at the start, not essencial, Tomboy did it, makes the note no longer a plain text file. ?? //S1 := #239#187#191''#10''#10''; S4 := ''#10' '; Result := S1 + S2 + S3 + RemoveBadXMLCharacters(Title) + S4; end; { Sets TimeStamp, a public SaveNote var that is later used by EditBox to set the value stored in NoteLister. And NoteLister is not thread safe. This method also reads NoteLister for NoteBookTags. Maybe or maybe NOT safe. } function Footer(Loc : TNoteUpdateRec): ANSIstring; var S1, S2, S3, S4, S5, S6 : string; begin if Loc.LastChangeDate = '' then begin debugln('------------------------------------------------------------------------'); debugln('ERROR, ERROR passed an blank change date to Footer, not nice.'); debugln('------------------------------------------------------------------------'); Loc.LastChangeDate := TB_GetLocalTime(); // no, thats just a temp fix, do something about it end; (* if Loc.LastChangeDate = '' then TimeStamp := TB_GetLocalTime() // get actual time date in format like Tomboy's else TimeStamp := Loc.LastChangeDate; *) S1 := ''#10' '; S2 := ''#10' '; S3 := ''#10' '; S4 := ''#10' ' + Loc.CPos + ''#10' 1'#10; S5 := ' ' + Loc.Width + ''#10' ' + Loc.Height + ''#10' ' + Loc.X + ''#10' ' + Loc.Y + ''#10; S6 := ' ' + Loc.OOS + ''#10''; if Loc.CreateDate = '' then Loc.CreateDate := Loc.LastChangeDate; if TheMainNoteLister <> Nil then Result := S1 + Loc.LastChangeDate + S2 + Loc.LastChangeDate + S3 + Loc.CreateDate + S4 + S5 + TheMainNoteLister.NoteBookTags(ExtractFileName(Loc.FFName)) + S6 else Result := S1 + Loc.LastChangeDate + S2 + Loc.LastChangeDate + S3 + Loc.CreateDate + S4 + S5 + S6; // That will mean no Notebook tags in single note mode, is that an issue ? // Most singe notes are out of their repo so won't have notebooks anyway but we could // save any tag list and restore it on save ?? end; end. tomboy-ng_0.39-1/source/libnotify.pas0000644000175000017500000002722314551457644017451 0ustar dbannondbannon{ libnotify binding for Free Pascal Copyright (C) 2011 Ido Kanner idokan at@at gmail dot.dot com This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this library; if not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. } unit libnotify; {$mode fpc}{$PACKRECORDS C} interface uses ctypes, glib2, gdk2pixbuf; const NOTIFY_LIBRARY = 'libnotify'; // Should be part of GTK but it is not binded to FPC :( type GVariant = record end; GfreeFunc = procedure(data : gpointer); cdecl; { notification.h } const (** * NOTIFY_EXPIRES_DEFAULT: * * The default expiration time on a notification. *) NOTIFY_EXPIRES_DEFAULT = -1; (** * NOTIFY_EXPIRES_NEVER: * * The notification never expires. It stays open until closed by the calling API * or the user. *) NOTIFY_EXPIRES_NEVER = 0; type P_NotifyNotificationPrivate = ^T_NotifyNotificationPrivate; T_NotifyNotificationPrivate = record end; PNotifyNotificationPrivate = P_NotifyNotificationPrivate; NotifyNotificationPrivate = T_NotifyNotificationPrivate; P_NotifyNotification = ^T_NotifyNotification; T_NotifyNotification = record parent_object : TGObject; priv : PNotifyNotificationPrivate; end; PNotifyNotification = P_NotifyNotification; TNotifyNotification = T_NotifyNotification; TNotificationProc = procedure (Notification : PNotifyNotification); cdecl; P_NotifyNotificationClass = ^T_NotifyNotificationClass; T_NotifyNotificationClass = record parent_class : TGObjectClass; // Signals Notification : TNotificationProc; end; PNotifyNotificationClass = P_NotifyNotificationClass; TNotifyNotificationClass = T_NotifyNotificationClass; function notify_notification_get_type : GType; cdecl; external NOTIFY_LIBRARY; function m_notify_type_notification : GType; cdecl; inline; function M_NOTIFY_NOTIFICATION(o : pointer) : PGTypeInstance; cdecl; inline; function M_NOTIFY_NOTIFICATION_CLASS(k : Pointer) : Pointer; cdecl; inline; function M_NOTIFY_IS_NOTIFICATION(o : Pointer) : Boolean; cdecl; inline; function M_NOTIFY_IS_NOTIFICATION_CLASS(k : pointer) : Boolean; cdecl; inline; function M_NOTIFY_NOTIFICATION_GET_CLASS(o : Pointer) : PGTypeClass; cdecl; inline; const (** * NotifyUrgency: * @NOTIFY_URGENCY_LOW: Low urgency. Used for unimportant notifications. * @NOTIFY_URGENCY_NORMAL: Normal urgency. Used for most standard notifications. * @NOTIFY_URGENCY_CRITICAL: Critical urgency. Used for very important notifications. * * The urgency level of the notification. *) NOTIFY_URGENCY_LOW = 0; NOTIFY_URGENCY_NORMAL = 1; NOTIFY_URGENCY_CRITICAL = 2; type NotifyUrgency = cint; (** * NotifyActionCallback: * @notification: * @action: * @user_data: * * An action callback function. *) NotifyActionCallback = procedure(notification : PNotifyNotification; action : PChar; user_data : gpointer); cdecl; (* /** * NOTIFY_ACTION_CALLBACK: * @func: The function to cast. * * A convenience macro for casting a function to a #NotifyActionCallback. This * is much like G_CALLBACK(). */ #define NOTIFY_ACTION_CALLBACK(func) ((NotifyActionCallback)(func)) *) function notify_notification_new(summary, body, icon : PChar) : PNotifyNotification; cdecl; external NOTIFY_LIBRARY; function notify_notification_update(notification : PNotifyNotification; summary, body, icon : PChar) : gboolean; cdecl; external NOTIFY_LIBRARY; function notify_notification_show(notification : PNotifyNotification; error : PPGError) : gboolean; cdecl; external NOTIFY_LIBRARY; procedure notify_notification_set_timeout(notification : PNotifyNotification; timeout : gint); cdecl; external NOTIFY_LIBRARY; procedure notify_notification_set_category(notification : PNotifyNotification; category : PChar); cdecl; external NOTIFY_LIBRARY; procedure notify_notification_set_urgency(notification : PNotifyNotification; urgency : NotifyUrgency); cdecl; external NOTIFY_LIBRARY; procedure notify_notification_set_icon_from_pixbuf( notification : PNotifyNotification; icon : PGdkPixbuf); cdecl; external NOTIFY_LIBRARY; procedure notify_notification_set_image_from_pixbuf( notification : PNotifyNotification; pixbuf : PGdkPixbuf); cdecl; external NOTIFY_LIBRARY; procedure notify_notification_set_hint_int32(notification : PNotifyNotification; key : PChar; value : gint); cdecl; external NOTIFY_LIBRARY; procedure notify_notification_set_hint_uint32(notification : PNotifyNotification; key : PChar; value : guint); cdecl; external NOTIFY_LIBRARY; procedure notify_notification_set_hint_double(notification : PNotifyNotification; key : PChar; value : gdouble); cdecl; external NOTIFY_LIBRARY; procedure notify_notification_set_hint_string(notification : PNotifyNotification; key : PChar; value : PChar); cdecl; external NOTIFY_LIBRARY; procedure notify_notification_set_hint_byte(notification : PNotifyNotification; key : PChar; value : guchar); cdecl; external NOTIFY_LIBRARY; procedure notify_notification_set_hint_byte_array( notification : PNotifyNotification; key : PChar; value : Pguchar; len : gsize); cdecl; external NOTIFY_LIBRARY; procedure notify_notification_set_hint(notification : PNotifyNotification; key : PChar; value : GVariant); cdecl; external NOTIFY_LIBRARY; procedure notify_notification_set_app_name(notification : PNotifyNotification; app_name : PChar); cdecl; external NOTIFY_LIBRARY; procedure notify_notification_clear_hints(notification : PNotifyNotification); cdecl; external NOTIFY_LIBRARY; procedure notify_notification_add_action(notification : PNotifyNotification; action, label_ : PChar; callback : NotifyActionCallback; user_data : gpointer; free_funch : GFreeFunc); cdecl; external NOTIFY_LIBRARY; procedure notify_notification_clear_actions(notification : PNotifyNotification); cdecl; external NOTIFY_LIBRARY; function notify_notification_close(notification : PNotifyNotification; error : PPGError) : gboolean; cdecl; external NOTIFY_LIBRARY; function notify_notification_get_closed_reason( notification : PNotifyNotification) : gint; cdecl; external NOTIFY_LIBRARY; { notify-enum-types.h } (* enumerations from "notification.h" *) function notify_urgency_get_type : GType; cdecl; external NOTIFY_LIBRARY; function M_NOTIFY_TYPE_URGENCY : GType; cdecl; inline; { notify-features.h } (* compile time version *) const NOTIFY_VERSION_MAJOR = 0; NOTIFY_VERSION_MINOR = 7; NOTIFY_VERSION_MICRO = 3; (* check whether a version equal to or greater than * major.minor.micro is present. *) function M_NOTIFY_CHECK_VERSION(major, minor, micro : cint) : Boolean; cdecl; inline; { notify.h } function notify_init(app_name : PChar) : gboolean; cdecl; external NOTIFY_LIBRARY; procedure notify_uninit; cdecl; external NOTIFY_LIBRARY; function notify_is_initted : gboolean; cdecl; external NOTIFY_LIBRARY; function notify_get_app_name : PChar; cdecl; external NOTIFY_LIBRARY; procedure notify_set_app_name(app_name : PChar); cdecl; external NOTIFY_LIBRARY; function notify_get_server_caps : PGList; cdecl; external NOTIFY_LIBRARY; function notify_get_server_info(ret_name, ret_vendor, ret_version : PPChar) : gboolean; cdecl; external NOTIFY_LIBRARY; implementation function m_notify_type_notification : GType; cdecl; begin m_notify_type_notification := notify_notification_get_type; end; function M_NOTIFY_NOTIFICATION(o : pointer): PGTypeInstance; cdecl; begin // #define NOTIFY_NOTIFICATION(o) (G_TYPE_CHECK_INSTANCE_CAST ((o), NOTIFY_TYPE_NOTIFICATION, NotifyNotification)) M_NOTIFY_NOTIFICATION := G_TYPE_CHECK_INSTANCE_CAST(o, m_notify_type_notification); end; function M_NOTIFY_NOTIFICATION_CLASS(k: Pointer): Pointer; cdecl; begin //#define NOTIFY_NOTIFICATION_CLASS(k) (G_TYPE_CHECK_CLASS_CAST((k), NOTIFY_TYPE_NOTIFICATION, NotifyNotificationClass)) M_NOTIFY_NOTIFICATION_CLASS := G_TYPE_CHECK_CLASS_CAST(k, m_notify_type_notification); end; function M_NOTIFY_IS_NOTIFICATION(o: Pointer): Boolean; cdecl; begin // #define NOTIFY_IS_NOTIFICATION(o) (G_TYPE_CHECK_INSTANCE_TYPE ((o), NOTIFY_TYPE_NOTIFICATION)) M_NOTIFY_IS_NOTIFICATION := G_TYPE_CHECK_INSTANCE_TYPE(o, m_notify_type_notification); end; function M_NOTIFY_IS_NOTIFICATION_CLASS(k: pointer): Boolean; cdecl; begin // #define NOTIFY_IS_NOTIFICATION_CLASS(k) (G_TYPE_CHECK_CLASS_TYPE ((k), NOTIFY_TYPE_NOTIFICATION)) M_NOTIFY_IS_NOTIFICATION_CLASS := G_TYPE_CHECK_CLASS_TYPE(k, m_notify_type_notification); end; function M_NOTIFY_NOTIFICATION_GET_CLASS(o: Pointer): PGTypeClass; cdecl; begin // #define NOTIFY_NOTIFICATION_GET_CLASS(o) (G_TYPE_INSTANCE_GET_CLASS ((o), NOTIFY_TYPE_NOTIFICATION, NotifyNotificationClass)) M_NOTIFY_NOTIFICATION_GET_CLASS := G_TYPE_INSTANCE_GET_CLASS(o, m_notify_type_notification); end; function M_NOTIFY_TYPE_URGENCY: GType; cdecl; begin M_NOTIFY_TYPE_URGENCY := notify_urgency_get_type; end; function M_NOTIFY_CHECK_VERSION(major, minor, micro: cint): Boolean; cdecl; begin { #define NOTIFY_CHECK_VERSION(major,minor,micro) \ (NOTIFY_VERSION_MAJOR > (major) || \ (NOTIFY_VERSION_MAJOR == (major) && NOTIFY_VERSION_MINOR > (minor)) || \ (NOTIFY_VERSION_MAJOR == (major) && NOTIFY_VERSION_MINOR == (minor) && \ NOTIFY_VERSION_MICRO >= (micro))) } M_NOTIFY_CHECK_VERSION := ((NOTIFY_VERSION_MAJOR > major) or ((NOTIFY_VERSION_MAJOR = major) and (NOTIFY_VERSION_MINOR > minor)) or ((NOTIFY_VERSION_MAJOR = major) and (NOTIFY_VERSION_MINOR = minor) and (NOTIFY_VERSION_MICRO >= micro))); end; end. tomboy-ng_0.39-1/source/transgithub.pas0000644000175000017500000021046614551457644020007 0ustar dbannondbannonunit transgithub; { Copyright (C) 2017-2022 David Bannon License: This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html ------------------ } { A class that provides transport for a tomboy-ng to github sync. -------------- P E R S O N A L A C C E S S T O K E N S ------------------ https://github.com/settings/tokens to generate a Person Access Token From a logged in to github page, click my pretty picture, top right. Then 'Settings'. on left sidebar, click 'Developer", "Personal Access Token". } { Normal Sync Cycle for GitHub Sync eg, as driven by SyncGui.ManualSync --------------------------------------------------------------------- Create ASync Assign Proceed and Progress methods Assign various config data Async.RepoAction := RepoUse Async.SetTransport Assigns and configures Transport ASync.TestConnection Reads Local Manifest, setting LocalServerID and LocalLastSyncDates Calls Transport.TestTransport Might make new serverID Creates RemoteNotes data structure Contacts github, confirming UID and Token work, a ServerID can be found. Scans remote dir indexing all files found in /, /Notes and /Meta Reads Remote Manifest, filling RemoteNotes out with details of all remote notes. Compares ServerIDs ASync.StartSync Calls LoadRemoteRepo which calls GitHubSync.GetRemoteNotes which does nothing. Calls GitHubSync.AssignActions which Iterates over RemoteNotes adding every entry into RemoteMetaData making some initial Action guesses. Iterates over NoteLister (both Note List and Notebook List) adding all entries not already in RemoteMetaData, firming up Actions as it goes. Calls CheckRemoteDeletes and CheckLocalDeletes that further refines Actions in RemoteMetaData based on information from LocalManifest. Asks the user to resolve any clashes Calls DoDownloads, DoDeletes and DoUpLoads which call Transport to do actual file work. Calls DoDeletesLocal. Calls Transport.DoRemoteManifest to write and upload a remote manifest. Calls WriteLocalManifest Easy Peasy ! The above glosses over error handling and, importantly, how data such as last change dates is shuffled around to ensure its in RemoteNotes when we write out remote manifests. Downloading a Note. RemoteNotes will already know CData and Notebooks from reading remote manifest. DownLoadANote will write a temp file in Note format. It first calls Downloader() which returns with a string containg note content as JSON Base64 encoded. We decode and drop into s stringlist. We pass that to Importer thats converts to xml. HISTORY : 2021/09/20 - Changed to using JSONTools, tidier, safer, easier to read code. 2021/09/25 - fixed how notebook lists are stored in RemoteNotes, as JSON array, not JSON data 2021/09/27 - Implement selective sync. 2022/10/18 - Fix markup around readme warning } {x$define DEBUG} {$mode ObjFPC}{$H+} interface uses Classes, SysUtils, {fpjson, jsonparser, }syncutils {$ifndef TESTRIG}, trans{$endif}; type TFileFormat = ( ffNone, // Format not, at this stage specified ffEncrypt, // File is encrypted ffMarkDown); // File is in MarkDown, CommonMark type PGitNote=^TGitNote; TGitNote = record FName : string; // eg README.txt, Meta/serverid, Notes/.md Sha : string; // The SHA, we always have this. Title : string; // Last known note title. LCDate: string; // The Last Change Date of the note. Always can get that. CDate : string; // The create Date, we may not know it if its a new note. Format : TFileFormat; // How the file is saved at github, md only at present Notebooks : string; // empty OK, else [] or ["notebook1", "notebook2"] etc. Only needed for SyDownLoad end; type { TGitNoteList } TGitNoteList = class(TFPList) private procedure DumpList(wherefrom : string); function Get(Index: integer): PGitNote; { Inserts just one field into GitNoteList. FName should include remote path and extension (ie Notes/ABC.md). Does not do format but might need to ...} procedure InsertData(const FName, Field, Data: string); public constructor Create(); destructor Destroy; override; // Adds an item, found in the remote dir scan JSON, to the // RemoteNotes list, does NOT check for duplicates. Only gets // Name (that is, FileName maybe with dir prepended) and sha. //function AddJItem(jItm: TJSONData; Prefix: string): boolean; // Adds a new item to List, Notes and files in Meta require prefix added before being passed here procedure AddNewItem(const FName, Sha: string); function Add(AGitNote : PGitNote) : integer; // Adds or updates record, FName being key. procedure Add(const FName, Sha: string); // Selectivly inserts the supplied data into GitNoteList. // Always use most fields but don't use LCD if the sha do not match. procedure InsertData(const GitRec : TGitNote); // Returns true and sets sha if note is in List. Ignores trailing / in FName. // If the Note exists in the list but its sha is not set, ret True but sha is empty function FNameExists(FName: string; out Sha: string): boolean; { Tries to find the list item, first tries RNotesDir+ID+.md and then tries as if ID is FFname. Returns a pointer to a GitNote record or nil if not found. } function Find(const ID: string): PGitNote; property Items[Index: integer]: PGitNote read Get; default; end; type { TGitHub } { TGitHubSync } {$ifdef TESTRIG} TGitHubSync = class {$else} TGithubSync = class(TTomboyTrans) {$endif} private { Private : Initialised in TestConnection which calls ScanRemoteRepo to put an ID and sha entry in, then ReadRemoteManifest to fill in cdate, format, title and notebooks. AssignAction will add locally know notes and and actions.} RemoteNotes : TGitNoteList; { Hold name of SelectiveSync Notebook, eg SyncGithub, set during a Join (depending on remote repo, a New (depending on if we have a Notebook by that name) or in a Use its loaded from RemoteManifest and cannot be changed. The actual name to trigger all this is a constant in implementation section of transgithub. } SelectiveSync : string; SelectiveNotebookIDs : TstringList; // May contain FNames of notes that are members of SelectiveSync notebook. Do not create or free. HeaderOut : string; // Very ugly global to get optional value back from Downloader // ToDo : do better than this Davo // A general purpose downloader, results in JSON, if downloading a file we need // to pass the Strings through ExtractContent() to do JSON and base64 stuff. // This method may set ErrorMessage, it might need resetting afterwards. // The two optional parameter must be used together and extract one header value. function Downloader(URL: string; out SomeString: String; const Header: string =''): boolean; //procedure DumpJSON(const St: string; WhereFrom: string = ''); { Returns the LCDate string from the commit history. We ask for just the most recent commit and find the datestring in the json. Expects a full file name, something like 'Notes/6EC64290-4348-4716-A892-41C9DE4AEC4C.md' - should work for any format.} function GetNoteLCD(FFName: string): string; { Used only by AssignActions, scans over NoteLister's notes adding any it finds present in NoteLister but not yet in RMData. We might exclude notes not members of the SyncGithub notebook if SelectiveSync contains that name. The list of local notes who are members of SyncGithub might be nil is no local SyncGithub. Note : we don't copy records from RMetaData to RemoteNotes is TestRun. } function MergeNotesFromNoteLister(RMData: TNoteInfoList; TestRun: boolean ): boolean; // Reads the (json) remote manifest, adding cdate, format and Notebooks to RemoteNotes. // Assumes RemoteNotes is created, comms tested. Ret false if cannot find remote // manifest. All a best effort approach, a github created note will not be listed. function ReadRemoteManifest(): boolean; // Generic Putting / Posting Method. Put = False means Post. If an FName is provided // then its a file upload, record the sha in RemoteNotes. function SendData(const URL, BodyJSt: String; Put: boolean; FName: string = ''): boolean; // Returns URL like https://api.github.com/repos/davidbannon/tb_test/contents (true) // Or like https://github.com/davidbannon/tb_test/blob/main/ (false) // Requires UserName, RemoteRepoName, API version does not have trailing / function ContentsURL(API: boolean): string; // Returns content asociated with Key at either toplevel (no third parameter) or // one level down under the ItemNo indexed toplevel Key. First top level key is zero. function ExtractJSONField(const data, Field: string; Level1: string = ''; Level2: string = ''): string; function GetServerId() : string; // Creates a file at remote using contents of List. RemoteFName may be // something like Meta/serverid for example. Checks RemoteNotes to see if // file already exists and does update node if it does. No dir is defaulted to. function SendFile(RemoteFName: string; STL: TstringList): boolean; // Makes a new remote repo if it does not exist, if called when repo // does exist, will check that a serverID is present and just return false // If the ServerID is NOT present, will make one and return true function MakeRemoteRepo() : boolean; // Gets just an ID, uses NotesDir to load that into commonmark and then passes // the resulting string to SendFile. Also works for NoteBooks ?? function SendNote(ID: string): boolean; // Scans the top level of the repo and then Notes and Meta recording in me and // RemoteNotes the filename and sha for every remote file it finds. function ScanRemoteRepo() : boolean; // Returns true if it has written temp file named ID.note-temp in Note format in the // NotesDir. Assumes it can write in NotesDir. If FFName provided, saves there instead. // FFName, if provided, must include path and extension and must be writable. function DownloadANote(const NoteID: string; FFName: string = ''): boolean; public //UserName : string; //RemoteRepoName : string; // eg tb_test, tb_notes TokenExpires : string; // Will have token expire date after TestTransport() {$ifdef TESTRIG} // These are all defined in trans, need to provide them is in TestRig mode RemoteServerRev : integer; ServerID : string; ErrorString : string; Password : string; ANewRepo : boolean; ProgressProcedure : TProgressProcedure; RemoteAddress : string; {$endif} (* ------------- Defined in parent class ---------------- Password : string; // A password for those Transports that need one. DebugMode : boolean; ANewRepo : Boolean; // Indicates its a new repo, don't look for remote manifest. ErrorString : string; // Set to '' is no errors. NotesDir, ConfigDir : string; // Local notes directory RemoteAddress : string; // A url to network server or 'remote' file directory for FileSync ServerID : string; { The current server ID. Is set with a successful TestTransport call. } RemoteServerRev : integer; { The current Server Rev, before we upload. Is set with a successful TestTransport call. } *) constructor Create(); destructor Destroy; override; // --------------- Methods required to be here by Trans ---------------- { GitHub - tries to contact Github, testing UserName, Token and tries to scan the remote files putting ID and SHA into RemoteNotes. If WriteNewID is true, tries to create repo first. Does no fill in LCD, will need to be done, note by note later. Might return SyncNetworkError, SyncNoRemoteMan, SyncReady, SyncCredentialError } function TestTransport(const WriteNewServerID: boolean = False): TSyncAvailable; {$ifndef TESTRIG} override;{$endif} { Github : Checks Temp dir, should empty it, ret TSyncReady or SyncBadError Sets RemoteAddress (so must have username available) } function SetTransport() : TSyncAvailable; {$ifndef TESTRIG} override;{$endif} { Github : This is just a stub here, does nothing. We populate RemoteNotes in AssignAction()} function GetRemoteNotes(const NoteMeta : TNoteInfoList; const GetLCD : boolean) : boolean; {$ifndef TESTRIG} override;{$endif} { GitHub : after downloading a note we record its LCDate in RemoteNotes because it will be needed to write the remote manifest a bit later } function DownloadNotes(const DownLoads: TNoteInfoList): boolean; {$ifndef TESTRIG} override;{$endif} function DeleteNote(const ID : string; const ExistRev : integer) : boolean; {$ifndef TESTRIG} override;{$endif} {Github : we expect a list of plain IDs, we update the GUI Progress indicator here. Pass SendNote an ID, downstream look after updating RemoteNotes sha data but we set the LCDate (in RemoteNotes) here. } function UploadNotes(const Uploads: TStringList): boolean; {$ifndef TESTRIG} override;{$endif} {GitHub : Has to make Meta/mainfest.json and README.md. ignores RevNo and the passed manifest, We must have the RemoteMetaData which tells us which notes apply, CDate, LCD etc. Notebooks comes from NoteLister. Must be called after syncing done so it can copy SHA data to RemoteMetaData. Make just a flat index but in future, some sort of notebook organisation. Generate suitable content, upload it, README.md to Github. } function DoRemoteManifest(const RemoteManifest : string; MetaData : TNoteInfoList = nil) : boolean; {$ifndef TESTRIG} override;{$endif} { Github - Downloads indicated note to temp dir, returns FFname is OK The downloaded file should be reusable in this session if its later needed } function DownLoadNote(const ID : string; const RevNo : Integer) : string; {$ifndef TESTRIG} override;{$endif} { Public - but not defined in Trans. Gets passed both Remote and Local MetaData lists, makes changes to only Remote. Relies on RemoteNotes, LocalMeta and NoteLister to fill in all details (inc Action) of all notes that are currently on remote server. Then scans over NoteLister adding any notes it finds that are not already in RemoteMetaData and marks them as SyUploads. Also adds the new NoteLister notes to RemoteNotes if NOT a TestRun.} function AssignActions(RMData, LMData: TNoteInfoList; TestRun: boolean): boolean; procedure Test(); end; // ============================================================================= implementation uses {$if (FPC_FULLVERSION>=30200)} opensslsockets, {$endif} // only available in FPC320 and later {$ifdef LCL} lazlogger, {$endif} // trying to not be dependent on LCL fphttpclient, httpprotocol, base64, LazUTF8, LazFileUtils, fpopenssl, ssockets, {ssockets,} DateUtils, fileutil, CommonMark, import_notes, Note_Lister, TB_Utils, jsontools, ResourceStr; const GitBaseURL='https://github.com/'; BaseURL='https://api.github.com/'; RNotesDir='Notes/'; RMetaDir='Meta/'; RemoteRepoName='tb_notes'; {$ifdef TESTRIG} NotesDir='/home/dbannon/Pascal/GithubAPI/notes/'; UserName='davidbannon'; DebugMode=true; {$endif} TempDir='Temp/'; // see also UserName (eg davidbannon) and RemoteRepoName (eg tb_test) // ================================ TGitNoteList =============================== function TGitNoteList.Get(Index: integer): PGitNote; begin Result := PGitNote(inherited get(Index)); end; procedure TGitNoteList.DumpList(wherefrom: string); var i : integer = 0; {Notebooks,} Format : string = ''; begin SayDebugSafe(''); if Wherefrom <> '' then SayDebugSafe('-------- TransGithub RemoteNotes ' + Wherefrom + '----------'); while i < count do begin case Items[i]^.Format of ffNone : Format := 'not set'; ffEncrypt : Format := 'Encrypt'; ffMarkDown : format := 'Markdown'; end; SayDebugSafe('List - FFName=[' + Items[i]^.FName + '] Sha=' + Items[i]^.Sha + ' LCDate=' + Items[i]^.LCDate); SaydebugSafe(' CDate=' + Items[i]^.CDate + ' Format=' + Format + ' Title=' + Items[i]^.Title + ' Notebooks=' + Items[i]^.Notebooks); inc(i); end; end; constructor TGitNoteList.Create(); begin inherited Create; end; destructor TGitNoteList.Destroy; var i : integer; begin for I := 0 to Count-1 do begin dispose(Items[I]); end; inherited Destroy; end; procedure TGitNoteList.AddNewItem(const FName, Sha: string); var PNote : PGitNote; begin new(PNote); PNote^.FName := Fname; PNote^.Title := ''; PNote^.LCDate := ''; PNote^.CDate := ''; PNote^.Format := ffNone; PNote^.Notebooks := ''; PNote^.sha := Sha; add(PNote); end; function TGitNoteList.Add(AGitNote: PGitNote): integer; begin result := inherited Add(AGitNote); end; procedure TGitNoteList.Add(const FName, Sha: string); var PNote : PGitNote; i : integer = 0; begin while i < count do begin if Items[i]^.FName = FName then begin Items[i]^.Sha := Sha; exit; end; inc(i); end; // OK, must be a new entry new(PNote); PNote^.FName := FName; PNote^.Sha := Sha; PNote^.Title := ''; PNote^.LCDate := ''; PNote^.CDate := ''; PNote^.Format := ffNone; Add(PNote); end; procedure TGitNoteList.InsertData(const FName, Field, Data : string); var //i : integer = 0; P : PGitNote; begin for p in self do begin if p^.FName = FName then begin case Field of 'title' : p^.Title := Data; 'lcdate' : p^.LCDate := Data; 'sha' : p^.Sha := Data; 'cdate' : p^.CDate := Data; // 'format' : p^.Format := Data; 'notebooks' : p^.Notebooks := Data; otherwise SayDebugSafe('TGitNoteList.InserData(s,s,s) asked to insert into nonexisting field : ' + Field); end; exit; end; end; SayDebugSafe('GitHub.InsertData(s,s,s) : Failed to find ' + FName + ' to insert data'); end; procedure TGitNoteList.InsertData(const GitRec : TGitNote); var i : integer = 0; begin if GitRec.FName = '' then begin SayDebugSafe('TGitNoteList.InsertData ERROR received a record with blank FName, Title is ' + GitRec.Title); exit; end; while i < count do begin if Items[i]^.FName = GitRec.FName then begin Items[i]^.Title := GitRec.Title; Items[i]^.CDate := GitRec.CDate; Items[i]^.Format := GitRec.Format; Items[i]^.Notebooks := GitRec.Notebooks; if Items[i]^.Sha = GitRec.Sha then Items[i]^.LCDate := GitRec.LCDate else Items[i]^.LCDate := ''; // note has been edited in Github web interface if Items[i]^.CDate = '' then Items[i]^.CDate := TheMainNoteLister.GetLastChangeDate(extractFileName(GitRec.FName)); // Leave LCDate as it is, we may fix it with a download later. For now, its not useful. // We could get the commit date (a zulu date) but not sure its worthwhile at this stage. exit; end; inc(i); end; SayDebugSafe('GitHub.InsertData : Failed to find ' + GitRec.FName + ' to insert data'); end; function TGitNoteList.FNameExists(FName: string; out Sha: string): boolean; var i : integer = 0; begin Sha := ''; if FName[length(FName)] = '/' then FName := FName.remove(length(FName)-1); // its part of a URL so don't reverse for windows ! while i < count do begin if Items[i]^.FName = FName then begin Sha := Items[i]^.Sha; exit(True); end; inc(i); end; debugln('TGitNoteList.FNameExists WARNING ? did not find ID=[' + FName +']'); result := False; end; function TGitNoteList.Find(const ID : string): PGitNote; var i : integer = 0; begin while i < count do begin if Items[i]^.FName = RNotesDir + ID + '.md' then // first, assume its a note exit(Items[i]); if Items[i]^.FName = ID then // but also try as if its a FFName exit(Items[i]); inc(i); end; Result := Nil; end; // =========================== T G i t H u b ================================ // ---------------- P U B L I C M E T H O D S ie from Trans ----------------- function TGitHubSync.TestTransport(const WriteNewServerID: boolean): TSyncAvailable; { If we initially fail to find offered user account, try defunkt so we can tell if its a network error or username one. } var St : string; begin Result := SyncNotYet; ErrorString := ''; {$ifdef DEBUG} debugln('TGithubSync.TestTransport - WriteNewServerID is ', booltostr(WriteNewServerID, true)); {$endif} if ANewRepo and WriteNewServerID then // Will fail ? if repo already exists. MakeRemoteRepo(); if RemoteNotes <> Nil then RemoteNotes.Free; RemoteNotes := TGitNoteList.Create(); if ProgressProcedure <> nil then ProgressProcedure(rsTestingCredentials); //debugln('TGithubSync.TestTransport - about to get auth-token-expire'); //debugln('URL=' + BaseURL + 'users/' + UserName); if DownLoader(BaseURL + 'users/' + UserName, ST, 'github-authentication-token-expiration') then begin // So, does nominated user account exist ? if ExtractJSONField(ST, 'login') = UserName then begin // "A" valid username TokenExpires := HeaderOut; //SayDebugSafe('Confirmed login OK'); if TokenExpires = '' then begin ErrorString := 'Username exists but Token Failure'; exit(SyncCredentialError); // Token failure end; // If to here, we have a valid username and a valid Password but don't know if they work together if ProgressProcedure <> nil then progressProcedure(rsLookingServerID); ServerID := GetServerId(); //debugln('TGithubSync.TestTransport : serverID is ' + ServerID); if ServerID = '' then begin ErrorString := 'Failed to get a ServerID, does Token have Repo Scope ?'; exit(SyncNoRemoteRepo) end else begin if ProgressProcedure <> nil then progressProcedure(rsScanRemote); if not ScanRemoteRepo() then exit(SyncBadRemote); // puts only remote filenames and sha in RemoteNotes if (not ReadRemoteManifest()) then begin if (not ANewRepo) and (not WriteNewServerID) then // do not expect a remote manifest in ANewRepo mode. // But if we have had an aborted New process, might mave serverid but no manifest exit(SyncNoRemoteMan) else ANewRepo := True; end; // we MUST detect here where a user is trying to add SelectiveSync to an existing non-selective repo = ERROR. // If remote is already selective, thats OK, it stays that way. If the remote is not selective but readable, // and local system is selective, ERROR. But if we appear to be building a new repo, we will go with // whatever the local system does. { I have two vars, SelectiveSync will hold name of selective NB RemoteManifest has one set. Even if local system does not have that NB (and therefore has no notes suitable). Else its empty. Secondly, we have SelectiveNotebookIDs, a pointer to the local selective NB's list of notes. If there is no local selective NB, then SelectiveNotebookIDs is nil. And we should skip all local files. If the remote repo is not selective but local one is, thats an ERROR. The exception being if the remote repo is being constructed, has serverID perhaps but no remotemanifest, ANewRepo is true, then we follow local policy. REMEMBER - SelectiveNotebookIDs might be nil ! } if TheMainNoteLister.GetNotesInNoteBook(SelectiveNotebookIDs, SyncTransportName(SyncGithub)) and (SelectiveSync = '') and (not ANewRepo) then begin ErrorString := 'Local is Selective, remote is NOT'; SayDebugSafe(ErrorString + ' probably need build a new remote repo, please read documentation'); exit(SyncMismatch) end; if (SelectiveSync = '') and assigned(SelectiveNotebookIDs) then // Use local 'cos its a new repo. SelectiveSync := SyncTransportName(SyncGithub); {$ifdef DEBUG} debugln('TGitHubSync.TestTransport SelectiveSync=' + SelectiveSync); if not assigned(SelectiveNotebookIDs) then debugln('TGitHubSync.TestTransport SelectiveNotebookIDs not assigned.'); {$endif} Result := SyncReady; if ProgressProcedure <> nil then ProgressProcedure('TestTransport Happy, SelectiveSync=' + SelectiveSync); end; end else SayDebugSafe('TGithubSync.TestTransport - Spoke to Github but did not confirm login'); end else begin if DownLoader(BaseURL + 'users/defunkt', ST) then begin ErrorString := ErrorString + ' Username is not valid : ' + UserName; exit(SyncCredentialError); end else begin // here probably because of a bad token, lets rewrite the error message if pos('401', ErrorString) > 0 then ErrorString := ' ' + rsGithubTokenExpired; exit(SyncNetworkError); end; end; end; function TGitHubSync.SetTransport(): TSyncAvailable; begin if DebugMode then saydebugSafe('TGithubSync.SetTransport - called'); if not directoryexists(NotesDir + TempDir) then ForceDirectory(NotesDir + TempDir); if directoryexists(NotesDir + TempDir) and DirectoryIsWritable(NotesDir + TempDir) then begin result := SyncReady; if not DeleteDirectory(NotesDir + TempDir, True) then Saydebugsafe('TGithubSync.SetTransport ERROR, failed to clear out Temp dir'); // by clearing the Temp dir, we know any files in there later on arrived in // this session and can be safely re-used eg, ones pulled down for clash handling. end else begin SayDebugSafe('Cannot use dir : ' + NotesDir + TempDir); exit(SyncBadError); end; RemoteAddress := GitBaseURL + UserName + '/' + RemoteRepoName; end; function TGitHubSync.DownloadNotes(const DownLoads: TNoteInfoList): boolean; var I : integer; DownCount : integer = 0; FullFileName : string; begin Result := True; if not DirectoryExists(NotesDir + TempDir) then exit(SayDebugSafe('TGithubSync.DownloadNotes - ERROR, no temp dir ' + NotesDir + TempDir)); if ProgressProcedure <> nil then ProgressProcedure(rsDownloadNotes); if not DirectoryExists(NotesDir + 'Backup') then if not ForceDirectory(NotesDir + 'Backup') then begin ErrorString := 'Failed to create Backup directory.'; exit(False); end; for I := 0 to DownLoads.Count-1 do begin if DownLoads.Items[I]^.Action = SyDownLoad then begin if FileExists(NotesDir + Downloads.Items[I]^.ID + '.note') then // First make a Backup copy if not CopyFile(NotesDir + Downloads.Items[I]^.ID + '.note', NotesDir + 'Backup' + PathDelim + Downloads.Items[I]^.ID + '.note') then begin ErrorString := 'GitHub.DownloadNotes Failed to copy file to Backup ' + NotesDir + Downloads.Items[I]^.ID + '.note'; exit(False); end; FullFileName := NotesDir + TempDir + Downloads.Items[I]^.ID + '.note'; if not FileExists(FullFileName) then Result := DownloadANote(Downloads.Items[I]^.ID, FullFileName) // OK, now download the file, else Result := True; // we must have downloaded it to resolve clash if Result and fileexists(FullFileName) then begin // to be sure, to be sure deletefile(NotesDir + Downloads.Items[I]^.ID + '.note'); renamefile(FullFileName, NotesDir + Downloads.Items[I]^.ID + '.note'); end else begin ErrorString := 'GitHub.DownloadNotes Failed to download ' + FullFileName; exit(SayDebugSafe('TGithubSync.DownloadNotes - ERROR, failed to down to ' + FullFileName)); end; inc(DownCount); if (DownCount mod 5 = 0) then if ProgressProcedure <> nil then ProgressProcedure(rsDownLoaded + ' ' + inttostr(DownCount) + ' notes'); end; end; end; function TGitHubSync.DeleteNote(const ID: string; const ExistRev: integer ): boolean; // https://docs.github.com/en/rest/reference/repos#delete-a-file var Response : TStringList; Client: TFPHttpClient; BodyStr, Sha : string; RFName : string; begin Result := false; RFName := RNotesDir + ID + '.md'; if not (RemoteNotes.FNameExists(RFName, Sha) and (Sha <> '')) then begin // Try for an ID first. RFName := ID; if not (RemoteNotes.FNameExists(RFName, Sha) and (Sha <> '')) then // Failing an ID, we try "as is". exit(SayDebugSafe('TGitHubSync.DeleteNote ERROR did not find sha for ' + ID)); end; BodyStr := '{ "message": "update upload", "sha" : "' + Sha + '" }'; Client := TFPHttpClient.create(nil); Response := TStringList.create; try Client.AddHeader('User-Agent','Mozilla/5.0 (compatible; fpweb)'); Client.AddHeader('Content-Type','application/json; charset=UTF-8'); Client.AddHeader('Accept', 'application/json'); Client.AllowRedirect := true; Client.UserName:=UserName; Client.Password:=Password; client.RequestBody := TRawByteStringStream.Create(BodyStr); Client.Delete(ContentsURL(True) + '/' + RFName, Response); Result := (Client.ResponseStatusCode = 200); if not Result then begin saydebugsafe('TGitHubSync.DeleteNote : Delete returned ' + inttostr(Client.ResponseStatusCode)); saydebugsafe('URL=' + ContentsURL(true) + '/' + RFName); saydebugsafe(' ------------- Delete Response ------------'); saydebugsafe(Response.text); saydebugsafe(' ------------- Delete Response End ------------'); end; finally Response.free; Client.RequestBody.Free; Client.Free; end; end; function TGitHubSync.GetRemoteNotes(const NoteMeta: TNoteInfoList; const GetLCD: boolean): boolean; begin if (RemoteNotes = Nil) or (NoteMeta = Nil) then exit(SayDebugSafe('TGitHubSync.GetRemoteNotes ERROR getRemoteNotes called with nil list')); result := True; end; function TGitHubSync.UploadNotes(const Uploads: TStringList): boolean; var St : string; NoteCount : integer = 0; begin {$ifdef DEBUG} RemoteNotes.DumpList('TGitHubSync.UploadNotes : About to upload ' + inttostr(UpLoads.Count) + ' notes'); {$endif} if ProgressProcedure <> nil then ProgressProcedure(rsUpLoading + ' ' + inttostr(Uploads.Count)); for St in Uploads do begin if not SendNote(St) then exit(false); inc(NoteCount); if NoteCount mod 5 = 0 then if ProgressProcedure <> nil then ProgressProcedure(rsUpLoaded + ' ' + inttostr(NoteCount) + ' notes'); RemoteNotes.InsertData(RNotesDir + St + '.md', 'lcdate', TheMainNoteLister.GetLastChangeDate(St)); // ToDo : that has hardwired assumpltion about markdown end; result := true; end; function TGitHubSync.DoRemoteManifest(const RemoteManifest: string; MetaData: TNoteInfoList): boolean; var P : PNoteInfo; // an item from RemoteMetaData PGit : PGitNote; // an item from local data structure, RemoteNotes Readme, manifest : TStringList; St, Notebooks : string; begin // Note : we do not use the supplied XML RemoteManifest, we build our own json one. Result := false; Readme := TstringList.Create; Manifest := TstringList.Create; Readme.Append('## My tomboy-ng Notes'); // * [Note Title](https://github.com/davidbannon/tb_demo/blob/main/Notes/287CAB9C-A75F-4FAF-A3A4-058DDB1BA982.md) Manifest.Append('{' + #10' "selectivesync" : "' + EscapeJSON(SelectiveSync) + '",'#10' "notes" : {'); try if MetaData = nil then exit(SayDebugSafe('TGithubSync.DoRemoteManifest ERROR, passed a nil metadata list')); for P in MetaData do begin if P^.Action in [ SyNothing, SyUploadNew, SyUploadEdit, SyDownload, SyClash ] then begin // SyClash ? I don't think so ..... // These notes will be the ones that end up on GitHub after we finish. PGit := RemoteNotes.Find(P^.ID); if PGit = nil then exit(SayDebugSafe('TGitHubSync.DoRemoteManifest - ERROR, failed to find ID from RemoteMetaData in RemoteNotes')); Readme.Append('* [' + P^.Title + '](' + ContentsURL(False) + PGit^.FName + ')'); if P^.Action = SyDownload then NoteBooks := PGit^.Notebooks else NoteBooks := TheMainNoteLister.NotebookJArray(P^.ID + '.note'); Manifest.Append(' "' + P^.ID + '" : {'#10 + ' "title" : "' + EscapeJSON(P^.Title) + '",'#10 + ' "cdate" : "' + P^.CreateDate + '",'#10 + ' "lcdate" : "' + PGit^.LCDate + '",'#10 + ' "sha" : "' + PGit^.Sha + '", '#10 + ' "format" : "md",'#10 + ' "notebooks" : '+ NoteBooks + #10 + ' },'); // should be empty string or eg ["one", "two"] end; end; // Remove that annoying trailing comma from last block if manifest.count > 0 then begin St := manifest[manifest.count-1]; if St[St.Length] = ',' then begin delete(St, St.Length, 1); manifest.Delete(manifest.count-1); manifest.append(St); end; end; Readme.append(''); Readme.append('***' + rsMetaDirWarning + '***'); Manifest.Append(' }'#10 + '}'#10); for PGit in RemoteNotes do // Put all the SHAs we know about into RemoteMetaData (for local manifest); if PGit^.Sha <> '' then begin P := MetaData.FindID(extractFileNameOnly(PGit^.FName)); if P <> nil then P^.Sha := PGit^.Sha; end; if not SendFile(RMetaDir + 'manifest.json', Manifest) then SayDebugSafe('TGitHubSync.DoRemoteManifest ERROR, failed to write remote manifest'); if not SendFile('README.md', Readme) then SayDebugSafe('TGitHubSync.DoRemoteManifest ERROR, failed to write remote README'); result := true; finally Manifest.Free; Readme.Free; end; end; function TGitHubSync.DownLoadNote(const ID: string; const RevNo: Integer): string; begin if DownloadANote(ID, NotesDir + TempDir + ID + '.note') then Result := NotesDir + TempDir + ID + '.note' else Result := ''; end; // ToDo : work through this better, are we risking race conditions here ? const Seconds5 = 0.00005; // Very roughly, 5 seconds function TGitHubSync.MergeNotesFromNoteLister(RMData : TNoteInfoList; TestRun: boolean) : boolean; var PGit : PGitNote; RemRec: PNoteInfo; NLister : PNote; i : integer; begin if (SelectiveSync <> '') and (not Assigned(SelectiveNotebookIDs)) then // Something in SelectiveSync but no local NB, no uploads possible exit(false); for i := 0 to TheMainNoteLister.GetNoteCount() -1 do begin // OK, now whats in NoteLister but not RemoteNotes ? NLister := TheMainNoteLister.GetNote(i); // debugln('TGitHubSync.MergeNotesFromNoteLister considering Title=' + NLister^.Title); if NLister = nil then exit(SayDebugSafe('TGitHubSync.AssignActions ERROR - not finding NoteLister Content')); // if I can be sure it really does sort the (NoteLister's) list with SelectiveNotebookIDs.sorted := true. // Calling SelectiveNotebookIDs.Sort does not seem to work ?? // we know we can safely poke at SelectiveNotebookIDs if SelectiveSync is not empty. if (SelectiveSync <> '') and (FindInStringList(SelectiveNotebookIDs, NLister^.ID) < 0) then continue; // Look for items in NoteLister that do not currently exist in RemoteMetaData. If we find one, // we will add it to both RemoteMetaData and RemoteNodes (because its needed to store sha on upload) // debugln('TGitHubSync.MergeNotesFromNoteLister Adding Title=' + NLister^.Title); if RMData.FindID(extractfilenameonly(NLister^.ID)) = nil then begin if not TestRun then begin new(PGit); PGit^.FName := RNotesDir + extractfilenameonly(NLister^.ID) + '.md'; // ToDo : Careful, assumes markdown PGit^.Sha := ''; PGit^.Notebooks := ''; PGit^.CDate := NLister^.CreateDate; PGit^.LCDate := NLister^.LastChange; PGit^.Format := ffMarkDown; RemoteNotes.Add(PGit); end; new(RemRec); RemRec^.ID := extractfilenameonly(NLister^.ID); RemRec^.LastChange := NLister^.LastChange; RemRec^.CreateDate := NLister^.CreateDate; RemRec^.Sha := ''; RemRec^.Title := NLister^.Title; RemRec^.Action := SyUploadNew; RemRec^.Deleted := False; RemRec^.Rev := 0; RemRec^.SID := 0; RMData.Add(RemRec); end { else debugln('TGithubSync.AssignActions - skiping because its already in RemoteNotes')}; end; Result := true; end; function TGitHubSync.AssignActions(RMData, LMData: TNoteInfoList; TestRun: boolean): boolean; var PGit : PGitNote; RemRec, LocRec : PNoteInfo; I : integer; //NLister : PNote; pNBook: PNoteBook; LCDate, CDate : string; begin // RMData should be empty, LMData will be empty if its a Join. Result := True; {$ifdef DEBUG} debugln('=================================================================='); debugln(' A S S I G N A C T I O N S '); debugln('=================================================================='); RMData.DumpList('TGithubSync.AssignActions.start RemoteMD'); LMData.DumpList('TGithubSync.AssignActions.start LocalMD'); RemoteNotes.DumpList('TGithubSync.AssignActions.start RemoteNotes'); {$endif} for PGit in RemoteNotes do begin // First, put an entry in RemoteMetaData for every remote note. if copy(PGit^.FName, 1, length(RNotesDir)) <> RNotesDir then continue; // Every note we see in this loop exists remotely. But may not exist locally. new(RemRec); RemRec^.ID := extractFileNameOnly(PGit^.FName); LocRec := LMData.FindID(RemRec^.ID); // Nil is OK, just means the note is not in LocalMetaData RemRec^.CreateDate := PGit^.CDate; RemRec^.LastChange := PGit^.LCDate; // We may not have this, if note was edited in github RemRec^.Deleted := false; RemRec^.Rev := 0; RemRec^.SID := 0; RemRec^.Title := TheMainNoteLister.GetTitle(RemRec^.ID); // We 'prefer' the local title, remote one may be different if RemRec^.Title = '' then RemRec^.Title := TheMainNoteLister.GetNotebookName(RemRec^.ID); // Maybe its a template ? RemRec^.Action := SyUnset; if RemRec^.Title = '' then begin // Not in Notelister, must be new or locally deleted //debugln('TGithubSync.AssignActions setting ' + RemRec^.ID + ' to Download #1'); RemRec^.Action := SyDownLoad; // May get changed to SyDeleteRemote RemRec^.Title := PGit^.Title; // One we prepared earlier, from remote manifest {$ifdef DEBUG} //SayDebugSafe('TGithubSync.AssignActions RemRec^.Title = ' + RemRec^.Title); //SayDebugSafe('TGithubSync.AssignActions PGit^.Title = ' + PGit^.Title); {$endif} end else begin // OK, it exists at both ends, now we need to look closely. //debugln('TGithubSync.AssignActions - Possibe clash LMData.LastSyncDate UTC= ' + FormatDateTime('YYYY MM DD : hh:mm', LMData.LastSyncDate )); if LMData.LastSyncDate < 1.0 then begin // Not valid // if LastSyncDate is 0.0, a Join. An ID that exists at both ends is a clash. No local manifest to help here. // But we have one more trick. If the remote note has a valid LCDate in RemoteNotes, it came from a -ng // (ie, not a Github edit). We can compare the date string to the local one and if they match, all good. if (PGit^.LCDate <> '') and (TheMainNoteLister.GetLastChangeDate(RemRec^.ID) = PGit^.LCDate) then RemRec^.Action := SyNothing else RemRec^.Action := SyClash; // OK, we tried but this one goes through to keeper. //debugln('TGithubSync.AssignActions - found possible JOIN clash, now its ' + RMData.ActionName(RemRec^.Action)); //debugln('PGit^.LCDate = ' + PGit^.LCDate + ' and TheNoteLister.GetLastChangeDate = ' + LocalLastChangeDate(RemRec^.ID + '.note')); end else begin // Normal sync, we have a local manifest. if (TB_GetGMTFromStr(TheMainNoteLister.GetLastChangeDate(RemRec^.ID)) - Seconds5) > LMData.LastSyncDate then RemRec^.Action := SyUploadEdit; // changed since last sync ? Upload it ! if LocRec = Nil then begin // ?? If it exists at both ends we must have uploaded it ?? dispose(RemRec); ErrorString := 'TGitHubSync.AssignActions ERROR, ID not found in LocalMetaData, might need to force a Join.'; exit(SayDebugSafe(ErrorString)); end else if PGit^.Sha <> LocRec^.Sha then begin // Ah, its been changed remotely if RemRec^.Action = SyUnset then begin //debugln('TGithubSync.AssignActions setting ' + RemRec^.ID + ' to Download #2'); //debugln('PGit^.Sha=' + PGit^.Sha + ' and LocRec^.Sha=' + LocRec^.Sha); RemRec^.Action := SyDownLoad // Good, only remotely end else begin RemRec^.Action := SyClash; // There is a problem to solve elsewhere. //debugln('TGitHubSync.AssignActions - assigning clash'); //debugln('sha from remote=' + PGit^.Sha + ' and local=' + LocRec^.Sha); end; end; end; //debugln('TGithubSync.AssignActions - Possibe clash becomes ' + RMData.ActionName(RemRec^.Action)); end; if RemRec^.Action = SyUnset then RemRec^.Action := SyNothing; RMData.Add(RemRec); end; {$ifdef DEBUG} RMData.DumpList('TGithubSync.AssignActions RemoteMD - Before scanning NoteLister'); {$endif} MergeNotesFromNoteLister(RMData, TestRun); // OK, just need to check over the Notebooks now, notebooks are NOT listed in NoteLister.Notelist ! for i := 0 to TheMainNoteLister.NotebookCount() -1 do begin pNBook := TheMainNoteLister.GetNoteBook(i); if (SelectiveSync <> '') and (SelectiveSync <> pNBook^.Name) then // only interested in SyncGithub template here.... continue; if RMData.FindID(extractfilenameonly(pNBook^.Template)) = nil then begin ErrorString := ''; CDate := GetNoteLastChangeSt(NotesDir + pNBook^.Template, ErrorString, True); LCDate := GetNoteLastChangeSt(NotesDir + pNBook^.Template, ErrorString, False); if ErrorString <> '' then exit(SayDebugSafe('Failed to find dates in template ' + pNBook^.Template)); if not TestRun then begin new(PGit); PGit^.FName := RNotesDir + extractfilenameonly(pNBook^.Template) + '.md'; // ToDo : Careful, assumes markdown PGit^.Sha := ''; PGit^.Notebooks := ''; PGit^.CDate := CDate; PGit^.LCDate := LCDate; PGit^.Format := ffMarkDown; RemoteNotes.Add(PGit); end; new(RemRec); RemRec^.ID := extractfilenameonly(pNBook^.Template); RemRec^.LastChange := LCDate; RemRec^.CreateDate := CDate; RemRec^.Sha := ''; RemRec^.Title := pNBook^.Name; RemRec^.Action := SyUploadNew; RemRec^.Deleted := False; RemRec^.Rev := 0; RemRec^.SID := 0; RMData.Add(RemRec); end {else debugln('TGithubSync.AssignActions - skiping because its already in RemoteNotes')}; end; {$ifdef DEBUG} RMData.DumpList('TGithubSync.AssignActions.End RemoteMD'); LMData.DumpList('TGithubSync.AssignActions.End LocalMD'); RemoteNotes.DumpList('TGithubSync.AssignActions.End RemoteNotes'); {$endif} end; procedure TGitHubSync.Test(); var ST : string; begin if Downloader(ContentsURL(True)+'/'+RNotesDir, ST) then begin // Github appears to be happy with Notes and Notes/ ? debugln('---------------------------------------------'); debugln(St); debugln('---------------------------------------------'); end else debugln('Downloader Failed'); end; // ==================== P R I V A T E M E T H O D S ========================= function TGitHubSync.GetNoteLCD(FFName : string) : string; var St : string; URL : string; begin Result := ''; // This call brings back an array, '[one-record]', note its not the Contents URL ! URL := BaseURL + 'repos/' + UserName + '/' + RemoteRepoName + '/'; if DownLoader(URL + 'commits?path=' + FFName + '&per_page=1&page=1', ST) then begin if St[1] = '[' then begin delete(St, 1, 1); end else SayDebugSafe('GitHub.GetNoteLCD - Error, failed to remove from array'); if St[St.Length] = ']' then begin delete(St, St.Length, 1); end else SayDebugSafe('GetNoteLCD - Error, failed to remove [ from array'); Result := ExtractJSONField(St, 'date', 'commit', 'author'); if (Result = '') or (Result[1] = 'E') then // E for ERROR SayDebugSafe('TGitHubSync.GetNoteLCD ERROR failed to find commit date in JSON ' + St + ' for file ' + FFName); end; end; function TGitHubSync.SendNote(ID: string): boolean; var STL : TStringList; CM : TExportCommon; begin STL := TStringList.Create; CM := TExportCommon.Create; try CM.NotesDir := NotesDir; CM.GetMDcontent(ID, STL); if STL.Count < 1 then exit(False); Result := SendFile(RNotesDir + ID + '.md', STL); finally CM.Free; STL.Free; end; end; function TGitHubSync.SendFile(RemoteFName: string; STL: TstringList): boolean; // Public only in test mode var Sha : string = ''; BodyStr : string; begin if RemoteNotes = nil then exit(false); if RemoteNotes.FNameExists(RemoteFName, Sha) and (Sha <> '') then begin // Existing file mode BodyStr := '{ "message": "update upload", "sha" : "' + Sha + '", "content": "' + EncodeStringBase64(STL.Text) + '" }'; if Sha = '' then exit(False); end else begin // New file mode BodyStr := '{ "message": "initial upload", "content": "' + EncodeStringBase64(STL.Text) + '" }'; end; Result := SendData(ContentsURL(True) + '/' + RemoteFName, BodyStr, true, RemoteFName); end; function TGitHubSync.MakeRemoteRepo(): boolean; var GUID : TGUID; STL: TstringList; begin // https://docs.github.com/en/rest/reference/repos#create-a-repository-for-the-authenticated-user {$ifdef DEBUG} SayDebugSafe('TGitHubSync.MakeRemoteRepo called'); {$endif} Result := SendData(BaseURL + 'user/repos', '{ "name": "' + RemoteRepoName + '", "auto_init": true, "private": true" }', False); if (not Result) and (GetServerId() <> '') then exit(false); {$ifdef DEBUG} SayDebugSafe('TGitHubSync.MakeRemoteRepo creating new ServerID'); {$endif} CreateGUID(GUID); STL := TstringList.Create; try ServerID := copy(GUIDToString(GUID), 2, 36); // it arrives here wrapped in {} STL.Add(ServerID); Result := SendFile(RMetaDir + 'serverid', STL); // Now, RemoteNotes does not exist at this stage !! // URL=https://api.github.com/repos/davidbannon/tb_test/contents/Meta/serverid finally STL.Free; end; {$ifdef DEBUG} SayDebugSafe('TGitHubSync.MakeRemoteRepo returning ' + booltostr(Result, True)); {$endif} //RemoteServerRev := -1; end; function TGitHubSync.ScanRemoteRepo(): boolean; var Node, ANode : TJsonNode; St, Sha : string; function ReadDir(Dir : string) : boolean; begin Result := True; if (Dir <> '') and (not RemoteNotes.FNameExists(Dir, Sha)) then exit; if Downloader(ContentsURL(True) + Dir, ST) then begin // St now contains a full dir listing as JSON array Node := TJsonNode.Create; try if Node.TryParse(St) then begin for ANode in Node do if ANode.Exists('name') and ANode.Exists('sha') then RemoteNotes.AddNewItem(Dir + ANode.Find('name').asString, ANode.Find('sha').asString) else exit(SayDebugSafe('TGitHubSync.ScanRemoteRepo - ERROR Invalid J data = ' + St)); end else exit(SayDebugSafe('TGitHubSync.ScanRemoteRepo - ERROR Invalid J data = ' + St)); finally Node.Free; end; end else exit(SayDebugSafe('TGitHubSync.ScanRemoteRepo - Download ERROR ' + Dir)); end; begin Result := ReadDir('') and ReadDir(RNotesDir) and ReadDir(RMetaDir); {$ifdef DEBUG} RemoteNotes.DumpList('TGitHubSync.ScanRemoteRepo RemoteNotes after Scan.'); {$endif} end; constructor TGitHubSync.Create(); begin ProgressProcedure := nil; // It gets passed after create. RemoteNotes := Nil; SelectiveNotebookIDs := nil; end; destructor TGitHubSync.Destroy; begin if RemoteNotes <> Nil then RemoteNotes.Free; inherited Destroy; end; function TGitHubSync.DownloadANote(const NoteID: string; FFName: string): boolean; var NoteSTL : TStringList; St : string; Importer : TImportNotes; PGit : PGitNote; begin Importer := Nil; NoteSTL := Nil; Result := True; {$ifdef DEBUG}Saydebugsafe('TGithubSync.DownloadANote');{$endif} try PGit := RemoteNotes.Find(RNotesDir + NoteID + '.md'); // ToDo : assumes markdown if PGit = nil then exit(SayDebugSafe('TGithubSync.DownloadANote - ERROR, cannot find ID in RemoteNotes = ' + RNotesDir + NoteID + '.md')); if PGit^.LCDate = '' then begin // maybe because note was edited in github and remote manifest LCD was unusable PGit^.LCDate := GetNoteLCD(PGit^.FName); // debugln(' TGithubSync.DownloadANote gethub edited note has date of ' + PGit^.LCDate); // TEST THIS !!!! end; if not Downloader(ContentsURL(True) + '/' + RNotesDir + NoteID + '.md', ST) then exit(SayDebugSafe('TGithubSync.DownloadANote ERROR, failed to download note : ' + NoteID)); {$ifdef DEBUG}Saydebugsafe('TGithubSync.DownloadANote downloaded OK ' + NoteID);{$endif} NoteSTL := TStringList.Create; NoteSTL.Text := DecodeStringBase64(ExtractJSONField(ST, 'content')); {$ifdef DEBUG}Saydebugsafe('TGithubSync.DownloadANote decoded');{$endif} if NoteSTL.Count > 0 then begin Importer := TImportNotes.Create; { if length(PGit^.Notebooks) > 5 then Saydebugsafe('TGithubSync.DownloadANote Using Notebook = ' + PGit^.Notebooks); } Importer.NoteBook := PGit^.Notebooks; {$ifdef DEBUG}Saydebugsafe('TGithubSync.DownloadANote about to import');{$endif} Importer.MDtoNote(NoteSTL, PGit^.LCDate, PGit^.CDate); {$ifdef DEBUG}Saydebugsafe('TGithubSync.DownloadANote imported');{$endif} // writeln(NoteSTL.TEXT); if FFName = '' then NoteSTL.SaveToFile(NotesDir + NoteID + '.note-temp') else NoteSTL.SaveToFile(FFname); {$ifdef DEBUG}Saydebugsafe('TGithubSync.DownloadANote file saved');{$endif} end else Result := false; finally if Importer <> Nil then Importer.Free; if NoteSTL <> Nil then NoteSTL.Free; //STL.Free; end; {$ifdef DEBUG}Saydebugsafe('TGithubSync.DownloadANote finished');{$endif} end; function TGitHubSync.ReadRemoteManifest(): boolean; var St : string; Node, ANode, NotesNode : TJsonNode; PGit : PGitNote; begin if RemoteNotes.Find(RMetaDir + 'manifest.json') = nil then exit(SayDebugSafe('Remote manifest not present, maybe a new repo ?')); if not Downloader(ContentsURL(True) + '/' + RMetaDir + 'manifest.json', ST) then exit(SayDebugSafe('GitHub.ReadRemoteMainfest : Failed to read the remote manifest file')); {$ifdef DEBUG} RemoteNotes.DumpList('TGithubSync.ReadRemoteManifest - Before ReadRemoteManifest'); {$endif} Node := TJsonNode.Create; try // content is in the "content" field, Base64 encoded. if not Node.TryParse(DecodeStringBase64(ExtractJSONField(ST, 'content'))) then exit(SayDebugSafe('TGitHubSync.ReadRemoteManifest ERROR invalid JSON : ' + ST)); if Node.Exists('selectivesync') then SelectiveSync := Node.Find('selectivesync').AsString; NotesNode := Node.Find('notes'); if NotesNode = nil then exit(SayDebugSafe('TGitHubSync.ReadRemoteManifest ERROR invalid JSON, notes not present : ' + ST)); for ANode in NotesNode do begin if ANode.Exists('title') and ANode.exists('lcdate') and ANode.Exists('cdate') and ANode.Exists('format') and ANode.Exists('sha') and ANode.Exists('notebooks') then begin PGit := RemoteNotes.Find(ANode.Name); // note, we pass an ID withoout path, Find adds Path internally if PGit = nil then exit(SayDebugSafe('TGitHubSync.ReadRemoteManifest ERROR invalid JSON, FName not present in RemoteNotes : ' + ANode.AsString)); //PGit^.FName := ANode.Name; PGit^.Title := ANode.Find('title').AsString; PGit^.CDate := ANode.Find('lcdate').AsString; if ANode.Find('format').AsString = 'md' then PGit^.Format := ffMarkDown else PGit^.Format := ffEncrypt; if PGit^.Sha = ANode.Find('sha').AsString then PGit^.LCDate := ANode.Find('lcdate').AsString; PGit^.Notebooks := ANode.Find('notebooks').AsJSON.Remove(0,12); // "notebooks" : ["Notebook1","Notebook2", "Notebook3"] // PGit^.Notebooks := ANode.Find('notebooks').AsArray.AsJson; end; end; finally Node.free; end; {$ifdef DEBUG} RemoteNotes.DumpList('TGithubSync.ReadRemoteManifest - After ReadRemoteManifest'); {$endif} end; function TGitHubSync.GetServerId(): string; var St : string; begin Result := ''; if Downloader(ContentsURL(True) + '/' + RMetaDir + 'serverid', ST) then Result := DecodeStringBase64(self.ExtractJSONField(ST, 'content')); Result := Result.Replace(#10, ''); Result := Result.Replace(#13, ''); //debugln('TGithubSync.GetServerId = [' + Result + ']'); end; function TGitHubSync.Downloader(URL: string; out SomeString: String; const Header: string): boolean; var Client: TFPHttpClient; begin //InitSSLInterface; // curl -i -u $GH_USER https://api.github.com/repos/davidbannon/libappindicator3/contents/README.note Client := TFPHttpClient.Create(nil); Client.UserName := UserName; Client.Password := Password; // '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'; Client.AddHeader('User-Agent','Mozilla/5.0 (compatible; fpweb)'); Client.AddHeader('Content-Type','application/json; charset=UTF-8'); Client.AllowRedirect := true; SomeString := ''; try try SomeString := Client.Get(URL); except on E: ESocketError do begin ErrorString := 'Github.Downloader ' + E.Message; exit(SayDebugSafe(ErrorString)); end; on E: EInOutError do begin ErrorString := 'Github Downloader - InOutError ' + E.Message; exit(SayDebugSafe(ErrorString)); end; on E: ESSL do begin ErrorString := 'Github.Downloader -SSLError ' + E.Message; exit(SayDebugSafe(ErrorString)); end; on E: Exception do begin ErrorString := 'GitHub.Downloader Exception ' + E.Message + ' downloading ' + URL; case Client.ResponseStatusCode of 401 : ErrorString := ErrorString + ' 401 Maybe your Token has expired or password is invalid ??'; 404 : ErrorString := ErrorString + ' 404 File not found ' + URL; else ErrorString := ErrorString + ' https error no ' + inttostr(Client.ResponseStatusCode); end; exit(SayDebugSafe(ErrorString)); end; end; with Client.ResponseHeaders do begin if Header <> '' then begin if IndexOfName(Header) <> -1 then HeaderOut := ValueFromIndex[IndexOfName(Header)] else HeaderOut := ''; end; end; finally Client.Free; end; result := true; end; function TGitHubSync.SendData(const URL, BodyJSt: String; Put: boolean; FName: string): boolean; var Client: TFPHttpClient; Response : TStringStream; begin Result := false; //SayDebugSafe('TGitHubSync.SendData - Posting to ' + URL); Client := TFPHttpClient.Create(nil); Client.AddHeader('User-Agent','Mozilla/5.0 (compatible; fpweb)'); Client.AddHeader('Content-Type','application/json; charset=UTF-8'); Client.AddHeader('Accept', 'application/json'); Client.AllowRedirect := true; Client.UserName:=UserName; Client.Password:=Password; client.RequestBody := TRawByteStringStream.Create(BodyJSt); Response := TStringStream.Create(''); try try if Put then begin client.Put(URL, Response); //DumpJSON(Response.DataString, 'SendData just after PUT'); if FName <> '' then // if FName is provided, is uploading a file // RemoteNotes.Add(FName, ExtractJSONField(Response.DataString, 'sha', 0)); RemoteNotes.Add(FName, ExtractJSONField(Response.DataString, 'sha', 'content')); end else client.Post(URL, Response); // don't use FormPost, it messes with the Content-Type value if (Client.ResponseStatusCode = 200) or (Client.ResponseStatusCode = 201) then Result := True else begin SayDebugSafe('GitHub.SendData : Post ret ' + inttostr(Client.ResponseStatusCode)); SayDebugSafe(Client.ResponseStatusText); end; except on E:Exception do begin ErrorString := 'GitHub.SendData - bad things happened : ' + E.Message; exit(SayDebugSafe(ErrorString)); end; end; finally Client.RequestBody.Free; Client.Free; Response.Free; end; end; function TGitHubSync.ContentsURL(API: boolean): string; begin if API then Result := BaseURL + 'repos/' + UserName + '/' + RemoteRepoName + '/contents' else Result := GITBaseURL + UserName + '/' + RemoteRepoName + '/blob/main/'; end; // -------------------- J S O N T O O L S ------------------------------------ // Returns content asociated with Field at either toplevel or if there are up to // two level names, that field down up to two fields down. Level1 is upper .... function TGitHubSync.ExtractJSONField(const data, Field : string; Level1 : string = ''; Level2 : string = '') : string; var Node, ANode : TJsonNode; begin result := ''; Node := TJsonNode.Create; ANode := Node; // Don't change Node, free will not be able to find it. try if not Node.TryParse(data) then exit('Failed to parse data'); if Level1 <> '' then ANode := ANode.Find(Level1); if ANode = nil then exit('ERROR - field not found 1 : ' + Level1); if Level2 <> '' then ANode := ANode.Find(Level2); if ANode = nil then exit('ERROR - field not found 2 : ' + Level2); ANode := ANode.Find(Field); if ANode = nil then result := 'ERROR - field not found 3 : ' + Field else result := ANode.AsString; finally Node.Free; end; end; (* WARNING this uses FPjson, needs to be rewritten before use. procedure TGitHubSync.DumpJSON(const St: string; WhereFrom: string); var jData : TJSONData; begin if Wherefrom <> '' then SayDebugSafe('------------ Dump from ' + Wherefrom + '-------------'); JData := GetJSON(St); SayDebugSafe('---------- JSON ------------'); SayDebugSafe(jData.FormatJSON); SayDebugSafe('----------------------------'); JData.Free; end; *) end. // ============================================================================= // ============================================================================= // ============================================================================= { Notebook Syntax - --------------- A note not in any notebooks - A notebook template - system:template system:notebook:MacStuff A note in a notebook - system:notebook:MacStuff } // ========================= J S O N R E S P O N S E S ====================== (* ----------- Commit response ----------------- { "sha" : "fb1dfecbc50329c7bedfc9ae00ba522bc3bd8536", "node_id" : "MDY6Q29tbWl0Mzk0NTAzNTYxOmZiMWRmZWNiYzUwMzI5YzdiZWRmYzlhZTAwYmE1MjJiYzNiZDg1MzY=", "commit" : { "author" : { "name" : "blar", "email" : "blar", "date" : "2021-08-11T04:09:43Z" .... quite a lot more follows ... ..... *) (* ---------- This is the directory listing, in this case, of Notes. Note its ---------- an array, wrapped in [], one array element per file or dir found. We need only Name and sha. [{ "name" :"06c8c753-77df-4b0f-a855-3d1416ef0260.md", "path" :"Notes/06c8c753-77df-4b0f-a855-3d1416ef0260.md", "sha" :"f11b48e4204e442759d1250a39c6d4a683f634f3", "size" :6323, "url" :"https://api.github.com/repos/davidbannon/tb_test/contents/Notes/06c8c753-77df-4b0f-a855-3d1416ef0260.md?ref=main", "html_url":"https://github.com/davidbannon/tb_test/blob/main/Notes/06c8c753-77df-4b0f-a855-3d1416ef0260.md", "git_url" :"https://api.github.com/repos/davidbannon/tb_test/git/blobs/f11b48e4204e442759d1250a39c6d4a683f634f3", "download_url":"https://raw.githubusercontent.com/davidbannon/tb_test/main/Notes/06c8c753-77df-4b0f-a855-3d1416ef0260.md?token=ABP76MGKOA3EL4QAG5VQSVLBIRS3Q", "type":"file", "_links" : { "self":"https://api.github.com/repos/davidbannon/tb_test/contents/Notes/06c8c753-77df-4b0f-a855-3d1416ef0260.md?ref=main", "git" :"https://api.github.com/repos/davidbannon/tb_test/git/blobs/f11b48e4204e442759d1250a39c6d4a683f634f3", "html":"https://github.com/davidbannon/tb_test/blob/main/Notes/06c8c753-77df-4b0f-a855-3d1416ef0260.md" } }, .... .... ] *) (* ----------------- Remote Manifest ------------------ { "notes" : { "903C31B1-229E-44E6-8FA3-EAAD53ED3E77" : { "title" : "Man Pages", "cdate" : "2021-08-01T19:13:24.7238449+10:00", "lcdate" : "2021-08-04T20:13:10.1153643+10:00", "sha" : "1c3b3dd579f8e46481fd5b5c93044d1c50448f4c", "format" : "md", "notebooks" : ["template", "Man Pages"] }, "B4B75FFE-996B-4D9A-B978-71D55427C7F1" : { "title" : "Installing LazarusCross Compiler", "cdate" : "2018-01-29T11:21:07.8490000+11:00", "lcdate" : "2021-09-15T11:42:00.4447428+10:00", "sha" : "96d4a70f065a92e099e4129f8bc9d3f3e568e4bc", "format" : "md", "notebooks" : [] }, ..... ..... } *) tomboy-ng_0.39-1/source/markdown.pas0000644000175000017500000003613214551457644017273 0ustar dbannondbannonunit markdown; { Copyright (C) 2017-2020 David Bannon License: This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html ------------------ This unit converts a note to markdown format. HISTORY 2018/12/05 This unit is pleased to serve. 2018/12/06 Fixed a bug in Addtag, if Buff is only spaces. 2019/05/14 Display strings all (?) moved to resourcestrings 2019/09/27 Added SmallFont, actually subscript because markdown does not do a small font. 2020/01/22 Enabled sending md to clipboard and saving to a file. 2021/01/25 Remove special char from filename when exporting to file. 2021/01/29 Use TB_Utils/TB_MakeFileName when exporting } // ToDo : replace this with one from TomboyTools, it does a better standard. Might be // included in the nextCloud Notes version if it ever makes it here. {$mode objfpc}{$H+} interface uses Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls, KMemo; type { TFormMarkdown } TFormMarkdown = class(TForm) ButtonClose: TButton; ButtonCopyAll: TButton; ButtonSave: TButton; Label1: TLabel; Memo1: TMemo; Panel1: TPanel; SaveDialog1: TSaveDialog; procedure ButtonCloseClick(Sender: TObject); procedure ButtonCopyAllClick(Sender: TObject); procedure ButtonSaveClick(Sender: TObject); procedure FormActivate(Sender: TObject); procedure FormShow(Sender: TObject); private FSize : integer; SmallFont : boolean; Bold : boolean; Italics : boolean; HiLight : boolean; Underline : boolean; Strikeout : boolean; FixedWidth : boolean; PrevFSize : integer; PrevBold : boolean; PrevItalics : boolean; PrevHiLight : boolean; PrevUnderline : boolean; PrevStrikeout : boolean; PrevFixedWidth : boolean; PrevSmallFont : boolean; //InList : boolean; function AddCodeBlock(var BlkNo: integer): string; function AddHeading(BlkNo: integer): string; function AddTag(const FT: TKMemoTextBlock; var Buff: ANSIString; CloseOnly: boolean=False): ANSIString; procedure CopyLastFontAttr(); procedure DisplayMarkDown(); function GetNextTextBlock(const BlkNo: integer): integer; public TheKMemo : TKMemo; end; var FormMarkdown: TFormMarkdown; implementation uses settings, Clipbrd, TB_Utils; {$R *.lfm} { TFormMarkdown } procedure TFormMarkdown.FormShow(Sender: TObject); begin {$ifdef DARWIN} Label1.Caption := 'Press Cmd-A, Cmd-C to copy'; {$endif} end; procedure TFormMarkdown.ButtonCloseClick(Sender: TObject); begin close; end; procedure TFormMarkdown.ButtonCopyAllClick(Sender: TObject); begin Clipboard.astext := Memo1.text; end; procedure TFormMarkdown.ButtonSaveClick(Sender: TObject); //var //TempFName : string; begin SaveDialog1.DefaultExt := 'md'; {$ifdef UNIX} SaveDialog1.InitialDir := GetEnvironmentVariable('HOME'); {$endif} {$ifdef WINDOWS} SaveDialog1.InitialDir := GetEnvironmentVariable('HOMEPATH'); {$endif} {TempFName := StringReplace(Caption, #32, '', [rfReplaceAll]); TempFName := StringReplace(TempFName, '/', '_', [rfReplaceAll]); TempFName := StringReplace(TempFName, '\', '_', [rfReplaceAll]); TempFName := StringReplace(TempFName, '*', '_', [rfReplaceAll]);} SaveDialog1.Filename := TB_MakeFileName(Caption); //SaveDialog1.Filename := TempFName + '.' + 'md'; if SaveDialog1.Execute then Memo1.Lines.SaveToFile(SaveDialog1.Filename); end; procedure TFormMarkdown.FormActivate(Sender: TObject); begin Memo1.Clear; DisplayMarkDown(); end; procedure TFormMarkdown.CopyLastFontAttr(); begin PrevSmallFont := SmallFont; PrevFSize := FSize; PrevBold := Bold; PrevItalics := Italics; PrevHiLight := HiLight; PrevUnderline := Underline; PrevStrikeout := Strikeout; PrevFixedWidth := FixedWidth; PrevFSize := FSize; end; function TFormMarkdown.GetNextTextBlock(const BlkNo : integer) : integer; begin Result := BlkNo; while Result < TheKmemo.Blocks.Count do begin if (TheKMemo.Blocks.Items[Result].ClassNameIs('TKMemoTextBlock') or TheKMemo.Blocks.Items[Result].ClassNameIs('TKMemoHyperlink')) and (TKMemoTextBlock(TheKMemo.Blocks.Items[Result]).Text <> '') then exit(Result); inc(Result); end; Result := 0; end; procedure TFormMarkdown.DisplayMarkDown(); var Buff : ANSIstring = ''; BlockNo : integer = 0; Block : TKMemoBlock; NextBlock : integer; begin SmallFont := false; Bold := false; Italics := False; HiLight := False; FixedWidth := False; try try repeat if BlockNo >= TheKMemo.Blocks.Count then break; Buff := AddHeading(BlockNo); if Buff <> '' then begin Memo1.Append(Buff); inc(BlockNo, 2); continue; end; Buff := AddCodeBlock(BlockNo); // carefull, we fiddle blockno in there .... if Buff <> '' then begin Memo1.Append(Buff); continue; end; CopyLastFontAttr(); while not TheKMemo.Blocks.Items[BlockNo].ClassNameIs('TKMemoParagraph') do begin Block := TheKmemo.Blocks.Items[BlockNo]; if Block.ClassNameIs('TKMemoTextBlock') then begin if Block.Text.Length > 0 then begin AddTag(TKMemoTextBlock(Block), Buff); Buff := Buff + Block.Text; end; end; if Block.ClassNameIs('TKMemoHyperlink') then Buff := Buff + Block.Text; // debugln('Block=' + inttostr(BlockNo) + ' ' +BlockAttributes(Block)); inc(BlockNo); if BlockNo >= TheKMemo.Blocks.Count then break; end; // At this stage, BlockNo points to either a Paragraph marker or beyond items if BlockNo < TheKMemo.Blocks.Count then if TKMemoParagraph(TheKMemo.Blocks.Items[BlockNo]).Numbering = pnuBullets then Buff := '* ' + Buff; NextBlock := GetNextTextBlock(BlockNo); if NextBlock > 0 then AddTag(TKMemoTextBlock(TheKMemo.Blocks.Items[NextBlock]), Buff, True); Memo1.Append(Buff); inc(BlockNo); if BlockNo >= TheKMemo.Blocks.Count then break; until false; { At this point we may have unsaved content in Buff cos last block was not a Para. But it cannot be Bullet. If it was a Para, Buff is empty. But we could still have hanging xml tags. So either case, send it to add tag with an empty Font. } Buff := ''; if SmallFont then Buff := ''; if Bold then Buff := Buff + '**'; if Italics then Buff := Buff + '_'; //if HiLight then Buff := Buff + ''; //if Underline then Buff := Buff + ''; if Strikeout then Buff := Buff + '~~'; if FixedWidth then Buff := Buff + #10'```'#10; // if FSize <> Sett.FontNormal then // Buff := Buff + SetFontXML(FSize, False); if length(Buff) > 0 then Memo1.Append(Buff); Except on EListError do begin Memo1.Append(Buff); end; end; finally end; end; // Called on first block after a paragraph marker, deals with single block, whole para in monospace // Must be one block followed by paragaraph marker. If it cannot help, returns empty string. // Assumes an para that starts with Mono font is all code. No arguments ! // Sequential mono paras are kept together as long as nothing between them. function TFormMarkDown.AddCodeBlock(var BlkNo : integer) : string; var Found : integer = 0; Starting : integer; begin Starting := BlkNo; Result := #10'```'#10; while TheKMemo.Blocks.Items[BlkNo].ClassNameIs('TKMemoTextBlock') and (TKMemoTextBlock(TheKMemo.Blocks.Items[BlkNo]).TextStyle.Font.Pitch = fpFixed) do begin inc(Found); while TheKMemo.Blocks.Items[BlkNo].ClassNameIs('TKMemoTextBlock') do begin Result := Result + TKmemoTextBlock(TheKMemo.Blocks.Items[BlkNo]).Text; inc(BlkNo); if BlkNo >= TheKmemo.Blocks.Count then break; end; if BlkNo >= TheKmemo.Blocks.Count then break; // OK, if to here, we must be on a para marker, end of that line. Result := Result + #10; inc(BlkNo); // step over the para marker end; // BlkNo is now pointing to block after the para marker at end of a mono para // or, possibly its pointing beyond kmemo and maybe we did not find a Mono para ? if Found > 0 then Result := Result + #10'```'#10 else begin Result := ''; BlkNo := Starting; // I didn't mess with it .... end; end; // Called on first block after a paragraph marker, deals with larger fonts that are headers // Must be one block followed by paragaraph marker. If it cannot help, returns empty string. function TFormMarkdown.AddHeading(BlkNo : integer) : string; begin Result := ''; if TheKMemo.Blocks.Items[BlkNo].ClassNameIs('TKMemoTextBlock') and ((BlkNo +1) < TheKMemo.Blocks.Count) and TheKMemo.Blocks.Items[BlkNo+1].ClassNameIs('TKMemoParagraph') then begin // OK, its a single block line. But is it a heading ? if TKmemoTextBlock(TheKMemo.Blocks.Items[BlkNo]).TextStyle.Font.Size = Sett.FontTitle then Result := '# ' + TKmemoTextBlock(TheKMemo.Blocks.Items[BlkNo]).Text; if TKmemoTextBlock(TheKMemo.Blocks.Items[BlkNo]).TextStyle.Font.Size = Sett.FontHuge then Result := '## ' + TKmemoTextBlock(TheKMemo.Blocks.Items[BlkNo]).Text; if TKmemoTextBlock(TheKMemo.Blocks.Items[BlkNo]).TextStyle.Font.Size = Sett.FontLarge then Result := '### ' + TKmemoTextBlock(TheKMemo.Blocks.Items[BlkNo]).Text; end; end; // AddTag deals with markup that has a pre and post componet, ie **Bold** function TFormMarkdown.AddTag(const FT : TKMemoTextBlock; var Buff : ANSIString; CloseOnly : boolean = False) : ANSIString; var BorrowedSpaces : integer = 0; begin // Important that we keep the tag order consistent. Good xml requires no cross over // tags. If the note is to be readable by Tomboy, must comply. (EditBox does not care) // Tag order - // FontSize HiLite Ital Bold Bullet TEXT BulletOff BoldOff ItalOff HiLiteOff FontSize // Processing Order is the reverse - // ListOff BoldOff ItalicsOff HiLiteOff FontSize HiLite Ital Bold List //debugln(BlockAttributes(FT)); // When Bold Turns OFF if Buff <> '' then // remove, temporarly, any trailing spaces while Buff[length(Buff)] = ' ' do begin inc(BorrowedSpaces); delete(Buff, length(Buff), 1); if Buff = '' then break; end; if CloseOnly then begin // In closeonly mode, we are just shuttig them all done prior to newline if Bold then begin Buff := Buff + '**'; Bold := false; end; if Italics then begin Buff := Buff + '_'; Italics := false; end; if Strikeout then begin Buff := Buff + '~~'; Strikeout := false; end; if FixedWidth then begin Buff := Buff + '`'; FixedWidth := False; end; if SmallFont then begin Buff := Buff + ''; SmallFont := False; end; end; // Normal mode. // When smallfont turns off if (SmallFont and (FT.TextStyle.Font.Size <> Sett.FontSmall)) then begin Buff := Buff + ''; SmallFont := False; end; if (Bold and (not (fsBold in FT.TextStyle.Font.Style))) then begin Buff := Buff + '**'; Bold := false; end; // When Italic turns OFF if (Italics and (not (fsItalic in FT.TextStyle.Font.Style))) then begin if Bold then Buff := Buff + '**'; Buff := Buff + '_'; if Bold then Buff := Buff + '**'; Italics := false; end; // When Strikeout turns OFF if (Strikeout and (not (fsStrikeout in FT.TextStyle.Font.Style))) then begin if Bold then Buff := Buff + '**'; if Italics then Buff := Buff + '_'; Buff := Buff + '~~'; if Italics then Buff := Buff + '_'; if Bold then Buff := Buff + '**'; Strikeout := false; end; // Full para fixed with is already looked after, here we deal with bits in an a para // When FixedWidth turns OFF //if (FixedWidth <> (FT.TextStyle.Font.Pitch = fpFixed) or (FT.TextStyle.Font.Name = MonospaceFont)) then begin if (FixedWidth and ((FT.TextStyle.Font.Pitch <> fpFixed) {or (FT.TextStyle.Font.Name <> MonospaceFont)})) then begin if Bold then Buff := Buff + '**'; if Italics then Buff := Buff + '_'; if Strikeout then Buff := Buff + '~~'; Buff := Buff + '`'; if Strikeout then Buff := Buff + '~~'; if Italics then Buff := Buff + '_'; if Bold then Buff := Buff + '**'; FixedWidth := false; end; while BorrowedSpaces > 0 do begin Buff := Buff + ' '; dec(BorrowedSpaces); end; if CloseOnly then exit(Buff); // FixedWidth turns ON if ((not FixedWidth) and ((FT.TextStyle.Font.Pitch = fpFixed))) then begin if Bold then Buff := Buff + '**'; if Italics then Buff := Buff + '_'; if Strikeout then Buff := Buff + '~~'; Buff := Buff + '`'; if Strikeout then Buff := Buff + '~~'; if Italics then Buff := Buff + '_'; if Bold then Buff := Buff + '**'; FixedWidth := true; end; // Strikeout turns ON if ((not Strikeout) and (fsStrikeout in FT.TextStyle.Font.Style)) then begin if Bold then Buff := Buff + '**'; if Italics then Buff := Buff + '_'; Buff := Buff + '~~'; if Italics then Buff := Buff + '_'; if Bold then Buff := Buff + '**'; Strikeout := true; end; // Italic turns On if ((not Italics) and (fsItalic in FT.TextStyle.Font.Style)) then begin if Bold then Buff := Buff + '**'; Buff := Buff + '_'; if Bold then Buff := Buff + '**'; Italics := true; end; // Bold turns On if ((not Bold) and (fsBold in FT.TextStyle.Font.Style)) then begin Buff := Buff + '**'; Bold := true; end; // SmallFont turns on if ((not SmallFont) and (FT.TextStyle.Font.Size = Sett.FontSmall)) then begin Buff := Buff + ''; SmallFont := True; end; Result := Buff; end; end. tomboy-ng_0.39-1/source/spelling.pas0000644000175000017500000002654014551457644017270 0ustar dbannondbannonunit Spelling; { Copyright (C) 2017-2022 David Bannon License: This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html ------------------ A GUI unit that uses hunspell.pas to check spelling of the passed KMemo Note we start at the end of doc and scan back to beginning } { HISTORY - 2018/03/03 Initial Commit 2018/03/24 Win only bug, missed counting a #13 when replacing first word on line. Win only - allow for #13 in a selected block 2018/04/07 Changes in ReplaceWord to really get it right for Windows UTF8 but some changes outside ifdef so must check on Linux too. 2018/06/21 Hide an unnecessary debug line 2018/11/29 Fixed bug when spell checking a selection of text 2019/05/19 Display strings all (?) moved to resourcestrings 2020/10/04 Bugfix, selected single word chopped off last character 2020/10/04 Now respond to double click in suggested word list box. } {$mode objfpc}{$H+} interface uses Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, Buttons, kmemo; type { TFormSpell } TFormSpell = class(TForm) BitBtn1: TBitBtn; ButtonSkip: TButton; ButtonIgnore: TButton; ButtonUseAndNextWord: TButton; //Label1: TLabel; LabelContext: TLabel; LabelPrompt: TLabel; Label4: TLabel; LabelStatus: TLabel; LabelSuspect: TLabel; ListBox1: TListBox; procedure ButtonIgnoreClick(Sender: TObject); procedure ButtonUseAndNextWordClick(Sender: TObject); procedure ButtonSkipClick(Sender: TObject); procedure FormHide(Sender: TObject); procedure FormShow(Sender: TObject); procedure ListBox1Click(Sender: TObject); procedure ListBox1DblClick(Sender: TObject); private function CleanContext(): AnsiString; { Returns the number of #13 before the indicated location - bloody windows ! } function NewLinesBefore(const Idx: integer): integer; { Returns True if it found another mis spelt word } procedure PreviousWord(var TheIndex: longint); procedure ReplaceWord(const NewWord: AnsiString); procedure ShowContents; procedure ShowSuggestions(); procedure WeAreDone(); function WordToCheck(): boolean; public TextToCheck : AnsiString; TheKMemo : TKmemo; end; var FormSpell: TFormSpell; implementation uses hunspell, settings, LazUTF8, LazLogger; const SetofDelims = [#10, #13, ' '..'@', '['..'`', '{'..'~']; // all askii visible char ?? // SetofDelims = [' ',#10,#13,'(', ')', ',', '[', ']', '1', '2', '3', '4', '5', '6', '7', '8', '9', '0', '.', ';', '/', '-']; ContextSize = 20; // Thats plus and minus var Spell : THunspell; { Index points to character before word we are checking, a deliminator or its 0 its a count of UTF8 characters, not bytes } Index : integer; FinishIndex : integer; TheWord : ANSIString; // The word we think might be mis-spelt LeadContext, TrailContext : AnsiString; SaveSelStart, SaveSelEnd : integer; Str_Text : ANSIString; // Will have a copy of KMemo's Text property, faster {$R *.lfm} { TFormSpell } function TFormSpell.NewLinesBefore(const Idx : integer) : integer; var BlockNo, LocalOffset : integer; begin Result := 0; BlockNo := TheKmemo.Blocks.IndexToBlockIndex(Idx, LocalOffset); while BlockNo > 0 do begin if TheKmemo.Blocks.Items[BlockNo].ClassNameIs('TKMemoParagraph') then inc(Result); dec(BlockNo); end; end; RESOURCESTRING rsCheckingFull = 'Checking full document'; rsCheckingSelection = 'Checking selection'; rsSpellNotConfig = 'Spelling not configured'; procedure TFormSpell.FormShow(Sender: TObject); begin // ShowContents(); SaveSelStart := TheKmemo.RealSelStart; SaveSelEnd := TheKMemo.RealSelEnd; // SelEnd points to first non-selected char if SaveSelEnd > (SaveSelStart+1) then begin // Something was selected ... Index := SaveSelEnd; FinishIndex := SaveSelStart; {$ifdef WINDOWS} // yet again, Windows silly line endings in .Text property Index := Index + NewLinesBefore(Index) + 1; FinishIndex := FinishIndex + NewLinesBefore(FinishIndex); {$endif} LabelStatus.Caption := rsCheckingSelection; end else begin // note only one char selected, we treat as check whole doc FinishIndex := 0; Index := UTF8Length(TheKMemo.Blocks.Text); LabelStatus.Caption := rsCheckingFull; end; TheKMemo.SelEnd := TheKMemo.SelStart; // Now, nothing selected. LabelStatus.Caption := ''; TheKMemo.Blocks.LockUpdate; Str_Text := TheKMemo.Blocks.Text; // Make a copy to work with, faster if Sett.SpellConfig then begin Spell := THunspell.Create(Application.HasOption('debug-spell'), Sett.LabelLibrary.Caption); if Spell.ErrorMessage = '' then begin if Spell.SetDictionary(Sett.LabelDic.Caption) then PreviousWord(Index); end; end else LabelStatus.Caption := rsSpellNotConfig; end; RESOURCESTRING rsREPLACE_with_1 = 'replace'; rsReplace_WITH_2 = 'with'; procedure TFormSpell.ListBox1Click(Sender: TObject); begin LabelStatus.Caption := rsREPLACE_with_1 + ' ' + TheWord + ' ' + rsReplace_WITH_2 + ' ' + ListBox1.Items[ListBox1.ItemIndex]; ButtonUseAndNextWord.Enabled := True; end; procedure TFormSpell.ListBox1DblClick(Sender: TObject); begin LabelStatus.Caption := rsREPLACE_with_1 + ' ' + TheWord + ' ' + rsReplace_WITH_2 + ' ' + ListBox1.Items[ListBox1.ItemIndex]; ButtonUseAndNextWord.Click; end; procedure TFormSpell.ReplaceWord(const NewWord : AnsiString); var BlockNo, TempIndex : integer; LocalIndex {$ifdef WINDOWS}, I {$endif} : integer; TB: TKMemoTextBlock; TextSize : integer; begin TempIndex := Index; {$ifdef WINDOWS} // Must allow for Windows extra CR in newline // need to know how many CRs between Index and 0 I := length(UTF8copy(Str_Text, 1, Index+1)); // One based St, we need a byte count, not char while I > 0 do begin if Str_Text[I] = #13 then dec(TempIndex); dec(I); end; {$endif} //BlockNo := TheKmemo.Blocks.IndexToBlockIndex(TempIndex+1, LocalIndex); BlockNo := TheKmemo.Blocks.IndexToBlockIndex(TempIndex, LocalIndex); //debugln('Operating on BK=' + inttostr(BlockNo) + ' Loc=' + inttostr(LocalIndex) + ' TempIndex=' + inttostr(TempIndex) + ' Index=' + inttostr(Index)); TextSize := TKMemoTextBlock(TheKmemo.Blocks.Items[BlockNo]).TextStyle.Font.Size; // and Style ???? TheKMemo.SelStart := TempIndex; // zero based TheKMemo.SelEnd := TempIndex + UTF8Length(TheWord); //TheKMemo.Blocks.DeleteChar(0); // will delete selected text, maybe use ClearSelection() ?? TheKMemo.Blocks.ClearSelection(); if TheKmemo.Blocks.Items[BlockNo].ClassNameIs('TKMemoParagraph') then begin TB := TheKMemo.Blocks.AddTextBlock(NewWord, BlockNo); TB.TextStyle.Font.Size := TextSize; end else //TheKmemo.Blocks.Items[BlockNo].InsertString(NewWord, LocalIndex-1); // TKSelectionIndex is 0 based TheKmemo.Blocks.Items[BlockNo].InsertString(NewWord, LocalIndex); LabelStatus.Caption := ''; end; procedure TFormSpell.ShowSuggestions(); begin Spell.Suggest(TheWord, ListBox1.Items); LabelPrompt.Visible:= True; ListBox1.Items.Add(TheWord); end; function TFormSpell.CleanContext() : AnsiString; // Ah, what about bloody windows ? var LineEndPos : integer; begin // DebugLn('[[' + LeadContext + ' & ' + TrailContext + ']]'); LineEndPos := UTF8Pos(LineEnding, LeadContext, 1); While LineEndPos > 0 do begin UTF8Delete(LeadContext, 1, LineEndPos); LineEndPos := UTF8Pos(LineEnding, LeadContext, 1); end; // DebugLn('[' + LeadContext + ']'); LineEndPos := UTF8Pos(LineEnding, TrailContext); if LineEndPos > 0 then UTF8Delete(TrailContext, LineEndPos, ContextSize); // DebugLn('[' + TrailContext + ']'); Result := LeadContext + ' ' + TrailContext; end; function TFormSpell.WordToCheck() : boolean; begin Result := False; if UTF8Length(TheWord) > 1 then if not Spell.Spell(TheWord) then Result := True; if Result then begin ShowSuggestions(); LabelSuspect.Caption := TheWord; LabelContext.Caption := CleanContext(); // ShowContents(); end else TheWord := '' end; RESOURCESTRING rsSpellComplete = 'Spell check complete'; procedure TFormSpell.WeAreDone(); begin LabelStatus.Caption := rsSpellComplete; LabelContext.Caption := ''; ListBox1.Clear; LabelSuspect.Caption:=''; ButtonSkip.Enabled := False; ButtonIgnore.Enabled := False; end; procedure TFormSpell.PreviousWord(var TheIndex : longint); var //TS1, TS2, TS3, TS4 : TTimeStamp; // Temp time stamping to test speed UTFCode : AnsiString; begin LabelPrompt.Visible:= False; // Dec(TheIndex); // why ? something to do with detecting spell check complete TheWord := ''; ButtonUseAndNextWord.Enabled := False; //Str_Text := TheKMemo.Blocks.Text; // much faster ! but tough on memory ? while TheIndex > FinishIndex do begin // remember, first char is #1 UTFCode := UTF8Copy(Str_Text, TheIndex, 1); if UTFCode[1] in SetOfDelims then begin LeadContext := UTF8Copy(Str_Text, TheIndex - ContextSize, ContextSize); TrailContext := UTF8Copy(Str_Text, TheIndex+1, ContextSize); if WordToCheck() then exit(); end else TheWord := UTFCode + TheWord; dec(TheIndex); end; // if to here, TheIndex is 0 or equal to FinishIndex if (UTF8Length(TheWord) > 1) then begin if (not WordToCheck()) then WeAreDone(); end else dec(TheIndex); // iff we didn't enter above loop, must still dec ! if TheIndex < FinishIndex then WeAreDone(); end; procedure TFormSpell.ButtonUseAndNextWordClick(Sender: TObject); begin ReplaceWord(ListBox1.Items[ListBox1.ItemIndex]); PreviousWord(Index); end; procedure TFormSpell.ButtonIgnoreClick(Sender: TObject); begin Spell.Add(TheWord); PreviousWord(Index); end; procedure TFormSpell.ButtonSkipClick(Sender: TObject); begin PreviousWord(Index); end; procedure TFormSpell.FormHide(Sender: TObject); begin FreeandNil(Spell); TheKMemo.Blocks.UnLockUpdate; TheKMemo.SelEnd := SaveSelEnd; // Restore selection as best we can TheKMemo.SelStart := SaveSelStart; // but if spelling has changed size of intermediate text ..... end; procedure TFormSpell.ShowContents; // this method for debug only // To see debug messages in ($#$@#!) windows, Lazarus->Run->Run Parameter and set (eg) --debug-log=logfile.txt // Note that you need to exit the app to flush all content to file. And file is not zeroed on startup. Sigh..... var Cnt : integer = 0; begin debugln('------------'); while Cnt < TheKMemo.Blocks.Count do begin debugln(TheKMemo.Blocks.Items[Cnt].ClassName + '=' + inttostr(Cnt) + ' [' + TheKMemo.Blocks.Items[Cnt].Text + '] starts at ' + inttostr(TheKMemo.Blocks.BlockToIndex(TheKMemo.Blocks.Items[Cnt])) ); inc(Cnt); end; debugln('------------'); end; end. tomboy-ng_0.39-1/source/markdown.lfm0000644000175000017500000000464614551457644017273 0ustar dbannondbannonobject FormMarkdown: TFormMarkdown Left = 248 Height = 462 Top = 159 Width = 821 Caption = 'FormMarkdown' ClientHeight = 462 ClientWidth = 821 OnActivate = FormActivate OnShow = FormShow LCLVersion = '2.1.0.0' object Memo1: TMemo AnchorSideLeft.Control = Owner AnchorSideTop.Control = Panel1 AnchorSideTop.Side = asrBottom AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = ButtonClose Left = 0 Height = 387 Top = 50 Width = 821 Anchors = [akTop, akLeft, akRight, akBottom] Lines.Strings = ( 'Memo1' ) ScrollBars = ssAutoVertical TabOrder = 0 end object Panel1: TPanel AnchorSideLeft.Control = Owner AnchorSideTop.Control = Owner AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom Left = 0 Height = 50 Top = 0 Width = 821 Anchors = [akTop, akLeft, akRight] Caption = 'Markdown Exporter' Font.Height = 20 ParentFont = False TabOrder = 1 end object ButtonClose: TButton AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = Owner AnchorSideBottom.Side = asrBottom Left = 746 Height = 25 Top = 437 Width = 75 Anchors = [akRight, akBottom] Caption = 'Close' OnClick = ButtonCloseClick TabOrder = 2 end object ButtonCopyAll: TButton AnchorSideRight.Control = ButtonClose AnchorSideBottom.Control = Owner AnchorSideBottom.Side = asrBottom Left = 671 Height = 25 Top = 437 Width = 75 Anchors = [akRight, akBottom] Caption = 'Copy All' OnClick = ButtonCopyAllClick TabOrder = 3 end object ButtonSave: TButton AnchorSideRight.Control = ButtonCopyAll AnchorSideBottom.Control = Owner AnchorSideBottom.Side = asrBottom Left = 596 Height = 25 Top = 437 Width = 75 Anchors = [akRight, akBottom] Caption = 'Save' OnClick = ButtonSaveClick TabOrder = 4 end object Label1: TLabel AnchorSideRight.Control = ButtonSave AnchorSideBottom.Control = Owner AnchorSideBottom.Side = asrBottom Left = 393 Height = 19 Top = 441 Width = 190 Anchors = [akRight, akBottom] BorderSpacing.Right = 13 BorderSpacing.Bottom = 2 Caption = 'Press Ctrl-A, Ctrl-C to copy' ParentColor = False end object SaveDialog1: TSaveDialog Left = 510 Top = 306 end end tomboy-ng_0.39-1/source/hunspell.pas0000644000175000017500000002645314551457644017310 0ustar dbannondbannon{$MODE objfpc}{$H+} unit hunspell; { Copyright (C) 2017-2020 David Bannon. License: This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html Note this unit 'includes' hunspell.inc that has a different license, please see that file for details. A Unit to connect to the hunspell library and check some spelling. First, create the class, it will try and find a library to load. Check ErrorMessage. Then call SetDictionary(), with a full filename of the dictionary to use. If GoodToGo is true, you can call Spell() and Suggests() otherwise, look in ErrorString for what went wrong. Look in FindLibrary() for default locations of Library. 2018/10/31 Changed to TLibHandle to accomadate Mac 64bit 2018/11/01 Added /usr/local/Cellar/hunspell/1.6.2/lib/ as place to look for hunspell library on Mac. Need to make that more flexible. 2018/11/29 Better debug messages 2020/11/13 Moved newly generated hunspell bindings out to a inc file. } interface uses Classes, dynlibs; { The Hunspell bindings are 'included' from another file to keep license issues managable and to comply with Debian requirements. } {$INCLUDE hunspell.inc} { THunspell } THunspell = class private Speller: Pointer; { Loads indicated library, returns False and sets ErrorMessage if something wrong } function LoadHunspellLibrary(LibraryName: AnsiString): Boolean; public { set to True if speller is ready to accept requests } GoodToGo : boolean; { empty if OK, contains an error message if something goes wrong } ErrorMessage : ANSIString; { Will have a full name to library if correctly loaded at create } LibraryFullName : string; { if set t, typically by caller, prints a lot of whats happening } DebugMode : boolean; { Will have a "first guess" as to where dictionaries are, poke another name in and call FindDictionary() if default did not work } constructor Create(const Debug : boolean; const FullLibName : ANSIString = ''); destructor Destroy; override; { Returns True if word spelt correctly } function Spell(Word: string): boolean; { Returns with List full of suggestions how to spell Word } procedure Suggest(Word: string; List: TStrings); { untested } procedure Add(Word: string); { untested } procedure Remove(Word: string); { returns a full library name or '' if it cannot find anything suitable } function FindLibrary(out FullName : AnsiString) : boolean; { returns true if it successfully set the indicated dictionary } function SetDictionary(const FullDictName: string) : boolean; function SetNewLibrary(const LibName : string) : boolean; end; var Hunspell_create: THunspell_create; var Hunspell_destroy: THunspell_destroy; var Hunspell_spell: Thunspell_spell; var Hunspell_suggest: Thunspell_suggest; var Hunspell_analyze: Thunspell_analyze; var Hunspell_stem: Thunspell_stem; var Hunspell_get_dic_encoding: Thunspell_get_dic_encoding; var Hunspell_add: THunspell_add; var Hunspell_free_list: THunspell_free_list; var Hunspell_remove: THunspell_remove; var HunLibLoaded: Boolean = False; var HunLibHandle: {THandle;} TLibHandle; // 64bit requires use of TLibHandle // see https://forum.lazarus.freepascal.org/index.php/topic,34352.msg225157.html implementation uses LazUTF8, SysUtils, {$ifdef linux}Process,{$endif} // Because we go looking for the library. {$ifdef WINDOWS}Forms,{$endif} // Forms needed so we can call Application.~ on Windows LazFileUtils, // Requires we add LCLBase to dependencies lazlogger; // lazlogger for the debug lines. { THunspell } function THunspell.LoadHunspellLibrary(libraryName: Ansistring): Boolean; begin Result := false; HunLibHandle := LoadLibrary(PAnsiChar(libraryName)); if HunLibHandle = NilHandle then begin if Debugmode then debugln('Failed to load library ' + libraryName); ErrorMessage := 'Failed to load library ' + libraryName; end else begin Result := True; Hunspell_create := THunspell_create(GetProcAddress(HunLibHandle, 'Hunspell_create')); if not Assigned(Hunspell_create) then Result := False; Hunspell_destroy := Thunspell_destroy(GetProcAddress(HunLibHandle, 'Hunspell_destroy')); if not Assigned(Hunspell_destroy) then Result := False; Hunspell_spell := THunspell_spell(GetProcAddress(HunLibHandle, 'Hunspell_spell')); if not Assigned(Hunspell_spell) then Result := False; Hunspell_suggest := THunspell_suggest(GetProcAddress(HunLibHandle, 'Hunspell_suggest')); if not Assigned(Hunspell_suggest) then Result := False; Hunspell_analyze := THunspell_analyze(GetProcAddress(HunLibHandle, 'Hunspell_analyze')); // not used here if not Assigned(Hunspell_analyze) then Result := False; Hunspell_stem := THunspell_stem(GetProcAddress(HunLibHandle, 'Hunspell_stem')); // not used here if not Assigned(Hunspell_stem) then Result := False; Hunspell_get_dic_encoding := THunspell_get_dic_encoding(GetProcAddress(HunLibHandle, 'Hunspell_get_dic_encoding')); // not used here if not Assigned(Hunspell_get_dic_encoding) then Result := False; Hunspell_free_list := THunspell_free_list(GetProcAddress(HunLibHandle, 'Hunspell_free_list')); if not Assigned(Hunspell_free_list) then Result := False; Hunspell_add := THunspell_add(GetProcAddress(HunLibHandle, 'Hunspell_add')); if not Assigned(Hunspell_add) then Result := False; Hunspell_remove := THunspell_remove(GetProcAddress(HunLibHandle, 'Hunspell_remove')); if not Assigned(Hunspell_remove) then Result := False; HunLibLoaded := Result; end; if ErrorMessage = '' then if not Result then begin ErrorMessage := 'Failed to find functions in ' + LibraryName; if debugmode then debugln('Hunspell Failed to find functions in ' + LibraryName); end; if Result and debugmode then debugln('Loaded library OK ' + LibraryName); end; constructor THunspell.Create(const Debug : boolean; const FullLibName : ANSIString = ''); begin DebugMode := Debug; ErrorMessage := ''; LibraryFullName := FullLibName; if LibraryFullName = '' then if Not FindLibrary(LibraryFullName) then begin if debugmode then debugln('Cannot find Hunspell library'); ErrorMessage := 'Cannot find Hunspell library'; exit(); end; //if debugmode then debugln('Creating Hunspell with library = ' + LibraryFullName); LoadHunspellLibrary(LibraryFullName); // will flag any errors it finds Speller := nil; // we are not GoodToGo yet, need a dictionary .... end; destructor THunspell.Destroy; begin //if DebugMode then debugln('About to destroy Hunspell'); if (HunLibHandle <> 0) and HunLibLoaded then begin if Speller<>nil then hunspell_destroy(Speller); Speller:=nil; if HunLibHandle <> 0 then FreeLibrary(HunLibHandle); HunLibLoaded := false; end; inherited Destroy; end; function THunspell.Spell(Word: string): boolean; begin Result := hunspell_spell(Speller, PChar(Word)) end; procedure THunspell.Suggest(Word: string; List: TStrings); var i, len: Integer; SugList, Words: PPChar; //Blar : AnsiString; begin List.clear; try len := hunspell_suggest(Speller, SugList, PChar(Word)); Words := SugList; for i := 1 to len do begin List.Add(Words^); //Blar := Words^; Inc(PtrInt(Words), sizeOf(Pointer)); end; finally Hunspell_free_list(Speller, SugList, len); end; end; procedure THunspell.Add(Word: string); begin Hunspell_add(Speller, Pchar(Word)); end; procedure THunspell.Remove(Word: string); begin Hunspell_remove(Speller, Pchar(Word)); end; function THunspell.FindLibrary(out FullName : ANSIString):boolean; var {$ifdef LINUX} I : integer = 1; {$endif} {$ifndef LINUX} Info : TSearchRec; Mask : ANSIString; {$endif} begin Result := False; {$IFDEF LINUX} // Assumes ldconfig always returns same format, better than searching several dirs if RunCommand('/bin/bash',['-c','ldconfig -p | grep hunspell'], FullName) then begin while UTF8Pos(' ', FullName, I) <> 0 do inc(I); if I=1 then exit(); UTF8Delete(FullName, 1, I-1); UTF8Delete(FullName, UTF8Pos(#10, FullName, 1), 1); Result := True; end else if RunCommand('/bin/bash',['-c','/sbin/ldconfig -p | grep hunspell'], FullName) then begin while UTF8Pos(' ', FullName, I) <> 0 do inc(I); if I=1 then exit(); UTF8Delete(FullName, 1, I-1); UTF8Delete(FullName, UTF8Pos(#10, FullName, 1), 1); Result := True; end; {$ENDIF} {$ifdef DARWIN} Mask := 'libhunspell*'; FullName := '/usr/local/Cellar/hunspell/1.6.2/lib/'; // /usr/local/Cellar/hunspell/1.6.2/lib/libhunspell-1.6.0.dylib if FindFirst(FullName + Mask, faAnyFile and faDirectory, Info)=0 then begin FullName := FullName + Info.name; Result := True; end; if not result then begin FullName := '/usr/lib/'; if FindFirst(FullName + Mask, faAnyFile and faDirectory, Info)=0 then begin FullName := FullName + Info.name; Result := True; end; end; FindClose(Info); {$endif} {$ifdef WINDOWS} // Now, only Windows left. Look for a dll in application home dir. Mask := '*hunspell*.dll'; FullName := ExtractFilePath(Application.ExeName); if FindFirst(FullName + Mask, faAnyFile and faDirectory, Info)=0 then begin FullName := FullName + Info.name; Result := True; end; FindClose(Info); {$endif} if Result then begin if DebugMode then debugln('FindLibrary looks promising [', FullName, ']'); end else if DebugMode then debugln('FindLibrary Failed to find a Hunspell Library', FullName, ']'); end; function THunspell.SetDictionary(const FullDictName: string) : boolean; var FullAff : string; begin if debugmode then debugln('about to try to set dictionary'); Result := False; if not FileExistsUTF8(FullDictName) then exit(); FullAff := FullDictName; UTF8Delete(FullAff, UTF8Length(FullAff) - 2, 3); FullAff := FullAff + 'aff'; if not FileExistsutf8(FullAFF) then exit(); try if assigned(Speller) then begin hunspell_destroy(Speller); if debugmode then debugln('Speller destroyed'); end; Speller := hunspell_create(PChar(FullAff), PChar(FullDictName)); // Create does not test the dictionaries ! except on E: Exception do debugln('Hunspell ' + E.Message); else debugln('Hunspell has lost it !'); end; Result := false; GoodToGo := assigned(Speller); if not GoodToGo then ErrorMessage := 'Failed to set Dictionary ' + FullDictName; Result := GoodToGo; end; function THunspell.SetNewLibrary(const LibName: string): boolean; begin LibraryFullName := LibName; Result := LoadHunspellLibrary(LibraryFullName); end; end. tomboy-ng_0.39-1/source/tbundo.pas0000644000175000017500000005426214551457644016750 0ustar dbannondbannonunit tbundo; { Copyright (C) 2021 David Bannon License: This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html ------------------ A FPC/Lazarus Unit to providing a Text Only undo/redo facility to KMemo. Intended for use in tomboy-ng, it may well be useful in other Lazarus applications that use KMemo, a component of KControls. See also tomboy-ng - https://github.com/tomboy-notes/tomboy-ng KControls - https://github.com/kryslt/KControls History : 2021-12-18 AddTextInsert is sometimes required to save any selected text. 2023-12-11 Do not move SelectionIndex while KMemo is locked. } { A unit to provide storage for undo / redo of the text in the tb-ng kmemo. AvailChanges represents the number of changes we have in the data structure. It starts at zero and goes up to MaxChanges, once MaxChanges is reached, it stays there, overwriting oldest entries. It goes down if we undo, undo ... and then add a new change. AvailRedos is usually zero, is only incremented during an Undo session. As soon as that session is terminated (by a new change) we zonk this var. NextChange is an index that points to the next data location to store a change. It starts at zero and is incremented up to MaxChanges -1 after that, rolls around to zero. Undo and Redo play with this var too. Actions RecordInitial Captures the relevent kmemo content before any changes are made. Stored in a pair of 'regional' variables that get overwritten all the time. Not every write to the vars results in a write to the data structure (some efficency to be gained here ...). Add* Stores data at location pointed to by NextChange, inc NextChange and AvailChanges (observing respective Max). If AvailRedos is not zero, zero it, end of a undo session. UnDo We can only do this if AvailChanges is greater than zero. Sets Current to data in previous location. inc AvailRedos and dec AvailChanges and NextChange. ReDo We can only do this if AvailRedos is greater than zero. Sets Current to data in NextChange location (we must have backed over it already). dec AvailRedos and inc AvailChanges and NextChange. Refinement ? If, in AddKeyPress, we are just adding a single char and its prev StartSelIndex is only one less than this one, can we add that char to previous NewData ? No, cannot tell after the first one. Maybe add a flag saying this is a single char at a time entry and count the char in there already ???? ToDo : read above..... In the Unit using KMemo : We must intercept every key press, cut and paste, delete, backspace key. Because by time we get to OnKeyPress, selected text has already been removed, we must record any selection in the OnKeyDown event. But the OnKeyDown event does not give us the plain text char typed by that key. So, we hook into all three, OnKeyDown, OnKeyPress, OnKeyUp (the latter just for delete and backspace). We capture the initial state in OnKeyDown, the actual key and final state in OnKeyPress (or onKeyUp for Delete and Backspace). Paste and Cut are more strait forward, we watch for a Ctrl-V or Ctrl-X and record any currently selected content and in the case of Ctrl-V the clipboard content. Easy. Capturing addition or removal of markup is similar to text change, we capture initial state in RecordInitial and then call AddMarkup after the change. If the app has a menu that offers Undo/Redo, might be best to enable/disable them when user activates the menu, not on each keypress. } {$mode ObjFPC}{$H+} {x$DEFINE DEBUG_UNDO} // Warning, debug uses writeln, don't use on Windows ! interface uses Classes, SysUtils, KMemo, KControls; type TChangeRec = record StartSelIndex : integer; // Zero based index where activity starts ExistLen : integer; NewLen : integer; ExistData : string; // The content that was initially there and deleted. NewData : string; // The content that was initially added. end; const MaxChange = 100; type TChangeStructure = array[0..MaxChange-1] of TChangeRec; { TUndo_Redo } TUndo_Redo = class private TheKMemo : TKMemo; // A ref to the KMemo we are managing. Set in create() CurrentCR : TChangeRec; // Only valid after a call to Undo or Redo AvailChanges : integer; // Number of usable changes we have in the structure AvailReDos : integer; // Number of changes we have just undone, we can redo this many NextChange : integer; // An index to the next place to put a change, may, or may not be empty ChangeStructure : TChangeStructure; Overwritten : string; // For split actions, eg, a keypress, stores (RTF) selected content OverwrittenLen : integer; // Length of plain, displayed text matching Overwritten procedure CopyChange(const SelStart, ELen, NLen: integer; const ExistData, NewData: string; var CRec: TChangeRec); procedure CopyChange(const FromCRec: TChangeRec; var ToCRec : TChangeRec); // Returns an RTF version of current selection, '' if nothing selected. function GetSelectedRTF(): string; // Adds a Change to man data structure, either data may be empty/0. // ELen, ExistDate represent existing content to be overwritten // NLen, NewData is content being introduced by this change. procedure AddChange(const SelStart, ELen, NLen: integer; const ExistData, NewData: string); procedure AddChange(CR : TChangeRec); // Pushes the indicated content into KMemo1, may be an Undo or Redo, accepts // both plain text or RTF. procedure InsertIntoKMemo(loc: integer; St: string); Public // Public : Hooked into the KMemo1KeyDown or just before a // markup change. It pre loads OverwrittenLen and // Overwritten with selected content (or content near cursor // for Delete or Backspace. Key is only significent if its // Delete or Backspace. Its does no harm if called without // the followup (AddMarkup, AddKeyPress or AddKeyUp). procedure RecordInitial(const Key: word); // Public. Call immediatly after a Markup related change. // Depends on the Overwritten and OverwrittenLen // having been recorded before the change by RecordInitial() procedure AddMarkup({MarkUp: TChangeMarkUp}); // Public : Called from KMemo1 onKeyPress event, assumes privare var, // Overwritten has been initialised with anything being overwritten. procedure AddKeyPress(Key: char); // Public : Called from KMemo1 onKeyUp event, handles // only delete and backspace keys. procedure AddKeyUp(Key: Word; Shift: TShiftState); // Public : Called before a paste happens, captures incoming // content and the existing selected content, all as RFT. // Atomic, does not depend on Overwritten. procedure AddPasteOrCut(CutOnly: boolean=false); // Public: Called when a primary paste (ie middle mouse, three // finger tap on Linux or Windows) or some other 'insert' happens. // We should have already checked that buffer contains some text. // If GrabExisting then we capture any currently selected text to // be restored later if necessary. procedure AddTextInsert(const SelIndex: integer; const Content: string; GrabExisting: boolean = false); function CanUnDo() : boolean; function CanRedo() : boolean; // Public : Does Undo, rets True if another Undo is possible // Always safe to call, may do nothing. function UnDo : boolean; // Public : Does Redo, rets True if another Redo is possible // Always safe to call, may do nothing. function ReDo : boolean; constructor Create(KM: TKMemo); // Public : For debug purposes only, don't leave for release. {$IFDEF DEBUG_UNDO} procedure Report(); procedure DumpTheKMemo(WhereFrom : string); {$endif} end; implementation uses LCLType; // First, a pivate helper function. // Returns Clipboard contents as either RTF or Text, '' if unavailable function ClipboardContents(var Content : string; var TSize : integer) : boolean; var AStream: TMemoryStream; begin Result := true; AStream := TMemoryStream.Create; try // We use kcontrols tool, ClipBoardLoadStreamAs() here to ensure we get exactly the same result. if ClipBoardLoadStreamAs(cRichText, AStream, Content) and (AStream.Size > 0) then begin TSize := Content.Length; // Grab it before overwriting, thats bytes, not char, UTF8 issue ?? AStream.Seek(0, soFromBeginning); setlength(Content, AStream.Size); AStream.ReadBuffer(Pointer(Content)^, AStream.Size); end else TSize := Content.Length; // even if above fails, we probably have text. finally AStream.Free; end; end; { ------------ TUndo_Redo -----------} procedure TUndo_Redo.RecordInitial(const Key : word); begin // We may arrive here under a number of conditions - // 1. A simple key press, 'normal' key, nothing selected // 2. A simple Delete, nothing selected, char UNDER cursor goes away. // 3. A simple Backspace, nothing selected, char to left of cursor goes away. // 4. Any one of the above, but with something selected. What ever is selected // goes away and is replaced with nothing or the key if its 1. above. // 5. New - Also from a markup change, called just before the markup is applied. {$IFDEF DEBUG_UNDO} writeln('TUndo_Redo.RecordInital'); // only ifdef DEBUG_UNDO {$endif} Overwritten := GetSelectedRTF(); OverwrittenLen := TheKMemo.RealSelLength; if OverwrittenLen = 0 then begin // OK, nothing selected then. // VK_Back nor VK_Delete will go on to trigger a KeyPress event, we call that from KeyUp event. if (Key = VK_Delete) and (TheKmemo.text.Length > TheKmemo.Blocks.RealSelStart) then begin // Must be delete char under cursor TheKmemo.SelLength := 1; Overwritten := TheKmemo.Blocks.SelText; // Note this is plain text, not RTF TheKmemo.SelLength := 0; OverwrittenLen := 1; end; if (Key = VK_Back) and (TheKMemo.RealSelStart > 0) then begin TheKmemo.SelStart := TheKmemo.RealSelStart - 1; TheKmemo.SelLength := 1; Overwritten := TheKmemo.Blocks.SelText; // Note this is plain text, not RTF TheKmemo.SelStart := TheKmemo.RealSelStart + 1; TheKmemo.SelLength := 0; OverwrittenLen := 1; end; end; end; function TUndo_Redo.GetSelectedRTF() : string; var AStream : TMemoryStream; begin result := ''; if TheKMemo.Blocks.RealSelLength > 0 then begin AStream := TMemoryStream.Create; try TheKMemo.SaveToRTFStream(AStream, True); if AStream.Size > 0 then begin AStream.Seek(0, soBeginning); SetLength(Result, AStream.Size); AStream.ReadBuffer(Pointer(Result)^, AStream.Size); end; finally AStream.Free; end; end; end; procedure TUndo_Redo.AddPasteOrCut(CutOnly: boolean); var CR : TChangeRec; begin CR.StartSelIndex := TheKmemo.blocks.RealSelStart; if CutOnly then begin CR.NewData := ''; CR.NewLen := 0; end else ClipboardContents(CR.NewData, CR.NewLen); // wot, not checking return value ? brave .... CR.ExistLen := TheKMemo.RealSelLength; CR.ExistData := GetSelectedRTF(); AddChange(CR); end; procedure TUndo_Redo.AddTextInsert(const SelIndex: integer; const Content: string; GrabExisting : boolean = false); // ToDo : Inconsistent, other public methods find their own data .... var Buff : string; begin if GrabExisting then begin Buff := GetSelectedRTF(); AddChange(SelIndex, Buff.Length, Content.Length, Buff, Content); end else AddChange(SelIndex, 0, Content.Length, '', Content); end; procedure TUndo_Redo.AddKeyPress(Key: char); begin AddChange(TheKMemo.CaretPos-1, OverwrittenLen, 1, Overwritten, Key); // -1 `cos its already happened end; procedure TUndo_Redo.AddKeyUp(Key: Word; Shift: TShiftState); begin if Key = VK_Delete then begin // Maybe delete char under cursor or a selected block if TheKmemo.text.Length > TheKmemo.Blocks.RealSelStart then begin AddChange(TheKmemo.blocks.RealSelStart, OverwrittenLen, 0, Overwritten, ''); end; end; if Key = VK_Back then begin if TheKMemo.RealSelStart >= 0 then AddChange(TheKmemo.blocks.RealSelStart, OverwrittenLen, 0, Overwritten, ''); end; end; function TUndo_Redo.CanUnDo(): boolean; begin Result := (AvailChanges > 0); {$IFDEF DEBUG_UNDO} writeln('Can Undo ' + booltostr(result, True)); // only ifdef DEBUG_UNDO {$endif} end; function TUndo_Redo.CanRedo(): boolean; begin Result := (AvailReDos > 0); {$IFDEF DEBUG_UNDO} writeln('Can Redo ' + booltostr(result, True)); // only ifdef DEBUG_UNDO {$endif} end; // -------------- Recording Change Methods ---------------------- procedure TUndo_Redo.AddMarkup(); var CR : TChangeRec; begin CR.StartSelIndex := TheKmemo.blocks.RealSelStart; // assume this has not moved ?? CR.ExistLen := OverwrittenLen; CR.ExistData := Overwritten; CR.NewLen := OverwrittenLen; CR.NewData := GetSelectedRTF(); AddChange(CR); end; procedure TUndo_Redo.AddChange(const SelStart, ELen, NLen : integer; const ExistData, NewData: string{; const MarkUp : TChangeMarkup}); begin {$IFDEF DEBUG_UNDO} writeln('AddChange at ' + inttostr(SelStart) // only ifdef DEBUG_UNDO + ' replace [' + ExistData + '] (' + inttostr(ELen) + ') with [' + NewData + '] (' + inttostr(NLen) + ')'); {$ENDIF} CopyChange(SelStart, ELen, NLen, ExistData, NewData, ChangeStructure[NextChange]); inc(NextChange); if NextChange = MaxChange then NextChange := 0; if AvailChanges < MaxChange then inc(AvailChanges); AvailReDos := 0; // Once we make a non undo/redo change, no more redos available end; procedure TUndo_Redo.AddChange(CR: TChangeRec); begin AddChange(CR.StartSelIndex, CR.ExistLen, CR.NewLen, CR.ExistData, CR.NewData); end; // --------- Do and Undo methods ------------ procedure TUndo_Redo.InsertIntoKMemo(loc : integer; St : string); var AStream: TMemoryStream; begin {$IFDEF DEBUG_UNDO} DumpTheKMemo('in TUndo_Redo.InsertIntoKMemo before Insert'); {$ENDIF} if copy(St, 1, 11) = '{\rtf1\ansi' then begin AStream := TMemoryStream.Create; try AStream.Write(St[1], St.length); AStream.Seek(0, soFromBeginning); TheKMemo.LoadFromRTFStream(AStream, Loc); // ToDo : should restore cursor to end of any new text, but how long is that .... ? finally AStream.Free; {$IFDEF DEBUG_UNDO} DumpTheKMemo('in TUndo_Redo.InsertIntoKMemo After Insert'); {$endif} end; end else begin TheKMemo.ActiveBlocks.InsertPlainText(Loc, St); TheKMemo.SelStart := loc + length(St); end; {$IFDEF DEBUG_UNDO} DumpTheKMemo('in TUndo_Redo.InsertIntoKMemo End Insert'); {$ENDIF} // Leave moving the SelectionIndex around until AFTER releasing the Locks ! end; function TUndo_Redo.UnDo: boolean; var Target : integer; begin if not CanUnDo() then exit(False); {$IFDEF DEBUG_UNDO} DumpTheKMemo('in TUndo_Redo.UnDo Start '); {$endif} Target := NextChange; if Target > 0 then dec(Target) else Target := MaxChange -1; CopyChange(ChangeStructure[Target], CurrentCR); inc(AvailReDos); dec(AvailChanges); if NextChange > 0 then dec(NextChange) else NextChange := MaxChange-1; result := (AvailChanges > 0); // can we call UnDo again ? with CurrentCR do begin {$IFDEF DEBUG_UNDO} writeln('Undo at ' + inttostr(StartSelIndex) + ' replace [' // only ifdef DEBUG_UNDO + NewData + '] with [' + ExistData + ']'); {$ENDIF} Thekmemo.Blocks.LockUpdate; try if NewData <> '' then begin Thekmemo.SelStart := StartSelIndex; Thekmemo.SelLength := NewLen; TheKmemo.Blocks.ClearSelection; end; // Insert Replace at Loc if ExistData <> '' then InsertIntoKMemo(StartSelIndex, ExistData); finally Thekmemo.Blocks.UnLockUpdate; end; TheKMemo.SelLength := 0; TheKMemo.SelStart := StartSelIndex; end; {$IFDEF DEBUG_UNDO} DumpTheKMemo('in TUndo_Redo.UnDo Start '); // Report(); {$endif} end; function TUndo_Redo.ReDo: boolean; // A redo uses the data currently pointed to by NextChange begin if not CanReDo then exit(False); CopyChange(ChangeStructure[NextChange], CurrentCR); dec(AvailReDos); // one less ReDos available inc(AvailChanges); // cos we can go back there if we so choose. inc(NextChange); // Point to next one if NextChange = MaxChange then NextChange := 0; result := (AvailReDos > 0); // can we call ReDo again ? with CurrentCR do begin {$IFDEF DEBUG_UNDO} writeln('Redo at ' + inttostr(StartSelIndex) + ' replace [' + ExistData + '] with [' + NewData + ']'); // only ifdef DEBUG_UNDO {$ENDIF} try Thekmemo.Blocks.LockUpdate; if ExistData <> '' then begin Thekmemo.SelStart := StartSelIndex; Thekmemo.SelLength := ExistLen; TheKmemo.Blocks.ClearSelection; end; if NewData <> '' then InsertIntoKMemo(StartSelIndex, NewData); finally Thekmemo.Blocks.UnLockUpdate; end; end; {$IFDEF DEBUG_UNDO} //Report(); {$ENDIF} end; // ------------- House Keeping ------------------ procedure TUndo_Redo.CopyChange(const SelStart, ELen, NLen: integer; const ExistData, NewData: string; var CRec: TChangeRec); begin CRec.ExistData:= ExistData; CRec.NewData:= NewData; CRec.StartSelIndex:= SelStart; CRec.ExistLen := ELen; CRec.NewLen := NLen; end; procedure TUndo_Redo.CopyChange(const FromCRec: TChangeRec; var ToCRec: TChangeRec); begin CopyChange(FromCRec.StartSelIndex, FromCRec.ExistLen, FromCRec.NewLen, FromCRec.ExistData, FromCRec.NewData, ToCRec); end; {$IFDEF DEBUG_UNDO} procedure TUndo_Redo.Report(); // This is a Debug method, it has no place in a release ! var I : integer = 0; //MarkUpSt : string; begin //exit; writeln('---------- Undo Report ---------'); writeln('NextChange=' + inttostr(NextChange) // only ifdef DEBUG_UNDO + ' AvailChanges=' + inttostr(AvailChanges) + ' AvailReDos=' + inttostr(AvailReDos)); for I := 0 to MaxChange -1 do // this is unnecessary, remove after testing if ChangeStructure[i].StartSelIndex >= 0 then begin writeln('Slot:' + inttostr(I) + ' Index:' + inttostr(ChangeStructure[i].StartSelIndex) + ' [' + ChangeStructure[i].ExistData + '] - [' + ChangeStructure[i].NewData + ']'{ + 'MarkUp=' + MarkUpSt}); end; writeln('Current : ' + inttostr(CurrentCR.StartSelIndex) + ' [' + CurrentCR.ExistData // only ifdef DEBUG_UNDO + '] - [' + CurrentCR.NewData + ']'); writeln('--------------------------------'); // only ifdef DEBUG_UNDO end; // This is a debug method, take care, it uses writeln and will kill Windows ! procedure TUndo_Redo.DumpTheKMemo(WhereFrom : string); var i : integer; begin Writeln('============ TEditBoxForm.DumpKMemo from ' + WhereFrom); writeln('============ BlockCount=', TheKMemo.Blocks.Count); writeln('============ EndBlock Index=', integer(TheKMemo.Blocks.Lines.Items[TheKMemo.Blocks.Lines.Count-1].EndBlock)); for i := 0 to TheKmemo.Blocks.Count-1 do writeln(Inttostr(i) + ' ' + TheKMemo.Blocks.Items[i].ClassName + ' = ' + TheKMemo.Blocks.Items[i].Text); end; {$endif} constructor TUndo_Redo.Create(KM : TKMemo); var I : integer; begin TheKMemo := KM; for I := 0 to MaxChange-1 do // ToDo : maybe this is unnecessary, remove after testing ChangeStructure[i].StartSelIndex:= -1; end; end. tomboy-ng_0.39-1/source/backlinks.pas0000644000175000017500000000275114551457644017412 0ustar dbannondbannonunit Backlinks; {$mode ObjFPC}{$H+} interface uses Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, Buttons; type PString = ^String; type { TFormBackLinks } TFormBackLinks = class(TForm) BitBtn1: TBitBtn; Label1: TLabel; ListBox1: TListBox; procedure FormShow(Sender: TObject); procedure ListBox1Click(Sender: TObject); private public BackList : TStringList; // dont free, belongs to EditBox BackTitle : PString; end; var FormBackLinks: TFormBackLinks; implementation uses {SearchUnit,} LCLProc; {$R *.lfm} { TFormBackLinks } procedure TFormBackLinks.FormShow(Sender: TObject); var i : integer; begin //DebugLn('TFormBackLinks.FormShow 1 ItemIndex=' + inttostr(ListBox1.ItemIndex)); ListBox1.ItemIndex := -1; Label1.Visible := BackList.Count = 0; ListBox1.ClickOnSelChange := False; // Above line to ensure we don't get unwanted click events on some linux systems. ListBox1.Clear; ListBox1.Items := BackList; ListBox1.ItemIndex := -1; //DebugLn('TFormBackLinks.FormShow 2 ItemIndex=' + inttostr(ListBox1.ItemIndex)); end; procedure TFormBackLinks.ListBox1Click(Sender: TObject); begin //DebugLn('TFormBackLinks.ListBox1Click 1 ItemIndex=' + inttostr(ListBox1.ItemIndex)); if (ListBox1.ItemIndex >= 0) and (ListBox1.ItemIndex < ListBox1.Count) then begin BackTitle^ := ListBox1.Items[ListBox1.ItemIndex]; close; end; end; end. tomboy-ng_0.39-1/source/syncgui.pas0000644000175000017500000004646214551457644017141 0ustar dbannondbannonunit SyncGUI; { Copyright (C) 2017-2020 David Bannon License: This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html ------------------ } { History 2017/12/06 Marked FileSync debug mode off to quieten console output a little 2017/12/30 Changed above DebugMode to VerboseMode 2017/12/30 We now call IndexNotes() after a sync. Potentially slow. 2017/12/30 Added a seperate procedure to do manual Sync, its called by a timer to ensure we can see dialog before it starts. 2018/01/01 Added ID in sync report to make it easier to track errors. 2018/01/01 Set goThumbTracking true so contents of scroll box glide past as you move the "Thumb Slide". 2018/01/01 Changed ModalResult for cancel button to mrCancel 2018/01/08 Tidied up message box text displayed when a sync conflict happens. 2018/01/25 Changes to support Notebooks 2018/01/04 Forced a screen update before manual sync so user knows whats happening. 2018/04/12 Added ability to call MarkNoteReadOnly() to cover case where user has unchanged note open while sync process downloads or deletes that note from disk. 2018/04/13 Taught MarkNoteReadOnly() to also delete ref in NoteLister to a sync deleted note 2018/05/12 Extensive changes - MainUnit is now just that. Only change here relates to naming of MainUnit and SearchUnit. 2018/05/21 Show any sync errors as hints in the StringGrid. 2018/06/02 Honor a cli --debug-sync 2018/06/14 Update labels when transitioning from Testing Sync to Manual Sync 2018/08/14 Added SDiff to replace clumbsy dialog when sync clash happens. 2018/08/18 Improved test/reporting of file access during sync 2018/10/25 New sync model. Much testing, support for Tomdroid. 2018/10/28 Much tweaking and bug fixing. 2018/10/29 Tell TB_Sdiff about note title before showing it. 2018/10/30 Don't show SyNothing in sync report 2018/11/04 Added support to update in memory NoteList after a sync. 2019/05/19 Display strings all (?) moved to resourcestrings 2020/02/20 Added capability to sync without showing GUI. 2020/06/18 Only show good sync notification for 3 seconds 2020/08/07 Changed the stringGrid to a ListView 'cos it handles dark themes better. 2020/08/10 ListView becomes type=vsReport 2020/04/26 Set Save button to disabled immediatly when pressed. 2021/09/08 Added progress indicator 2022/04/15 Improve man sync close button communication with user. } {$mode objfpc}{$H+} interface uses Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls, {Grids,} ComCtrls, Syncutils; type { TFormSync } TFormSync = class(TForm) ButtonSave: TButton; ButtonCancel: TButton; ButtonClose: TButton; Label1: TLabel; Label2: TLabel; LabelProgress: TLabel; ListViewReport: TListView; // Viewstyle=vsReport, make columns in Object Inspector Memo1: TMemo; Panel1: TPanel; Panel2: TPanel; Panel3: TPanel; Splitter3: TSplitter; { Runs a sync without showing form. Ret False if error or its not setup. Caller must ensure that Sync is config and that the Sync dir is available. If clash, user will see dialog. } procedure FormCreate(Sender: TObject); // function RunSyncHidden() : boolean; procedure ButtonCancelClick(Sender: TObject); procedure ButtonCloseClick(Sender: TObject); procedure ButtonSaveClick(Sender: TObject); procedure FormClose(Sender: TObject; var CloseAction: TCloseAction); procedure FormHide(Sender: TObject); { At Show, depending on SetUpSync, we'll either go ahead and do it, any error is fatal or, if True, walk user through process. } procedure FormShow(Sender: TObject); private FormShown : boolean; LocalTimer : TTimer; procedure AddLVItem(Act, Title, ID: string); procedure AdjustNoteList(); procedure AfterShown(Sender : TObject); // Display a summary of sync actions to user. function DisplaySync(): string; { Called when user wants to join a (possibly uninitialised) Repo, will handle some problems with user's help. } procedure JoinSync; { Called to do a sync assuming its all setup. Any problem is fatal } function ManualSync: boolean; { Populates the string grid with details of notes to be actioned } procedure ShowReport; { We will pass address of this method to lower level units so they can report on progress. Short one to three words ? } procedure SyncProgress(const St: string); public Busy : boolean; // indicates that there is some sort of sync in process now. AnotherSync : boolean; // After this (manual) sync, we have another one (ie github) Transport : TSyncTransPort; UserName, Password : string; // For those thatnsports that need such things. LocalConfig, NoteDirectory : ANSIString; { Indicates we are doing a setup User has already agreed to abandon any existing Repo but we don't know if indicated spot already contains a repo or, maybe we want to make one. } SetupSync : boolean; { we will pass address of this function to Sync } function Proceed(const ClashRec : TClashRecord) : TSyncAction; end; var FormSync: TFormSync; implementation { In SetupFileSync mode, does a superficial, non writing, test OnShow() user can then click 'OK' and we'd do a real sync, exit and settings saved in calling process. } uses LazLogger, SearchUnit, TB_SDiff, Sync, LCLType, {SyncError,} ResourceStr, {notifier,} Settings, MainUnit { tb_utils}; {$R *.lfm} var ASync : TSync; { TFormSync } function TFormSync.Proceed(const ClashRec : TClashRecord) : TSyncAction; var SDiff : TFormSDiff; begin SDiff := TFormSDiff.Create(self); SDiff.RemoteFilename := ClashRec.ServerFileName; SDiff.LocalFilename := ClashRec.LocalFileName; SDiff.NoteTitle := ClashRec.Title; case SDiff.ShowModal of mrYes : Result := SyDownLoad; mrNo : Result := SyUpLoadEdit; mrNoToAll : Result := SyAllLocal; mrYesToAll : Result := SyAllRemote; mrAll : Result := SyAllNewest; mrClose : Result := SyAllOldest; otherwise Result := SyUnSet; // Thats an ERROR ! What are you doing about it ? end; SDiff.Free; Application.ProcessMessages; // so dialog goes away while remainder are being processed. // Use Remote, Yellow is mrYes, File1 // Use Local, Aqua is mrNo, File2 end; procedure TFormSync.FormClose(Sender: TObject; var CloseAction: TCloseAction); begin FreeandNil(ASync); Busy := False; end; procedure TFormSync.FormHide(Sender: TObject); begin if LocalTimer = Nil then exit(); LocalTimer.Free; LocalTimer := nil; end; procedure TFormSync.SyncProgress(const St: string); begin LabelProgress.Caption := St; Application.ProcessMessages; end; // Following resourcestrings defined in syncUtils.pas function TFormSync.DisplaySync(): string; var UpNew, UpEdit, Down, DelLoc, DelRem, Clash, DoNothing, Errors : integer; begin ASync.ReportMetaData(UpNew, UpEdit, Down, DelLoc, DelRem, Clash, DoNothing, Errors); Memo1.Append(rsNewUploads + inttostr(UpNew)); Memo1.Append(rsEditUploads + inttostr(UpEdit)); Memo1.Append(rsDownloads + inttostr(Down)); Memo1.Append(rsLocalDeletes + inttostr(DelLoc)); Memo1.Append(rsRemoteDeletes + inttostr(DelRem)); Memo1.Append(rsClashes + inttostr(Clash)); Memo1.Append(rsDoNothing + inttostr(DoNothing)); if Errors > 0 then Memo1.Append(rsSyncERRORS + inttostr(Errors)); result := 'Uploads=' + inttostr(UpNew+UpEdit) + ' downloads=' + inttostr(Down) + ' deletes=' + inttostr(DelLoc + DelRem); // debugln('Display Sync called, DoNothings is ' + inttostr(DoNothing)); end; // User is only allowed to press Cancel or Save when this is finished. procedure TFormSync.JoinSync; var SyncAvail : TSyncAvailable; begin freeandnil(ASync); ASync := TSync.Create; Label1.Caption := SyncTransportName(Transport) + ' ' + rsTestingRepo; Application.ProcessMessages; ASync.ProceedFunction:= @Proceed; ASync.DebugMode := Application.HasOption('s', 'debug-sync'); ASync.NotesDir:= NoteDirectory; ASync.ConfigDir := LocalConfig; ASync.ProgressProcedure := @SyncProgress; ASync.Password := Sett.LabelToken.Caption; // better find a better way to do this Davo Async.UserName := Sett.EditUserName.text; ASync.RepoAction:=RepoJoin; Async.SetTransport(TransPort); SyncAvail := ASync.TestConnection(); if SyncAvail = SyncNoRemoteRepo then if mrYes = QuestionDlg('Advice', rsCreateNewRepo, mtConfirmation, [mrYes, mrNo], 0) then begin ASync.RepoAction:=RepoNew; SyncAvail := ASync.TestConnection(); end; if SyncAvail <> SyncReady then begin showmessage(rsUnableToProceed + ' ' + ASync.ErrorString); ModalResult := mrCancel; end; Label1.Caption := SyncTransportName(Transport) + ' ' + rsLookingatNotes; Application.ProcessMessages; ASync.TestRun := True; ASync.GetSyncData(); // does not return anything interesting here. Does in Auto mode however. // if ASync.UseSyncData() then begin // ToDo : am I dealing with TestRun correctly ? DisplaySync(); ShowReport(); Label1.Caption := SyncTransportName(Transport) + ' ' + rsLookingatNotes; Label2.Caption := rsSaveAndSync; ButtonSave.Enabled := True; // end else // Showmessage(rsSyncError + ' ' + ASync.ErrorString); ButtonCancel.Enabled := True; end; procedure TFormSync.AfterShown(Sender : TObject); begin LocalTimer.Enabled := False; // Don't want to hear from you again if SetUpSync then begin JoinSync(); end else ManualSync(); end; //RESOURCESTRING // rsPleaseWait = 'Please wait a minute or two ...'; procedure TFormSync.FormShow(Sender: TObject); begin if Application.HasOption('debug-sync') then debugln('TFormSync.FormShow '); Busy := True; LabelProgress.Caption := ''; Left := 55 + random(55); Top := 55 + random(55); FormShown := False; Label2.Caption := rsNextBitSlow; Memo1.Clear; ListViewReport.Clear; ButtonSave.Enabled := False; ButtonClose.Enabled := False; ButtonCancel.Enabled := False; {$ifdef windows} // linux apps know how to do this themselves if Sett.DarkTheme then begin // Sett.BackGndColour; Sett.TextColour; ListViewReport.Color := clnavy; ListViewReport.Font.Color := Sett.HiColour; splitter3.Color:= clnavy; Panel1.color := Sett.BackGndColour; Panel2.color := Sett.BackGndColour; Panel3.color := Sett.BackGndColour; Label1.Font.Color:= Sett.TextColour; Label2.Font.Color := Sett.TextColour; Memo1.Color:= Sett.BackGndColour; Memo1.Font.Color := Sett.TextColour; ButtonCancel.Color := Sett.HiColour; ButtonClose.Color := Sett.HiColour; ButtonSave.Color := Sett.HiColour; end; {$endif} // We call a timer to get out of OnShow so ProcessMessages works as expected LocalTimer := TTimer.Create(Nil); LocalTimer.OnTimer:= @AfterShown; LocalTimer.Interval:=500; LocalTimer.Enabled := True; end; (* function TFormSync.RunSyncHidden(): boolean; // ToDo : this is now done in Settings, remove ??? begin //debugln('In RunSyncHidden'); if SetUpSync then exit(False); // should never call this in setup mode but to be sure ... busy := true; ListViewReport.Clear; // Result := ManualSync(); ASync := TSync.Create; try ASync.AutoSetUp(Transport); // ToDo : must determine what mode of Sync we are running in. ASync.GetSyncData(); ASync.UseSyncData(); finally ASync.Free; Busy := False; end; end; *) procedure TFormSync.FormCreate(Sender: TObject); begin UserName := ''; Password := ''; end; // User is only allowed to press Close when this is finished. function TFormSync.ManualSync : boolean; var //SyncState : TSyncAvailable = SyncNotYet; //Notifier : TNotifier; SyncSummary : string; begin Label1.Caption := SyncTransportName(Transport) + ' ' + rsTestingSync; Application.ProcessMessages; ASync := TSync.Create; try //Screen.Cursor := crHourGlass; //sleep(1000); ASync.ProceedFunction := @Proceed; ASync.ProgressProcedure := @SyncProgress; ASync.DebugMode := Application.HasOption('s', 'debug-sync'); ASync.NotesDir:= NoteDirectory; ASync.ConfigDir := LocalConfig; ASync.RepoAction:= RepoUse; ASync.Password := Sett.LabelToken.Caption; // better find a better way to do this Davo Async.UserName := Sett.EditUserName.text; Async.SetTransport(TransPort); //debugln({$I %FILE%}, ', ', {$I %CURRENTROUTINE%}, '(), line:', {$I %LINE%}, ' : Testing Connection.'); if ASync.TestConnection() <> SyncReady then begin debugln({$I %FILE%}, ', ', {$I %CURRENTROUTINE%}, '(), line:', {$I %LINE%}, ' : ', 'Test Transport Failed.'); if ASync.DebugMode then debugln('Failed testConnection'); // in autosync mode, form is not visible, we just send a notify that cannot sync right now.and return false if not Visible then begin SearchForm.UpdateStatusBar(1, rsAutoSyncNotPossible); if Sett.CheckNotifications.checked then begin MainForm.ShowNotification(rsAutoSyncNotPossible); end; exit(false); end else begin // busy unset in finally clause //Screen.Cursor := crDefault; showmessage('Unable to sync because ' + ASync.ErrorString); //Screen.Cursor := crHourGlass; FormSync.ModalResult := mrAbort; exit(false); // busy unset in finally clause end; exit(false); //redundant ? end; //debugln({$I %FILE%}, ', ', {$I %CURRENTROUTINE%}, '(), line:', {$I %LINE%}, ' : ', 'Transport good, about to run.'); Label1.Caption := SyncTransportName(Transport) + ' ' + rsRunningSync; Application.ProcessMessages; ASync.TestRun := False; if ASync.GetSyncData() and ASync.UseSyncData() then; // ToDo : should I evaluate separetly ? SyncSummary := DisplaySync(); SearchForm.UpdateStatusBar(1, rsLastSync + ' ' + FormatDateTime('YYYY-MM-DD hh:mm', now) + ' ' + SyncSummary); if (not Visible) and Sett.CheckNotifications.Checked then begin MainForm.ShowNotification(rsLastSync + ' ' + SyncSummary, 2000); end; ShowReport(); AdjustNoteList(); // ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Label1.Caption := SyncTransportName(Transport) + ' ' + rsAllDone; Label2.Caption := rsPressClose; ButtonClose.Enabled := True; if AnotherSync then begin ButtonClose.Hint := 'proceed to next sync'; ButtonClose.ShowHint := True; end else ButtonClose.ShowHint := False; Result := True; finally FreeandNil(ASync); Busy := False; //Screen.Cursor := crDefault; end; end; procedure TFormSync.AdjustNoteList(); var DeletedList, DownList : TStringList; Index : integer; begin DeletedList := TStringList.Create; DownList := TStringList.Create; with ASync.RemoteMetaData do begin for Index := 0 to Count -1 do begin if Items[Index]^.Action = SyDeleteLocal then DeletedList.Add(Items[Index]^.ID); if Items[Index]^.Action = SyDownload then DownList.Add(Items[Index]^.ID); end; end; if (DeletedList.Count > 0) or (DownList.Count > 0) then SearchForm.ProcessSyncUpdates(DeletedList, DownList); FreeandNil(DeletedList); FreeandNil(DownList); end; procedure TFormSync.AddLVItem(Act, Title, ID : string); var TheItem : TListItem; begin TheItem := ListViewReport.Items.Add; TheItem.Caption := Act; TheItem.SubItems.Add(copy(Title, 1, 25)+' '); TheItem.SubItems.Add(ID); end; procedure TFormSync.ShowReport; var Index : integer; Rows : integer = 0; begin with ASync.RemoteMetaData do begin for Index := 0 to Count -1 do begin if Items[Index]^.Action <> SyNothing then begin AddLVItem( ASync.RemoteMetaData.ActionName(Items[Index]^.Action) , Items[Index]^.Title , Items[Index]^.ID); inc(Rows); end; end end; if Rows = 0 then Memo1.Append(rsNoNotesNeededSync) else Memo1.Append(inttostr(ASync.RemoteMetaData.Count) + rsNotesWereDealt); if ASync.TransMode = SyncGitHub then begin Memo1.Append('Token expires : ' + ASync.TokenExpire); Sett.LabelToken.Hint := 'Expires ' + ASync.TokenExpire; end; {$IFDEF DARWIN} // Apparently ListView.columns[n].autosize does not work in Mac, this is rough but better then nothing. ListViewReport.Columns[0].Width := listviewReport.Canvas.Font.GetTextWidth('upload edit '); ListViewReport.Columns[1].Width := ListViewReport.Columns[0].Width *2; {$ENDIF} end; procedure TFormSync.ButtonCancelClick(Sender: TObject); begin ModalResult := mrCancel; end; procedure TFormSync.ButtonCloseClick(Sender: TObject); begin ModalResult := mrOK; end; // This only ever happens during a Join, RepoAction will still be 'join'. procedure TFormSync.ButtonSaveClick(Sender: TObject); begin Label2.Caption:=rsNextBitSlow; Label1.Caption := SyncTransportName(Transport) + ' ' + 'First Time Sync'; Memo1.Clear; ButtonCancel.Enabled := False; ButtonSave.Enabled := False; Application.ProcessMessages; ASync.TestRun := False; if ASync.GetSyncData() and ASync.UseSyncData() then begin // ToDo : should I evaluate separetly ? SearchForm.UpdateStatusBar(1, rsLastSync + ' ' + FormatDateTime('YYYY-MM-DD hh:mm', now) + ' ' + DisplaySync()); ShowReport(); AdjustNoteList(); Label1.Caption := SyncTransportName(Transport) + ' ' + rsAllDone; Label2.Caption := rsPressClose; if ASync.TransMode = SyncGithub then begin Sett.LabelSyncRepo.Caption := ASync.GetTransRemoteAddress; // this relies on Sett being in Github mode, during a Join, should be .... Sett.LabelToken.Hint := 'Expires ' + ASync.TokenExpire; end; end else Showmessage(rsSyncError + ASync.ErrorString); ButtonClose.Enabled := True; end; end. tomboy-ng_0.39-1/source/autostart.pas0000644000175000017500000001053414551457644017475 0ustar dbannondbannonunit autostart; { Copyright (C) 2017-2020 David Bannon License: This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html ------------------ A unit to set and unset auto start of the tomboy-ng application on Windows and Linux. 2019/05/24 Display strings all (?) moved to resourcestrings 2020/05/18 Windows binaries no longer have 32 or 64 as part of binary name } {$mode objfpc}{$H+} interface uses Classes, SysUtils; type { TAutoStartCtrl } TAutoStartCtrl = class Private procedure AutoOff(AppName : string); // don't need appname Linux or windows, maybe MacOS ? procedure AutoOn(AppName: string); {$ifdef WINDOWS} function WindowsDirectory(CSIDL : integer): string; {$endif} Public ErrorMessage : string; // If set, trouble Will Roberinson ! TargetName : string; // Whatever we need copy, link or what ever to LinkName : string; // What we put in destination LinkDestination : string; // Directory we put the above. constructor Create(AppName : string; StartIt : boolean); destructor Destroy; override; end; implementation uses LazLogger, LazFileUtils, FileUtil, LazUTF8 {$ifdef WINDOWS}, Windows, ShlObj, ActiveX, ComObj, ExtCtrls{$endif}; { TAutoStartCtrl } {$ifdef WINDOWS} function TAutoStartCtrl.WindowsDirectory(CSIDL : integer) : string; var DirArray : array[0..MAX_PATH] of Char; PIDL : PItemIDList; begin SHGetSpecialFolderLocation(0, CSIDL, PIDL) ; SHGetPathFromIDList(PIDL, DirArray) ; Result := DirArray; // CSIDL_PROGRAM_FILES -> Where the tomboy-ng directory containg exe is. // CSIDL_STARTUP -> Where we put our shortcut (or remove it from) // CSIDL_APPDATA -> top of ~/AppData\Roaming ...... (not needed here) // CSIDL_DESKTOPDIRECTORY -> User's desktop. end; {$endif} procedure TAutoStartCtrl.AutoOn(AppName : string); {$ifdef WINDOWS} Var IObject : IUnknown; ISLink : IShellLink; IPFile : IPersistFile; {$endif} begin {$ifdef LINUX} // Just copy the desktop file, too easy. if not DirPathExists(LinkDestination) then ForceDirectory(LinkDestination); if FileExistsUTF8(TargetName) then CopyFile(TargetName, LinkDestination + LinkName) else ErrorMessage := 'Cannot find ' + TargetName; {$endif} {$ifdef WINDOWS} // Typically makes a link to c:\Programe Files\tomboy-ng\tomboy-ng64.exe in // C:\Users\dbann\AppData\Roaming\Microsoft\Windows\Start Menu\Programs\Startup\. if not FileExistsUTF8(TargetName) then begin ErrorMessage := 'Cannot find ' + TargetName; exit; end; IObject := CreateComObject(CLSID_ShellLink) ; ISLink := IObject as IShellLink; IPFile := IObject as IPersistFile; ISLink.SetPath(pChar(TargetName)); IsLink.SetWorkingDirectory(pChar(ExtractFilePath(TargetName))); IPFile.Save(PWChar(WideString(LinkDestination + LinkName)), false); // ErrorMessage := TargetName + ' --- ' + LinkDestination + LinkName; {$endif} end; procedure TAutoStartCtrl.AutoOff(AppName : string); begin if FileExistsUTF8(LinkDestination + LinkName) then DeleteFileUTF8(LinkDestination + LinkName); end; constructor TAutoStartCtrl.Create(AppName: string; StartIt: boolean); (* {$ifdef WINDOWS}var CPU : string;{$endif} *) begin inherited create; ErrorMessage := ''; {$ifdef LINUX} TargetName := '/usr/share/applications/' + AppName + '.desktop'; LinkDestination := AppendPathDelim(GetEnvironmentVariableUTF8('HOME')) + '.config/autostart'; LinkName := '/' + AppName + '.desktop'; {$endif} {$ifdef WINDOWS} (* CPU := {$i %FPCTARGETCPU%}; if CPU = 'i386' then CPU := '32' else CPU := '64'; } *) TargetName := WindowsDirectory(CSIDL_PROGRAM_FILES) + '\' + AppName + '\' + AppName + '.exe'; LinkDestination := WindowsDirectory(CSIDL_STARTUP); LinkName := '\' + AppName + '.lnk'; {$endif} if StartIt then AutoOn(AppName) else AutoOff(AppName); end; destructor TAutoStartCtrl.Destroy; begin inherited Destroy; end; end. tomboy-ng_0.39-1/source/tb_sdiff.lrj0000644000175000017500000000465514551457644017242 0ustar dbannondbannon{"version":1,"strings":[ {"hash":33421508,"name":"tformsdiff.caption","sourcebytes":[65,32,78,111,116,101,32,83,121,110,99,32,67,108,97,115,104,32,104,97,115,32,98,101,101,110,32,68,101,116,101,99,116,101,100],"value":"A Note Sync Clash has been Detected"}, {"hash":31088229,"name":"tformsdiff.labelremote.caption","sourcebytes":[76,97,98,101,108,82,101,109,111,116,101],"value":"LabelRemote"}, {"hash":202931964,"name":"tformsdiff.labellocal.caption","sourcebytes":[76,97,98,101,108,76,111,99,97,108],"value":"LabelLocal"}, {"hash":94564212,"name":"tformsdiff.label3.caption","sourcebytes":[82,101,109,111,116,101,32,67,104,97,110,103,101,100],"value":"Remote Changed"}, {"hash":180302756,"name":"tformsdiff.label4.caption","sourcebytes":[76,111,99,97,108,32,67,104,97,110,103,101,100],"value":"Local Changed"}, {"hash":164800533,"name":"tformsdiff.radiolong.hint","sourcebytes":[77,97,121,98,101,32,110,101,99,101,115,115,97,114,121,32,116,111,32,115,104,111,119,32,100,105,102,102,101,114,101,110,99,101],"value":"Maybe necessary to show difference"}, {"hash":156750467,"name":"tformsdiff.radiolong.caption","sourcebytes":[76,111,110,103,32,76,105,110,101,115],"value":"Long Lines"}, {"hash":59263924,"name":"tformsdiff.radioshort.hint","sourcebytes":[69,97,115,105,101,114,32,116,111,32,114,101,97,100],"value":"Easier to read"}, {"hash":103486035,"name":"tformsdiff.radioshort.caption","sourcebytes":[83,104,111,114,116,32,76,105,110,101,115],"value":"Short Lines"}, {"hash":38215182,"name":"tformsdiff.label1.caption","sourcebytes":[79,114,32,109,97,107,101,32,97,32,99,104,111,105,99,101,32,102,111,114,32,114,101,109,97,105,110,100,101,114,32,111,102,32,116,104,105,115,32,114,117,110],"value":"Or make a choice for remainder of this run"}, {"hash":90352804,"name":"tformsdiff.buttalloldest.caption","sourcebytes":[79,108,100,101,115,116],"value":"Oldest"}, {"hash":88923300,"name":"tformsdiff.buttallnewest.caption","sourcebytes":[78,101,119,101,115,116],"value":"Newest"}, {"hash":5462396,"name":"tformsdiff.buttalllocal.caption","sourcebytes":[76,111,99,97,108],"value":"Local"}, {"hash":93079205,"name":"tformsdiff.buttallremote.caption","sourcebytes":[82,101,109,111,116,101],"value":"Remote"}, {"hash":122881516,"name":"tformsdiff.bitbtnuselocal.caption","sourcebytes":[85,115,101,32,76,111,99,97,108],"value":"Use Local"}, {"hash":93327317,"name":"tformsdiff.bitbtnuseremote.caption","sourcebytes":[85,115,101,32,82,101,109,111,116,101],"value":"Use Remote"} ]} tomboy-ng_0.39-1/source/cli.pas0000644000175000017500000002753414551457644016226 0ustar dbannondbannonunit cli; {$mode objfpc}{$H+} { Copyright (C) 2017-2022 David Bannon License: This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html ------------------ This unit is active before the GUI section and may decide GUI is not needed. Handles command line switches, imports and comms with an existing instance. History 2020/06/18 Remove unnecessary debug line. 2021/12/28 Tidy LongOpts model. 2022/01/13 When importing file, don't check for its existance, importer will do that 2022/01/13 When importing note, check if FFileName starts with '~' 2022/04/07 Tidy up options. 2022/05/03 Add unix username to IPC pipe. 2022/10/18 Short switch for import MD is -m 2022/10/20 Do Import from this instance with direct call to IndexNewNote(). } { Note that for Qt app, the command line can also include a option meant for Qt. See https://doc.qt.io/qt-5/qguiapplication.html#supported-command-line-options It appears that Qt sees such an option before this unit does AND it removes it and also removes anything after it ! But does act on it. Seems both - and -- acceptable - --platformtheme qt5ct -platformtheme qt5ct And an typo in the option value is ignored, use a space as seperator, not '=' ! } interface uses Classes, SysUtils, Dialogs; function ContinueToGUI() : boolean ; { Will take offered file name, report some error else checks its a .note, saves it to normal repo and requests a running instance (if there is one) to reindex as necessary. Note that in CLI mode, we do not check for a Title Clash (because NoteLister may not be running. In GUI mode, existing Title is checked.} procedure Import_Note(FFName : string = ''); { Will take offered file name, report error else converts that file to .note, saves it to normal repo and requests a running instance (if there is one) to reindex as necessary. Note that in CLI mode, we do not check for a Title Clash (because NoteLister may not be running. In GUI mode, existing Title is checked.} procedure Import_Text_MD_File(MD : boolean; FFName : string = ''); var SingleNoteName : string = ''; // other unit will want to know..... const Version_string = {$I %TOMBOY_NG_VER}; implementation uses Forms, LCLProc, LazFileUtils, FileUtil, ResourceStr, simpleipc, IniFiles, import_notes, tb_utils; type ENoNotesRepoException = class(Exception); var LongOpts : TStringArray; // See initialization section const ShortOpts = 'hgo:l:vt:m:n:'; // help gnome3 open lang ver import-[txt md note] { If something on commandline means don't proceed, ret True } function CommandLineError(inCommingError : string = '') : boolean; var ErrorMsg : string; begin ErrorMsg := InCommingError; Result := false; if ErrorMsg = '' then begin ErrorMsg := Application.CheckOptions(ShortOpts, LongOpts); if Application.HasOption('h', 'help') then ErrorMsg := 'Usage -'; end; if ErrorMsg <> '' then begin DebugLn(ErrorMsg); {$ifdef DARWIN} debugln(rsMachelp1); debugln(rsMacHelp2); {$endif} debugln(' --dark-theme ' + 'Does not work for GTK2'); debugln(' -l --lang=CCode ' + rsHelpLang); // syntax depends on bugfix https://bugs.freepascal.org/view.php?id=35432 debugln(' -h --help ' + rsHelpHelp); debugln(' --version ' + rsHelpVersion); debugln(' --no-splash ' + rsHelpNoSplash); debugln(' --debug-sync ' + rsHelpDebugSync); debugln(' --debug-index ' + rsHelpDebugIndex); debugln(' --debug-spell ' + rsHelpDebugSpell); debugln(' --config-dir=PATH_to_DIR ' + rsHelpConfig); debugln(' --open-note=PATH_to_NOTE ' + rsHelpSingleNote); debugln(' --debug-log=SOME.LOG ' + rsHelpDebug); // debugln(' --save-exit ' + rsHelpSaveExit); // legacy but still allowed. debugln(' --import-txt=PATH_to_FILE ' + rsHelpImportFile + ' also -t'); debugln(' --import-md=PATH_to_FILE ' + rsHelpImportFile + ' also -m'); debugln(' --import-note=PATH_to_NOTE ' + rsHelpImportFile + ' also -n'); debugln(' --title-fname ' + rsHelpTitleISFName); {$ifdef LCLgtk2} debugln(' --useappind=yes|no ' + 'Force particular TrayIcon'); {$endif} result := true; end; end; { Ret T if we have ONE or more command line Paramaters, not to be confused with a Option, a parameter has no '-'. Because the only parameter we expect is SingleNoteFileName, we also honour -o --open-note. More than one such parameter is an error, report to console, ret true but set SingleFileName to ''. } function HaveCMDParam() : boolean; var Params : TStringArray; begin Result := False; if Application.HasOption('o', 'open-note') then begin SingleNoteName := Application.GetOptionValue('o', 'open-note'); exit(True); end; Params := Application.GetNonOptions(ShortOpts, LongOpts); if length(Params) = 1 then begin if Params[0] <> '%f' then begin // MX Linux passes the %f from desktop file during autostart SingleNoteName := Params[0]; exit(True); end; end; if length(Params) > 1 then begin CommandLineError('Unrecognised parameters on command line'); SingleNoteName := ''; exit(True); end; end; // Looks for server, if present, sends indicated message and returns true, else false. function CanSendMessage(Msg : string) : boolean; var CommsClient : TSimpleIPCClient; begin Result := False; // if TheReindexProc = nil then begin try CommsClient := TSimpleIPCClient.Create(Nil); CommsClient.ServerID:='tomboy-ng' {$ifdef UNIX} + '-' + GetEnvironmentVariable('USER'){$endif}; // on multiuser system, unique if CommsClient.ServerRunning then begin CommsClient.Active := true; CommsClient.SendStringMessage(Msg); CommsClient.Active := false; Result := True; end; finally freeandnil(CommsClient); end; // end else TheReindexProc(); end; { Returns the absolute notes dir, raises ENoNotesRepoException if it cannot find it } function GetNotesDir() : string; var ConfigFile : TIniFile; begin // TiniFile does not care it it does not find the config file, just returns default values. ConfigFile := TINIFile.Create(TB_GetDefaultConfigDir + 'tomboy-ng.cfg'); try result := ConfigFile.readstring('BasicSettings', 'NotesPath', ''); // MUST be mentioned in config file finally ConfigFile.Free; end; if Result = '' then Raise ENoNotesRepoException.create('tomboy-ng does not appear to be configured'); end; procedure Import_Note(FFName : string = ''); var FFileName, Fname : string; GUID : TGUID; begin if FFName <> '' then FFileName := FFName else FFileName := Application.GetOptionValue('n', 'import-note'); {$ifdef UNIX} if FFileName[1] = '~' then FFileName := GetEnvironmentVariable('HOME') + FFileName.Remove(0,1); {$endif} if not FileExists(FFileName) then begin debugln('Error, request to import nonexisting file : ' + FFileName); exit; end; if GetTitleFromFFN(FFileName, false) = '' then begin debugln('Error, request to import invalid Note file : ' + FFileName); exit; end; if IDLooksOK(ExtractFileNameOnly(FFileName)) then FName := ExtractFileName(FFileName) else begin CreateGUID(GUID); FName := copy(GUIDToString(GUID), 2, 36) + '.note'; end; // debugln('About to copy ' + FFileName + ' to ' + FName); if CopyFile(FFileName, GetNotesDir() + FName) then begin if TheReindexProc = nil then // Defined in tb_utils, set in SearchUnit. CanSendMessage('REINDEX:' + FName) else TheReindexProc(FName, True); end else debugln('ERROR - failed to copy ' + FFileName + ' to ' + GetNotesDir() + FName); end; procedure Import_Text_MD_File(MD : boolean; FFName : string = ''); // ToDo : make this a function, ret F on error. // ) var FFileName : string; Importer : TImportNotes; begin if FFName <> '' then FFileName := FFName else if MD then FFileName := Application.GetOptionValue('m', 'import-md') else FFileName := Application.GetOptionValue('t', 'import-txt'); Importer := TImportNotes.Create; try try Importer.DestinationDir := GetNotesDir(); // might raise ENoNotesRepoException Importer.Mode := 'plaintext'; if MD then Importer.Mode := 'markdown'; Importer.FirstLineIsTitle := true; if Application.HasOption('f', 'title-fname') then Importer.FirstLineIsTitle := false; Importer.ImportName := FFileName; if Importer.Execute() = 0 then debugln(Importer.ErrorMsg) else // At this stage, we have a valid note in repo but not Indexed. if TheReindexProc = nil then begin // Defined in tb_utils, set in SearchUnit. CanSendMessage('REINDEX:'+ Importer.NewFileName) // eg REINDEX:48480CC5-EC3E-4AA0-8C83-62886DB291FD.note end else TheReindexProc(Importer.NewFileName, True); // If TheReindexProc then we have a GUI, show message there. except on //E: ENoNotesRepoException do begin E: Exception do begin debugln(E.Message); exit; end; end; finally Importer.Free; end; end; function ContinueToGUI() : boolean ; begin if CommandLineError() then exit(False); if Application.HasOption('v', 'version') then begin debugln('tomboy-ng version ' + Version_String); exit(False); end; if Application.HasOption('t', 'import-txt') then begin Import_Text_MD_File(false); exit(False); end; if Application.HasOption('m', 'import-md') then begin Import_Text_MD_File(true); exit(False); end; if Application.HasOption('n', 'import-note') then begin Import_Note(); exit(False); end; // Note that the useappind option is processed in the LPR file. if HaveCMDParam() then if SingleNoteName = '' then exit(False) // thats an error, more than one parameter else exit(True); // proceed in SNM // Looks like a normal startup if CanSendMessage('SHOWSEARCH') then exit(False); Result := true; end; initialization LongOpts := TStringArray.create( // a type, not an object, don't free. 'dark-theme', 'lang:', 'debug-log:', 'help', 'version', 'no-splash', 'debug-sync', 'debug-index', 'debug-spell', 'config-dir:', 'open-note:', 'save-exit', // -o for open also legal. save-exit is legecy 'import-txt:', 'import-md:', 'import-note:', // -t, -m -n respectivly 'title-fname', 'gnome3', 'useappind:'); // -g and gnome3 is legal but legacy, ignored. end. tomboy-ng_0.39-1/source/editbox.lrj0000644000175000017500000002004114551457644017103 0ustar dbannondbannon{"version":1,"strings":[ {"hash":153585165,"name":"teditboxform.caption","sourcebytes":[69,100,105,116,66,111,120,70,111,114,109],"value":"EditBoxForm"}, {"hash":124067209,"name":"teditboxform.label2.caption","sourcebytes":[82,101,97,100,32,79,110,108,121],"value":"Read Only"}, {"hash":201669571,"name":"teditboxform.label3.caption","sourcebytes":[84,104,105,115,32,110,111,116,101,32,104,97,115,32,98,101,101,110,32,99,104,97,110,103,101,100,32,98,121,32,116,104,101,32,83,121,110,99,32,80,114,111,99,101,115,115],"value":"This note has been changed by the Sync Process"}, {"hash":71601577,"name":"teditboxform.label4.caption","sourcebytes":[80,108,101,97,115,101,32,99,108,111,115,101,32,105,116,32,40,97,110,100,32,114,101,45,111,112,101,110,32,105,102,32,105,116,32,119,97,115,32,97,32,100,111,119,110,108,111,97,100,41],"value":"Please close it (and re-open if it was a download)"}, {"hash":185126132,"name":"teditboxform.editfind.text","sourcebytes":[69,100,105,116,70,105,110,100],"value":"EditFind"}, {"hash":238044255,"name":"teditboxform.labelfindinfo.caption","sourcebytes":[76,97,98,101,108,70,105,110,100,73,110,102,111],"value":"LabelFindInfo"}, {"hash":88,"name":"teditboxform.labelfindcount.caption","sourcebytes":[88],"value":"X"}, {"hash":225175811,"name":"teditboxform.speedbuttonnotebook.hint","sourcebytes":[77,97,110,97,103,101,32,78,111,116,101,98,111,111,107,115],"value":"Manage Notebooks"}, {"hash":48553723,"name":"teditboxform.speedrollback.hint","sourcebytes":[82,111,108,108,32,66,97,99,107],"value":"Roll Back"}, {"hash":217489525,"name":"teditboxform.speedbuttondelete.hint","sourcebytes":[68,101,108,101,116,101,32,116,104,105,115,32,110,111,116,101],"value":"Delete this note"}, {"hash":242362684,"name":"teditboxform.speedbuttontools.hint","sourcebytes":[84,111,111,108,115,32,45,32,83,121,110,99,44,32,69,120,112,111,114,116,44,32,83,112,101,108,108],"value":"Tools - Sync, Export, Spell"}, {"hash":153225411,"name":"teditboxform.speedbuttontext.hint","sourcebytes":[70,111,110,116,32,115,105,122,101,44,32,98,111,108,100,44,32,105,116,97,108,105,99,115,32,101,116,99],"value":"Font size, bold, italics etc"}, {"hash":199403422,"name":"teditboxform.speedbuttonlink.hint","sourcebytes":[67,114,101,97,116,101,32,110,101,119,32,108,105,110,107,101,100,32,110,111,116,101,32,40,116,101,120,116,32,115,101,108,101,99,116,101,100,41,32,111,114,32,100,105,115,112,108,97,121,32,66,97,99,107,108,105,110,107,115,46],"value":"Create new linked note (text selected) or display Backlinks."}, {"hash":59715590,"name":"teditboxform.speedbuttonsearch.hint","sourcebytes":[83,101,97,114,99,104,32,65,108,108,32,78,111,116,101,115,32,67,116,114,108,45,83,104,105,102,116,45,70],"value":"Search All Notes Ctrl-Shift-F"}, {"hash":343125,"name":"teditboxform.buttmaintbmenu.caption","sourcebytes":[77,101,110,117],"value":"Menu"}, {"hash":4863637,"name":"teditboxform.speedclose.caption","sourcebytes":[67,108,111,115,101],"value":"Close"}, {"hash":134277820,"name":"teditboxform.speedsymbol.hint","sourcebytes":[73,110,115,101,114,116,32,101,120,116,101,110,100,101,100,32,99,104,97,114,97,99,116,101,114,32,111,114,32,115,121,109,98,111,108],"value":"Insert extended character or symbol"}, {"hash":30345779,"name":"teditboxform.panelbacklinks.caption","sourcebytes":[80,97,110,101,108,66,97,99,107,76,105,110,107,115],"value":"PanelBackLinks"}, {"hash":120032241,"name":"teditboxform.labelbacklinks.caption","sourcebytes":[108,97,98,101,108,49],"value":"label1"}, {"hash":300580,"name":"teditboxform.menubold.caption","sourcebytes":[66,111,108,100],"value":"Bold"}, {"hash":84574963,"name":"teditboxform.menuitalic.caption","sourcebytes":[73,116,97,108,105,99],"value":"Italic"}, {"hash":151125108,"name":"teditboxform.menustrikeout.caption","sourcebytes":[83,116,114,105,107,101,111,117,116],"value":"Strikeout"}, {"hash":234009348,"name":"teditboxform.menuhighlight.caption","sourcebytes":[72,105,103,104,108,105,103,104,116],"value":"Highlight"}, {"hash":101774616,"name":"teditboxform.menufixedwidth.caption","sourcebytes":[70,105,120,101,100,32,87,105,100,116,104],"value":"Fixed Width"}, {"hash":180974597,"name":"teditboxform.menuunderline.caption","sourcebytes":[85,110,100,101,114,108,105,110,101],"value":"Underline"}, {"hash":48330708,"name":"teditboxform.menusmall.caption","sourcebytes":[83,109,97,108,108,32,70,111,110,116],"value":"Small Font"}, {"hash":129088868,"name":"teditboxform.menunormal.caption","sourcebytes":[78,111,114,109,97,108,32,70,111,110,116],"value":"Normal Font"}, {"hash":225574612,"name":"teditboxform.menularge.caption","sourcebytes":[76,97,114,103,101,32,70,111,110,116],"value":"Large Font"}, {"hash":326613,"name":"teditboxform.menuhuge.caption","sourcebytes":[72,117,103,101],"value":"Huge"}, {"hash":204653243,"name":"teditboxform.menuitembulletright.caption","sourcebytes":[66,117,108,108,101,116,32,43],"value":"Bullet +"}, {"hash":204653245,"name":"teditboxform.menuitembulletleft.caption","sourcebytes":[66,117,108,108,101,116,32,45],"value":"Bullet -"}, {"hash":267343253,"name":"teditboxform.menuitemsync.caption","sourcebytes":[83,121,110,99,104,114,111,110,105,122,101],"value":"Synchronize"}, {"hash":213582195,"name":"teditboxform.menuitemsettings.caption","sourcebytes":[83,101,116,116,105,110,103,115],"value":"Settings"}, {"hash":80705172,"name":"teditboxform.menuitemexport.caption","sourcebytes":[69,120,112,111,114,116],"value":"Export"}, {"hash":110270710,"name":"teditboxform.menuitemexportrtf.caption","sourcebytes":[69,120,112,111,114,116,32,82,84,70],"value":"Export RTF"}, {"hash":120326628,"name":"teditboxform.menuitemexportplaintext.caption","sourcebytes":[69,120,112,111,114,116,32,80,108,97,105,110,32,84,101,120,116],"value":"Export Plain Text"}, {"hash":267951902,"name":"teditboxform.menuitemexportmarkdown.caption","sourcebytes":[69,120,112,111,114,116,32,77,97,114,107,100,111,119,110],"value":"Export Markdown"}, {"hash":110271478,"name":"teditboxform.menuitemexportpdf.caption","sourcebytes":[69,120,112,111,114,116,32,80,68,70],"value":"Export PDF"}, {"hash":5738580,"name":"teditboxform.menuitemprint.caption","sourcebytes":[80,114,105,110,116],"value":"Print"}, {"hash":236160955,"name":"teditboxform.menuitemspell.caption","sourcebytes":[83,112,101,108,108,32,67,104,101,99,107],"value":"Spell Check"}, {"hash":5262024,"name":"teditboxform.menuitemindex.caption","sourcebytes":[73,110,100,101,120],"value":"Index"}, {"hash":209960037,"name":"teditboxform.menuitemevaluate.caption","sourcebytes":[69,118,97,108,117,97,116,101],"value":"Evaluate"}, {"hash":85652432,"name":"teditboxform.menustayontop.caption","sourcebytes":[83,116,97,121,32,79,110,32,84,111,112],"value":"Stay On Top"}, {"hash":110774325,"name":"teditboxform.menuitemfind.caption","sourcebytes":[70,105,110,100,32,105,110,32,116,104,105,115,32,78,111,116,101],"value":"Find in this Note"}, {"hash":73728500,"name":"teditboxform.menufindnext.caption","sourcebytes":[70,105,110,100,32,78,101,120,116],"value":"Find Next"}, {"hash":73741766,"name":"teditboxform.menufindprev.caption","sourcebytes":[70,105,110,100,32,80,114,101,118],"value":"Find Prev"}, {"hash":19140,"name":"teditboxform.menuitemcut.caption","sourcebytes":[67,117,116],"value":"Cut"}, {"hash":304761,"name":"teditboxform.menuitemcopy.caption","sourcebytes":[67,111,112,121],"value":"Copy"}, {"hash":190022030,"name":"teditboxform.menuitemcopyplain.caption","sourcebytes":[67,111,112,121,32,80,108,97,105,110],"value":"Copy Plain"}, {"hash":5671589,"name":"teditboxform.menuitempaste.caption","sourcebytes":[80,97,115,116,101],"value":"Paste"}, {"hash":78392485,"name":"teditboxform.menuitemdelete.caption","sourcebytes":[68,101,108,101,116,101],"value":"Delete"}, {"hash":195288076,"name":"teditboxform.menuitemselectall.caption","sourcebytes":[83,101,108,101,99,116,32,65,108,108],"value":"Select All"}, {"hash":94435780,"name":"teditboxform.menuitem4.caption","sourcebytes":[77,101,110,117,73,116,101,109,52],"value":"MenuItem4"}, {"hash":94435781,"name":"teditboxform.menuitem5.caption","sourcebytes":[77,101,110,117,73,116,101,109,53],"value":"MenuItem5"}, {"hash":94435782,"name":"teditboxform.menuitem6.caption","sourcebytes":[77,101,110,117,73,116,101,109,54],"value":"MenuItem6"} ]} tomboy-ng_0.39-1/source/recover.pas0000644000175000017500000004772114551457644017124 0ustar dbannondbannonunit recover; { Copyright (C) 2017-2022 David Bannon License: This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html ------------------ } { History 2018/08/27 Now take config and local (sync) manifest with a snpshot, restore on the main 'Restore' tab. 2018/10/28 Much changes, now working reasonably well. 2018/10/29 Set attributes of Unzipped files on the Mac, it apparently leaves then 000 2018/11/05 Altered name of safety zip file 2019/05/19 Display strings all (?) moved to resourcestrings 2019/12/18 Allow user to move stringgrid colums and pin its bottom to form. 2020/05/19 Avoid var out of for loop problem in ButtonDeleteBadNotesClick() and TabSheetExistingShow() 2020/06/11 Ensure snapshot dir exists ..... 2020/06/11 Really Ensure snapshot dir exists, rename SnapDir FullSnapDir 2020/07/16 Extensive work to improve 'UI' sanity. 2020/07/16 cleanup unused constants 2020/08/21 Improve windows dark theme colours. 2022/11/09 Fixed a fail to delete Bad Note, day one bug ? } {$mode objfpc}{$H+} interface uses Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, ComCtrls, ExtCtrls, Grids, zipper{, Types}; type { TFormRecover } TFormRecover = class(TForm) ButtonRecoverSnap: TButton; ButtonSnapHelp: TButton; ButtonDeleteBadNotes: TButton; ButtonMakeSafetySnap: TButton; Label1: TLabel; Label10: TLabel; Label12: TLabel; Label14: TLabel; Label15: TLabel; Label16: TLabel; LabelExistingAdvice2: TLabel; LabelExistingAdvice: TLabel; LabelNoteErrors: TLabel; Label2: TLabel; Label3: TLabel; Label4: TLabel; Label5: TLabel; Label6: TLabel; Label7: TLabel; Label9: TLabel; ListBoxSnapshots: TListBox; PageControl1: TPageControl; Panel1: TPanel; PanelSnapshots: TPanel; PanelNoteList: TPanel; StringGridNotes: TStringGrid; TabSheetMergeSnapshot: TTabSheet; TabSheetRecoverSnapshot: TTabSheet; TabSheetRecoverNotes: TTabSheet; TabSheetIntro: TTabSheet; TabSheetBadNotes: TTabSheet; //procedure Button4Click(Sender: TObject); procedure ButtonMakeSafetySnapClick(Sender: TObject); procedure ButtonDeleteBadNotesClick(Sender: TObject); procedure ButtonRecoverSnapClick(Sender: TObject); procedure ButtonSnapHelpClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure FormShow(Sender: TObject); procedure ListBoxSnapshotsClick(Sender: TObject); procedure ListBoxSnapshotsDblClick(Sender: TObject); procedure StringGridNotesDblClick(Sender: TObject); procedure TabSheetBadNotesShow(Sender: TObject); procedure TabSheetIntroShow(Sender: TObject); procedure TabSheetMergeSnapshotShow(Sender: TObject); procedure TabSheetRecoverSnapshotShow(Sender: TObject); procedure TabSheetRecoverNotesShow(Sender: TObject); private procedure CleanAndUnzip(const FullDestDir, FullZipName: string); function ExpandZipName(AFileName: string): string; function FindSnapFiles(): integer; procedure RestoreSnapshot(const Snapshot: string); //procedure ScaleGridNotes(); procedure ShowNotes(const FullSnapName: string); function ZipDate(): string; procedure CreateSnapshot(const FullSourceDir, FullZipName: string); public // Note that, at present, this debugmode is not set automatically anywhere. DebugMode : boolean; RequiresIndex : boolean; FullSnapDir, NoteDir, ConfigDir : string; // Creates a snapshot, returning its full name. function CreateSnapshot(const Manual: boolean): string; procedure CleanUpSnapshots(const MaxSnaps : integer); end; var FormRecover: TFormRecover; implementation {$R *.lfm} { TFormRecover } uses LazFileUtils, Note_Lister, SearchUnit, process, LazLogger, {$ifdef DARWIN}baseunix,{$endif} // for fpChmod MainUnit, // just for MainUnit.MainForm.ShowHelpNote( ResourceStr; var SnapNoteLister : TNoteLister; procedure TFormRecover.FormShow(Sender: TObject); begin RequiresIndex := False; StringGridNotes.ColCount:=4; StringGridNotes.FixedCols:=0; //StringGridNotes.Options := [StringGridNotes.options] + [goThumbTracking]; // Label1.Caption := rsWeHaveSnapShots_1 + ' ' + inttostr(FindSnapFiles()) + ' ' + rsWeHaveSnapShots_2; Label1.Caption := format(rsWeHaveSnapShots, [FindSnapFiles()]); end; procedure TFormRecover.FormCreate(Sender: TObject); begin PageControl1.ActivePageIndex:=0; ButtonRecoverSnap.Enabled := False; Left := (Screen.Width - Width) div 2; Top := (Screen.Height - height) div 2; end; procedure TFormRecover.FormDestroy(Sender: TObject); begin //If SnapNoteLister <> Nil then FreeAndNil(SnapNoteLister); end; procedure TFormRecover.ButtonDeleteBadNotesClick(Sender: TObject); var I : integer = 1; Cnt : integer = 0; begin for I := 1 to StringGridNotes.RowCount-1 do begin // includes header showmessage('Delete ' + StringGridNotes.Cells[0, I]); DeleteFile(NoteDir + StringGridNotes.Cells[0, I]); Debugln('TFormRecover.ButtonDeleteBadNotesClick - ' + NoteDir + StringGridNotes.Cells[0, I]); inc(Cnt); end; //showmessage(rsDeletedDamaged_1 + ' ' + inttostr(CNT) + ' ' + rsDeletedDamaged_2 ); showmessage(format(rsDeletedDamaged, [CNT])); end; procedure TFormRecover.ButtonRecoverSnapClick(Sender: TObject); {var ZName : string; } begin if (ListBoxSnapshots.ItemIndex >= 0) and (ListBoxSnapshots.ItemIndex < ListBoxSnapshots.Count) then begin RestoreSnapshot(ListBoxSnapshots.Items[ListBoxSnapshots.ItemIndex]); //showmessage('I''d use [' + ZName + '] and put it all in [' + NoteDir); end; end; procedure TFormRecover.ButtonSnapHelpClick(Sender: TObject); begin // MainUnit.MainForm.ShowHelpNote('recover.note'); SearchForm.ShowHelpNote('recover.note'); end; procedure TFormRecover.ButtonMakeSafetySnapClick(Sender: TObject); begin CreateSnapshot(True); //CreateSnapShot(NoteDir, FullSnapDir + 'Safety.zip'); // abandonded idea of safety snapshot, too complicated //Label1.Caption := rsWeHaveSnapShots_1 + ' ' + inttostr(FindSnapFiles()) + ' ' + rsWeHaveSnapShots_2; Label1.Caption := format(rsWeHaveSnapShots, [FindSnapFiles()]); end; procedure TFormRecover.RestoreSnapshot(const Snapshot : string); begin {if mrYes <> QuestionDlg(rsDeleteAndReplace_1, rsDeleteAndReplace_2 + ' ' + NoteDir + ' ' + rsDeleteAndReplace_3 + ' ' + FormatDateTime( 'yyyy-mm-dd hh:mm', FileDateToDateTime(FileAge(FullSnapDir + Snapshot))) + ' ?' // + Snapshot + ' ' + DateTimeToStr(FileDateToDateTime(FileAge(FullSnapDir + Snapshot))) + ' ?' , mtConfirmation, [mrYes, mrNo], 0) then exit; } if mrYes <> QuestionDlg(rsDeleteAndReplace_1, format(rsDeleteAndReplace_2 , [NoteDir, FormatDateTime( 'yyyy-mm-dd hh:mm', FileDateToDateTime(FileAge(FullSnapDir + Snapshot)))]) , mtConfirmation, [mrYes, mrNo], 0) then exit; CleanAndUnzip(NoteDir, FullSnapDir + Snapshot); if FileExists(NoteDir + 'config' + PathDelim + 'tomboy-ng.cfg') then begin CopyFile(NoteDir + 'config' + PathDelim + 'tomboy-ng.cfg', ConfigDir + 'tomboy-ng.cfg'); DeleteFile(NoteDir + 'config' + PathDelim + 'tomboy-ng.cfg'); if FileExists(NoteDir + 'config' + PathDelim + 'manifest.xml') then begin CopyFile(NoteDir + 'config' + PathDelim + 'manifest.xml', ConfigDir + 'manifest.xml'); DeleteFile(NoteDir + 'config' + PathDelim + 'manifest.xml'); end; DeleteDirectory(NoteDir + 'config', False); end; showmessage(rsAllRestored); RequiresIndex := true; end; //RESOURCESTRING // rsNoSafetySnapshot = 'A Safety snapshot not found. Try setting Snapshot Dir to where you may have one.'; {procedure TFormRecover.Button4Click(Sender: TObject); begin if fileexists(FullSnapDir + 'Safety.zip') then RestoreSnapshot('Safety.zip') else showmessage(rsNoSafetySnapshot); end;} procedure TFormRecover.StringGridNotesDblClick(Sender: TObject); var NName : string; begin case PageControl1.ActivePageIndex of {0,} 1 : begin try NName := StringGridNotes.Cells[0, StringGridNotes.Row]; except on EGridException do exit; end; if length(NName) < 9 then exit; // empty returns ID.note from col(0) title // showmessage('We will open [' + NName + ']'); MainUnit.MainForm.SingleNoteMode(NoteDir + NName, False, False); end; 2, 3, 4 : begin try NName := StringGridNotes.Cells[3, StringGridNotes.Row]; except on EGridException do exit; // clicked outside valid area end; if length(NName) < 9 then exit; // showmessage('We will open ' + FullSnapDir + 'temp' + PathDelim + NName); MainUnit.MainForm.SingleNoteMode(FullSnapDir + 'temp' + PathDelim + NName, False, True); end; end; end; procedure TFormRecover.CleanAndUnzip(const FullDestDir, FullZipName : string); var ZipFile: TUnZipper; Info : TSearchRec; begin ForceDirectory(FullDestDir); if FindFirst(FullDestDir + '*.note', faAnyFile, Info)=0 then begin repeat if debugmode then Debugln('Deleting [' + FullDestDir + Info.Name + ']'); DeleteFileUTF8(FullDestDir + Info.Name); // should we test return value ? until FindNext(Info) <> 0; end; FindClose(Info); if FileExists(FullDestDir + 'config' + PathDelim + 'manifest.xml') then DeleteFile(FullDestDir + 'config' + PathDelim + 'manifest.xml'); if FileExists(FullDestDir + 'config' + PathDelim + 'tomboy-ng.cfg') then DeleteFile(FullDestDir + 'config' + PathDelim + 'tomboy-ng.cfg'); ZipFile := TUnZipper.Create; try ZipFile.FileName := FullZipName; ZipFile.OutputPath := FullDestDir; ZipFile.Examine; ZipFile.UnZipAllFiles; finally ZipFile.Free; end; {$ifdef Darwin} // paszlib, on mac, leaves files with no permissions ! if FindFirst(FullDestDir + '*.note', faAnyFile, Info)=0 then begin repeat fpChmod(FullDestDir + Info.Name, &644); // uses baseunix, should we test return value ? until FindNext(Info) <> 0; end; FindClose(Info); if FileExists(FullDestDir + 'config' + PathDelim + 'manifest.xml') then fpchmod(FullDestDir + 'config' + PathDelim + 'manifest.xml', &644); if FileExists(FullDestDir + 'config' + PathDelim + 'tomboy-ng.cfg') then fpchmod(FullDestDir + 'config' + PathDelim + 'tomboy-ng.cfg', &644); {$endif} end; function TFormRecover.ExpandZipName(AFileName : string) : string; var FName : string; begin // gets eg /somepath/20180826_2135_Sun.zip, 20180826_2135_Sun_Man.zip, 20180826_2135_Sun_Month.zip // 20200714_2004_Auto.zip FName := ExtractFileName(AFileName); if FName = 'Safety.zip' then Result := 'from Intro Tab' else begin Result := copy(FName, 1, 4) + '-' + copy(FName, 5, 2) + '-' + copy(FName, 7, 2); // year Month day Result := Result + ' ' + copy(FName, 10, 2) + ':' + copy(FName, 12, 2); // hour minutes Result := Result + ' ' + copy(FName, 15, 4); // end; end; // Unzips indicated snapshot, indexes its files and lists them in the StringGridNotes procedure TFormRecover.ShowNotes(const FullSnapName : string); begin PanelNoteList.Caption:=rsNotesInSnap +' ' + ExpandZipName(FullSnapName); ForceDirectory(FullSnapDir + 'temp'); CleanAndUnZip(FullSnapDir + 'temp' + PathDelim, FullSnapName); if SnapNoteLister <> Nil then FreeAndNil(SnapNoteLister); SnapNoteLister := TNoteLister.Create; SnapNoteLister.Debugmode := DebugMode; SnapNoteLister.WorkingDir:= FullSnapDir + 'temp' + PathDelim; {Result := }SnapNoteLister.IndexNotes(); SnapNoteLister.LoadStGrid(StringGridNotes, 4); // this must be a TStringGrid 'cos it can show very long lines such as xml errors StringGridNotes.Cells[0, 0] := 'Title'; StringGridNotes.Cells[1, 0] := 'Date'; StringGridNotes.Cells[2, 0] := 'Create'; StringGridNotes.Cells[3, 0] := 'Filename'; //StringGridNotes.Row[0] := ['Title', 'Date', 'Create', 'File']; // StringGridNotes.InsertRowWithValues(0, ['Title', 'Date', 'Create', 'File']); //StringGridNotes.SortOrder := soDescending; // Sort with most recent at top //StringGridNotes.SortColRow(True, 1); stringGridNotes.AutoSizeColumns; ButtonRecoverSnap.Enabled := True; end; function TFormRecover.ZipDate({WithDay : Boolean}) : string; var ThisMoment : TDateTime; begin ThisMoment:=Now; Result := FormatDateTime('YYYYMMDD',ThisMoment) + '_' + FormatDateTime('hhmm',ThisMoment); //if WithDay then Result := Result + '_' + FormatDateTime('ddd', ThisMoment); end; function TFormRecover.CreateSnapshot(const Manual : boolean) : string; var ZipName : string; begin if Manual then ZipName := ZipDate() + '_Man' else ZipName := ZipDate() + '_Auto'; if not DirectoryExists(FullSnapDir) then begin createDir(FullSnapDir); if not DirectoryExists(FullSnapDir) then begin Showmessage('Cannot create ' + FullSnapDir); exit(''); end; end; CreateSnapshot(NoteDir, FullSnapDir + ZipName + '.zip'); result := FullSnapDir + ZipName + '.zip'; end; procedure TFormRecover.CreateSnapshot(const FullSourceDir, FullZipName: string); var Zip : TZipper; Info : TSearchRec; // Tick, Tock : QWord; begin //debugln('--------- Config = ' + ConfigDir); Zip := TZipper.Create; try Zip.FileName := FullZipName; // Tick := GetTickCount64(); if FindFirst(FullSourceDir + '*.note', faAnyFile, Info)=0 then begin repeat // debugln('Zipping note [' + FullSourceDir + Info.Name + ']'); Zip.Entries.AddFileEntry(FullSourceDir + Info.Name, Info.Name); until FindNext(Info) <> 0; if FileExists(ConfigDir + 'tomboy-ng.cfg') then Zip.Entries.AddFileEntry(ConfigDir + 'tomboy-ng.cfg', 'config' + PathDelim + 'tomboy-ng.cfg') else Debugln('ERROR - cannot locate ' + ConfigDir + 'tomboy-ng.cfg'); if FileExists(ConfigDir + 'manifest.xml') then Zip.Entries.AddFileEntry(ConfigDir + 'manifest.xml', 'config' + PathDelim + 'manifest.xml') else if DebugMode then debugln('NOTE : Local Manifest not found ' + ConfigDir + 'manifest.xml'); Zip.ZipAllFiles; end; //Tock := GetTickCount64(); // 150mS, 120 notes on lowend laptop finally FindClose(Info); Zip.Free; end; // debugln('All notes in ' + FullSourceDir + ' to ' + FullZipName + ' took ' + inttostr(Tock - Tick) + 'ms'); end; { Removes any more than MaxSnaps Auto generated from the snaps dir. Does not play with Manually generated ones. } procedure TFormRecover.CleanUpSnapshots(const MaxSnaps: integer); var Snaps : TStringList; ToRemoveFromList : integer; St : string; begin Snaps := FindAllFiles(FullSnapDir, '*_Auto.zip', false); // list contains full file names ! try // debugln('RECOVER - CleanUpSnapshots() we have numb snapshots = ' + dbgs(Snaps.Count)); Snaps.Sort; ToRemoveFromList := MaxSnaps; while (ToRemoveFromList > 0) and (Snaps.Count <> 0) do begin Snaps.Delete(Snaps.Count-1); dec(ToRemoveFromList); end; for St in Snaps do begin // debugln('Deleting snap item ' + St); DeleteFile(St); end; finally freeandnil(Snaps); end; end; procedure TFormRecover.ListBoxSnapshotsDblClick(Sender: TObject); begin if (ListBoxSnapshots.ItemIndex >= 0) and (ListBoxSnapshots.ItemIndex < ListBoxSnapshots.Count) then begin ShowNotes(FullSnapDir + ListBoxSnapshots.Items[ListBoxSnapshots.ItemIndex]); end; end; procedure TFormRecover.ListBoxSnapshotsClick(Sender: TObject); begin if (ListBoxSnapshots.ItemIndex >= 0) and (ListBoxSnapshots.ItemIndex < ListBoxSnapshots.Count) then begin ShowNotes(FullSnapDir + ListBoxSnapshots.Items[ListBoxSnapshots.ItemIndex]); end; end; procedure TFormRecover.TabSheetBadNotesShow(Sender: TObject); var I, Comma : integer; Msg : string; begin //showmessage('Existing Show'); StringGridNotes.Visible := True; StringGridNotes.Enabled := True; with StringGridNotes do while RowCount > 1 do DeleteRow(RowCount-1); ButtonDeleteBadNotes.Enabled := False; ListBoxSnapshots.ItemIndex:= -1; ListBoxSnapShots.Enabled:=False; PanelNoteList.Caption:=rsClickBadNote; // LabelNoteErrors.Caption := rsBadNotes_1 + ' ' + inttostr(SearchForm.NoteLister.ErrorNotes.Count) + ' ' + rsBadNotes_2; LabelNoteErrors.Caption := format(rsBadNotes, [TheMainNoteLister.ErrorNotes.Count]); LabelExistingAdvice2.Caption := ''; LabelExistingAdvice.Caption := ''; if TheMainNoteLister.ErrorNotes.Count <> 0 then begin LabelExistingAdvice.Caption := rsTryRecover_1; LabelExistingAdvice2.Caption := rsTryrecover_2; end; StringGridNotes.Clear; StringGridNotes.FixedRows := 0; StringGridNotes.InsertRowWithValues(0, ['ID', 'ErrorMessage']); StringGridNotes.FixedRows := 1; for I := 0 to TheMainNoteLister.ErrorNotes.Count -1 do begin Msg := TheMainNoteLister.ErrorNotes.Strings[I]; Comma := pos(',', Msg); StringGridNotes.InsertRowWithValues(I + 1, [copy(Msg, 1, Comma-1), copy(Msg, Comma+1, 200)]); // copy(Msg, 1, Comma-1) = simple file name // copy(Msg, Comma+1, 200) = error messages, may be quite long. end; StringGridNotes.AutoSizeColumns; if {I} TheMainNoteLister.ErrorNotes.Count > 0 then ButtonDeleteBadNotes.Enabled:= True; end; procedure TFormRecover.TabSheetIntroShow(Sender: TObject); begin ListBoxSnapShots.Enabled := False; StringGridNotes.Visible := false; ListBoxSnapshots.ItemIndex:= -1; end; procedure TFormRecover.TabSheetMergeSnapshotShow(Sender: TObject); begin ListBoxSnapShots.Enabled:=True; // this tab is not used, probably will not ever be. But it has a count so be careful removing it end; procedure TFormRecover.TabSheetRecoverSnapshotShow(Sender: TObject); begin ListBoxSnapShots.Enabled:=True; ListBoxSnapshots.ItemIndex:= -1; with StringGridNotes do while RowCount > 1 do DeleteRow(RowCount-1); PanelNoteList.Caption:= rsClickSnapShot; StringGridNotes.Visible := True; StringGridNotes.Enabled := True; ButtonRecoverSnap.Enabled := (ListBoxSnapshots.ItemIndex >= 0) and (ListBoxSnapshots.ItemIndex < ListBoxSnapshots.Count); end; procedure TFormRecover.TabSheetRecoverNotesShow(Sender: TObject); begin with StringGridNotes do while RowCount > 1 do DeleteRow(RowCount-1); StringGridNotes.Visible := True; StringGridNotes.Enabled := True; PanelNoteList.Caption:=rsClickSnapShot; ListBoxSnapShots.Enabled:=True; ListBoxSnapshots.ItemIndex:= -1; end; function TFormRecover.FindSnapFiles() : integer; var Info : TSearchRec; begin ListBoxSnapshots.Clear; Result := 0; if FindFirst(FullSnapDir + '*.zip', faAnyFile and faDirectory, Info)=0 then begin repeat ListBoxSnapshots.AddItem(Info.Name, nil); inc(Result); until FindNext(Info) <> 0; end; FindClose(Info); end; end. tomboy-ng_0.39-1/source/Tomboy_NG.res0000644000175000017500000002636414551457644017322 0ustar dbannondbannon   True false 0MAINICON00 %% (0` $ddo o o+p{  to)o o  po oKy   ~oGop     rooo\|    oXooq    sooon   oloo+s %**#uo)oo  9VGJHGM/ o~oo9v  -I?:53.*$)!wo7o o  3'$##%%$$#%#&- po oIy  +2,-/137679:~:x;s;l8j<{&zoFop  LT_hfU?& $.9< qo os 3_XVXRt}iR::FD=;A, usL PX[Z]__]d{PILH@@<:9wg  3WW]^bdffdb^i\TTSMLJB>633*  LRX[]aaeiijfggb```\YYURMJC>;72..  3QNRWaagdhjjlnmjljdaba^XVQLFA=55-&%% DILPWZ^ecijnnpvsnrolifa`ZUPLIB>83+)"!'  /@BJOQW\]fkgkssrquqronlfc_]WRNHB@55-+$!!!/ 7:?ENNUZ]^eiiomvsuuttpnlhc^^TSLKA?93.+&! S"249AELPRY]adjjnnrqkjjjrnjhd\ZUQNICC:50)!2*&.8>?EJNVY]cbiikhe\VQVbkomjh_[[TQHE?74)&`a814>?BLQRW]`ba`_UOSZNPJ|Fmylhdd`ZWSRJF>=)<@A^m_TS`}pc`a]_[S>]ztlg\^?hς==Rr`D}Y]qcaa[\ZXKEztlg_\v ~6||}Hhv[LRd}dZY[ZYXUAhyrmg^[q/~ymHwX[q~mVWYUVVRFHyske^[gu5,8.[`Y||}cSfy||SNTSUSUL=lzrkd_W^†#=2 7+_Wmlljjjunvx{gT[JOOP>Jwrld^VZsa@5B7@3rvyOC8o}xrkc^WSbE8#G:`TNGb}xqjc\WQV~NOA~PBu󹹹 ~pid[UNNdTGVH]THqf08pZV]a3fLVH55tomboy-ng_0.39-1/source/searchunit.lfm0000644000175000017500000003037414551457644017613 0ustar dbannondbannonobject SearchForm: TSearchForm Left = 466 Height = 401 Top = 347 Width = 794 ActiveControl = EditSearch Caption = 'tomboy-ng_Search' ClientHeight = 401 ClientWidth = 794 OnActivate = FormActivate OnCloseQuery = FormCloseQuery OnCreate = FormCreate OnDeactivate = FormDeactivate OnDestroy = FormDestroy OnHide = FormHide OnKeyDown = FormKeyDown OnResize = FormResize OnShow = FormShow LCLVersion = '3.0.0.3' object EditSearch: TEdit AnchorSideLeft.Control = BitBtnMenu AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = Owner AnchorSideBottom.Control = Panel1 Left = 144 Height = 32 Top = 0 Width = 148 Anchors = [akTop, akLeft, akBottom] BorderSpacing.Left = 2 ParentShowHint = False ShowHint = True TabOrder = 3 OnChange = EditSearchChange OnEnter = EditSearchEnter OnKeyDown = FormKeyDown OnKeyUp = EditSearchKeyUp end object Panel1: TPanel AnchorSideLeft.Control = Owner AnchorSideTop.Side = asrBottom AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = StatusBar1 Left = 0 Height = 345 Top = 33 Width = 794 Anchors = [akTop, akLeft, akRight, akBottom] BorderSpacing.Top = 1 Caption = 'Panel1' ClientHeight = 345 ClientWidth = 794 TabOrder = 0 object Splitter1: TSplitter AnchorSideTop.Control = Panel1 AnchorSideBottom.Control = Panel1 AnchorSideBottom.Side = asrBottom Left = 224 Height = 343 Top = 1 Width = 5 Align = alNone Anchors = [akTop, akBottom] end object ButtonClearFilters: TButton AnchorSideLeft.Control = Panel1 AnchorSideTop.Control = Panel1 AnchorSideRight.Control = Splitter1 Left = 1 Height = 32 Top = 1 Width = 223 Anchors = [akTop, akLeft, akRight] Caption = 'Clear' Enabled = False TabOrder = 2 OnClick = ButtonClearFiltersClick OnKeyDown = FormKeyDown end object ListBoxNotebooks: TListBox AnchorSideLeft.Control = ButtonClearFilters AnchorSideTop.Control = Panel2 AnchorSideTop.Side = asrBottom AnchorSideRight.Control = Splitter1 AnchorSideBottom.Control = Panel1 AnchorSideBottom.Side = asrBottom Left = 1 Height = 280 Hint = 'Right Click to manage Notebooks' Top = 64 Width = 223 Anchors = [akTop, akLeft, akRight, akBottom] ExtendedSelect = False ItemHeight = 0 ParentShowHint = False ScrollWidth = 230 ShowHint = True Sorted = True TabOrder = 3 TopIndex = -1 OnClick = ListBoxNotebooksClick OnKeyPress = ListViewNotesKeyPress OnKeyDown = FormKeyDown OnMouseUp = ListBoxNotebooksMouseUp end object Panel2: TPanel AnchorSideLeft.Control = ButtonClearFilters AnchorSideTop.Control = ButtonClearFilters AnchorSideTop.Side = asrBottom AnchorSideRight.Control = Splitter1 Left = 1 Height = 31 Top = 33 Width = 223 Anchors = [akTop, akLeft, akRight] Caption = 'Notebooks' TabOrder = 4 end object ListViewNotes: TListView AnchorSideLeft.Control = Splitter1 AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = Panel1 AnchorSideRight.Control = Panel1 AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = Panel1 AnchorSideBottom.Side = asrBottom Left = 232 Height = 343 Top = 1 Width = 561 Anchors = [akTop, akLeft, akRight, akBottom] AutoSortIndicator = True AutoWidthLastColumn = True BorderSpacing.Left = 3 Columns = < item end item Width = 530 end item Width = 1 end> HideSelection = False ParentShowHint = False ReadOnly = True RowSelect = True ScrollBars = ssVertical SortColumn = 1 SortType = stText TabOrder = 0 ViewStyle = vsReport OnColumnClick = ListViewNotesColumnClick OnData = ListViewNotesData OnDblClick = ListViewNotesDblClick OnDrawItem = ListViewNotesDrawItem OnKeyDown = FormKeyDown OnKeyPress = ListViewNotesKeyPress end end object StatusBar1: TStatusBar Left = 0 Height = 23 Top = 378 Width = 794 Panels = < item Width = 200 end item Alignment = taRightJustify Width = 500 end> SimplePanel = False end object ButtonClearSearch: TButton AnchorSideLeft.Control = EditSearch AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = Owner AnchorSideBottom.Control = Panel1 Left = 294 Height = 32 Top = 0 Width = 99 Anchors = [akTop, akLeft, akBottom] BorderSpacing.Left = 2 Caption = 'Clear' TabOrder = 4 OnClick = ButtonClearSearchClick end object BitBtnMenu: TBitBtn AnchorSideLeft.Control = Owner AnchorSideTop.Control = Owner AnchorSideBottom.Control = Panel1 Left = 2 Height = 32 Top = 0 Width = 140 Anchors = [akTop, akLeft, akBottom] BorderSpacing.Left = 2 Caption = 'Menu' Glyph.Data = { 36090000424D3609000000000000360000002800000018000000180000000100 2000000000000009000064000000640000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000003232 3238333333050000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00000000000000000000000000000000000000000000000000002E2E2E163636 36F93C3C3CF0393939863737371C000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00000000000000000000000000000000000000000000000000003737377D8080 80F6DEDEDEFF727272FA3A3A3ADC000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00000000000000000000000000003434348D34343440555555033D3D3DEBD9D9 D9FFFFFFFFFF777777F536363672000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00000000000000000000000000003E3E3EEB464646F53B3B3BEB595959F2FFFF FFFFEEEEEEFF3A3A3AF630303010000000000000000000000000000000000000 000000000000000000004D4D4DFF4D4D4DFF4D4D4DFF4D4D4DFF4D4D4DFF4D4D 4DFF4D4D4DFF4D4D4DFF4D4D4DFF3E3E3EFFE8E8E8FFCDCDCDFFCECECEFFFFFF FFFF9E9E9EFC3E3E3EB100000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFF474747FFEAEAEAFFFFFFFFFFFFFFFFFFFFFF FFFFACACACFC434343F5404040D0323232510000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFF454545FFEDEDEDFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFCFCFCFFF383838F9323232420000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFF000000FF000000FF000000FF0000 00FF000000FFFFFFFFFFFFFFFFFF414141FFF0F0F0FFFFFFFFFFFFFFFFFFFFFF FFFFD8D8D8FF3E3E3EF43333334B000000000000000000000000000000000000 000000000000000000004D4D4DFFFAFAFAFFFAFAFAFFFAFAFAFFFAFAFAFFFAFA FAFFFAFAFAFFFAFAFAFFFAFAFAFF3F3F3FFFF2F2F2FFFFFFFFFFFFFFFFFFD9D9 D9FF3E3E3EF53434344E00000000000000000000000000000000000000000000 000000000000000000004D4D4DFF4D4D4DFF4D4D4DFF4D4D4DFF4D4D4DFF4D4D 4DFF4D4D4DFF4D4D4DFF4D4D4DFF383838FFF5F5F5FFFFFFFFFFDBDBDBFF3E3E 3EF6353535570000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFAFAFAFFFAFAFAFFFAFAFAFFFAFAFAFFFAFA FAFFFAFAFAFFFAFAFAFFFAFAFAFF3A3A3AFFF8F8F8FFE0E0E0FF424242F53636 365A000000000000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFF000000FF000000FF000000FF0000 00FF000000FFFFFFFFFFFFFFFFFF383838FFDDDDDDFF424242FF3636365E0000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFF363636FF494949FF454545FF000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFF000000FF000000FF000000FF0000 00FFFFFFFFFFFFFFFFFFFFFFFFFF353535FFAEAEAEFF4D4D4DFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFDFDFDFFA9A9A9FFFFFFFFFF4D4D4DFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFF000000FF000000FF000000FF0000 00FF000000FF000000FFFFFFFFFFFFFFFFFFFFFFFFFF4D4D4DFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF4D4D4DFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFF000000FF000000FF000000FF0000 00FF000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF4D4D4DFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF4D4D4DFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFF4D4D4DFF4D4D4DFF4D4D4DFF4D4D4DFF4D4D 4DFF4D4D4DFF4D4D4DFF4D4D4DFF4D4D4DFF4D4D4DFF4D4D4DFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000 } OnClick = BitBtnMenuClick TabOrder = 1 end object ButtonSearchOptions: TButton AnchorSideTop.Control = Owner AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = Panel1 Left = 648 Height = 32 Top = 0 Width = 144 Anchors = [akTop, akRight, akBottom] BorderSpacing.Right = 2 Caption = 'Options' TabOrder = 5 OnClick = ButtonSearchOptionsClick end object SelectDirectoryDialog1: TSelectDirectoryDialog Left = 344 Top = 72 end object PopupMenuNotebook: TPopupMenu Left = 560 Top = 72 object MenuEditNotebookTemplate: TMenuItem Caption = 'Edit Notebook Template' OnClick = MenuEditNotebookTemplateClick end object MenuDeleteNotebook: TMenuItem Caption = 'Delete Notebook' OnClick = MenuDeleteNotebookClick end object MenuRenameNoteBook: TMenuItem Caption = 'Rename Notebook' OnClick = MenuRenameNoteBookClick end object MenuNewNoteFromTemplate: TMenuItem Caption = 'Create New Note from Template' OnClick = MenuNewNoteFromTemplateClick end object MenuItemManageNBook: TMenuItem Caption = 'Manage Notes in Notebook' OnClick = MenuItemManageNBookClick end object MenuItem3: TMenuItem Caption = '-' end object MenuCreateNoteBook: TMenuItem Caption = 'Create new Notebook' OnClick = MenuCreateNoteBookClick end end object PopupMenuSearchOptions: TPopupMenu Left = 450 Top = 206 object MenuItemImportNote: TMenuItem Caption = 'Import File' OnClick = MenuItemImportNoteClick end object MenuItemCaseSensitive: TMenuItem Caption = 'Case Sensitive' OnClick = MenuItemCaseSensitiveClick end object MenuItemSWYT: TMenuItem Caption = 'Search While You Type' OnClick = MenuItemSWYTClick end end object OpenDialogImport: TOpenDialog Left = 346 Top = 171 end end tomboy-ng_0.39-1/source/Tomboy_NG.ico0000644000175000017500000002267614551457644017305 0ustar dbannondbannon00 %(0` $ddo o o+p{  to)o o  po oKy   ~oGop     rooo\|    oXooq    sooon   oloo+s %**#uo)oo  9VGJHGM/ o~oo9v  -I?:53.*$)!wo7o o  3'$##%%$$#%#&- po oIy  +2,-/137679:~:x;s;l8j<{&zoFop  LT_hfU?& $.9< qo os 3_XVXRt}iR::FD=;A, usL PX[Z]__]d{PILH@@<:9wg  3WW]^bdffdb^i\TTSMLJB>633*  LRX[]aaeiijfggb```\YYURMJC>;72..  3QNRWaagdhjjlnmjljdaba^XVQLFA=55-&%% DILPWZ^ecijnnpvsnrolifa`ZUPLIB>83+)"!'  /@BJOQW\]fkgkssrquqronlfc_]WRNHB@55-+$!!!/ 7:?ENNUZ]^eiiomvsuuttpnlhc^^TSLKA?93.+&! S"249AELPRY]adjjnnrqkjjjrnjhd\ZUQNICC:50)!2*&.8>?EJNVY]cbiikhe\VQVbkomjh_[[TQHE?74)&`a814>?BLQRW]`ba`_UOSZNPJ|Fmylhdd`ZWSRJF>=)<@A^m_TS`}pc`a]_[S>]ztlg\^?hς==Rr`D}Y]qcaa[\ZXKEztlg_\v ~6||}Hhv[LRd}dZY[ZYXUAhyrmg^[q/~ymHwX[q~mVWYUVVRFHyske^[gu5,8.[`Y||}cSfy||SNTSUSUL=lzrkd_W^†#=2 7+_Wmlljjjunvx{gT[JOOP>Jwrld^VZsa@5B7@3rvyOC8o}xrkc^WSbE8#G:`TNGb}xqjc\WQV~NOA~PBu󹹹 ~pid[UNNdTGVH]THqf08pZV]a3fLVH55tomboy-ng_0.39-1/source/backupview.lrj0000644000175000017500000000357614551457644017623 0ustar dbannondbannon{"version":1,"strings":[ {"hash":34251059,"name":"tformbackupview.caption","sourcebytes":[86,105,101,119,44,32,114,101,99,111,118,101,114,32,111,114,32,100,101,108,101,116,101,32,66,97,99,107,117,112,32,70,105,108,101,115],"value":"View, recover or delete Backup Files"}, {"hash":10435829,"name":"tformbackupview.buttonopen.hint","sourcebytes":[79,112,101,110,32,97,110,100,32,118,105,101,119,32,116,104,101,32,119,104,111,108,101,32,110,111,116,101],"value":"Open and view the whole note"}, {"hash":380871,"name":"tformbackupview.buttonopen.caption","sourcebytes":[86,105,101,119],"value":"View"}, {"hash":19305231,"name":"tformbackupview.buttonrecover.hint","sourcebytes":[82,101,115,116,111,114,101,32,116,104,105,115,32,110,111,116,101,32,116,111,32,109,97,105,110,32,114,101,112,111],"value":"Restore this note to main repo"}, {"hash":146435218,"name":"tformbackupview.buttonrecover.caption","sourcebytes":[82,101,99,111,118,101,114],"value":"Recover"}, {"hash":120709198,"name":"tformbackupview.buttondelete.hint","sourcebytes":[82,101,97,108,108,121,44,32,116,111,116,97,108,108,121,32,100,101,108,101,116,101,32,116,104,105,115,32,110,111,116,101,46],"value":"Really, totally delete this note."}, {"hash":78392485,"name":"tformbackupview.buttondelete.caption","sourcebytes":[68,101,108,101,116,101],"value":"Delete"}, {"hash":205911214,"name":"tformbackupview.buttonok.hint","sourcebytes":[77,121,32,119,111,114,107,32,104,101,114,101,32,105,115,32,100,111,110,101,46],"value":"My work here is done."}, {"hash":4863637,"name":"tformbackupview.buttonok.caption","sourcebytes":[67,108,111,115,101],"value":"Close"}, {"hash":60010147,"name":"tformbackupview.listbox1.hint","sourcebytes":[85,115,101,32,67,116,114,108,32,111,114,32,83,104,105,102,116,32,116,111,32,115,101,108,101,99,116,32,109,117,108,116,105,112,108,101,32,101,110,116,114,105,101,115],"value":"Use Ctrl or Shift to select multiple entries"} ]} tomboy-ng_0.39-1/source/backlinks.lrj0000644000175000017500000000062114551457644017410 0ustar dbannondbannon{"version":1,"strings":[ {"hash":81999685,"name":"tformbacklinks.caption","sourcebytes":[76,105,110,107,101,100,32,116,111,32,116,104,105,115,32,110,111,116,101],"value":"Linked to this note"}, {"hash":141286446,"name":"tformbacklinks.label1.caption","sourcebytes":[78,111,32,111,116,104,101,114,32,110,111,116,101,115,32,108,105,110,107,32,104,101,114,101,46],"value":"No other notes link here."} ]} tomboy-ng_0.39-1/source/settings.pas0000644000175000017500000031634214551457644017315 0ustar dbannondbannonunit settings; { Copyright (C) 2017-2020 David Bannon License: This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html ------------------ This form represents all the settings and will have most (?) of the constants. Makes sense for all units to 'use' this unit, ideally in the implmentation section. Launcher for Sync Engines, Backup, Snapshot RollBack systems. } { HISTORY 2017/9/27 - Created 2017/10/10 - added ability to set fonts to small, medium and big 2017/10/15 - gave the setting form Tabs, lot less cluttered. 2017/11/25 - added a button to notes path config to use the 'default' path that is, similar to what tomboy does. Code to make that path. 2017/11/28 - put a ; after a line of windows only code. 2017/12/08 - changed size of Mediun normal font, one size smaller 2017/12/28 - extensive changes so this form is now Main form. This is because Cocoa cannot handle Hide() in main form OnShow event. This makes more sense anyway. 2017/12/28 - Small change to force a Note Directory if user browses away from Settings screen that urges them to set it first ! Sigh... 2017/12/29 Further force of a Note Directory. 2017/12/30 We now set Search box lablepath after setting up a NotesPath Added a caption to tell user we are setting up sync. 2017/12/30 Added a call to IndexNotes after setting up sync, potentially slow. 2018/01/25 Changes to support Notebooks 2018/02/04 Added a Main menu because Macs work better with one. 2018/02/09 Added a means save export path but only until app exits, not saved to disk. 2018/02/14 Added check boxes to control search box 2018/02/23 Added capabily to configure spell check. 2018/03/18 Added a close button (really a hide button) and an ifdef to close on the Mac when ever asked to do so. Have disabled close icon but seems it still works on Linux but not mac, so thats OK (but funny). Issue #25 relates, untested. 2018/03/24 Added some checks to make sure spell libary and dictionary mentioned in config file is still valid. 2018/05/12 Extensive changes - MainUnit is now just that. 2018/05/20 NeedRefresh to indicate when need to refresh menus and mainform status. 2018/05/23 Added /usr/share/myspell/ to linux dictionary search path. Enabled Save button after dictionary selection. 2018/06/06 Substantial changes. Now create config dir at form creation. User no longer manually saves, config file is updated at each change. Extensive checks of config and notes directory before proceeding. 2018/06/14 Moved call to CheckSpelling() from OnShow to OnCreate. Select MediumFont in default settings. 2018/07/22 Removed an errant editbox that somehow appeared over small font button. 2018/08/18 Now call SpellCheck() after loading settings. Note, if settings file has an old library name and hunspell can find a new one, nothing is updated ! 2018/08/23 Ensured that an ini file without a notedir returns a sensible value, TEST 2018/10/28 Much changes, support Backup management, snapshots and new sync Model. 2018/11/01 Ensure we have a valid Spell, even after a hide ! 2018/11/05 Set default tab. 2018/11/29 Change Spelling UI when selecting Library and Dictionary 2018/12/03 Added show splash screen to settings, -g or an indexing error will force show 2018/12/03 disable checkshowTomdroid on all except Linux 2019/03/19 Added setting option to show search box at startup 2019/04/07 Restructured Main and Popup menus. Untested Win/Mac. 2019/04/13 Almost rid of NeedRefresh, SearchForm.IndexNotes() instead. 2019/04/27 Fix for Huge display font. 2019/05/06 Support saving pos and open on startup in note. 2019/05/14 Display strings all (?) moved to resourcestrings 2019/06/11 Moved some checkboxes and renamed 'Display' to 'Notes'. 2019/09/6 Button to download Help Notes in non-English 2019/09/07 User can now select a note font. 2019/12/18 Moved LinkScanRange to EditBox 2019/12/20 Ensure we have UsualFont set to something even during first start. 2019/12/24 Ensure we don't try to sync if its not yet setup. 2020/03/02 Force our guess fixed font if no config file. 2020/03/08 Don't call search refreshMenu(mkFileMenu after an initial sync, no need 2020/03/30 Added code to allow user to set display colours. 2020/04/07 As well as forcing Linux AltHelpNotes into config dir, must also do Windows ! 2020/04/08 Added some code to support SyncNextCloud, see define SHOW_NET_SYNC top of implementation section. 2020/04/10 Added Net and File sync mode to settings file, make labels consistent 2020/04/28 Put four random digits in place of the '0000' in GetLocalTime() 2020/04/04 Don't run autosync in singlenote mode. 2020/05/11 Moved all handling of the backup files to BackupView 2020/06/11 check if snapshot ok before flushing old ones. 2020/06/18 Ensure a default config file is written asap at first start. 2020/06/18 Removed unnecessary panel on Snap tab 2020/07/09 New help notes location. 2020/07/16 Drop Backup tab, merge to Snapshot tab, renamed 'Recover' 2020/07/24 Moved HELP notes from /usr/share/doc/tomboy-ng to /usr/share/tomboy-ng to suit debian 2020/08/01 Show better labels in HelpLangCombo. 2021/01/23 Save Search Auto Refresh check box status. 2021/04/24 Added setting to enable/disable undo/redo 2021/05/01 Remove HaveConfig and restructured config startup 2021/06/01 Add setting to disable Notifications 2021/09/27 Allow both File and Github sync, maybe its a good idea ?? SelectiveSync. 2021/10/06 Restructured the way we enter GH Token, all copy and paste now. 2021/10/26 User selectable date stamp format 2021/12/03 Rearranged checkboxes to accomodate Searching While u Wait. 2022/01/21 GTK3 determines what is a monospace font differently. 2022/01/31 Added a CheckFindToggles to determine if every press of Ctrl-f invokes Find or toggles it on or off. 2022/03/31 Tidyed up the Github Token controls, now can invoke browser. 2022/09/02 Removed AutoRefreshSearch checkbox, its the SearchUnit's problem. 2022/10/21 CheckAutoStart must call its own method to trigger writing files 2023/01/14 Save Auto Snapshot settings 2023/02/21 Drop Monospace font to last of priority, its not a real font. 2023/03/11 Make a bool to indicate Qt is in charge of its colours, eg QT_QPA_PLATFORMTHEME 2023/03/18 Ensure AltColour and AltBackGndColor are set to something in user defined scheme 2023/10/28 Restructure some of Auto Sync to allow multithreading, does not use SyncGUI 2023/10/29 Multithreaded sync appears to work. } {$mode objfpc}{$H+} // interface uses Classes, SysUtils, {FileUtil,} Forms, Controls, Graphics, Dialogs, StdCtrls, Buttons, ComCtrls, ExtCtrls, Menus, FileUtil, BackUpView, LCLIntf, Spin{, notifier}, base64, fpttf, LMessages, syncutils; // Types; type TSyncOption = (AlwaysAsk, UseServer, UseLocal); // Relating to sync clash pref in config file const WM_SYNCMESSAGES = LM_USER + 2100; // These are used by the auto sync to update user WM_SYNCNOTPOSSIBLE = LM_USER + 2101; WM_SYNCFINISHED = LM_USER + 2102; WM_SYNCERROR = LM_USER + 2103; WM_SYNCTIMEOUT = LM_USER + 2104; WM_SYNCCLASH = LM_USER + 2105; WM_SAVETIMEOUT = LM_USER + 2110; // Generated by threaded save system, still handled here. WM_SAVEERROR = LM_USER + 2111; WM_SAVEFINISHED = LM_USER + 2112; type { TSett } TSett = class(TForm) ButtonManualSnap: TButton; ButtonSetNotePath: TButton; ButtonShowBackUp: TButton; ButtonSnapRecover: TButton; CheckAutoSnapEnabled: TCheckBox; CheckEscClosesNote: TCheckBox; CheckFindToggles: TCheckBox; CheckStampBold: TCheckBox; CheckStampItalics: TCheckBox; CheckStampSmall: TCheckBox; CheckNotifications: TCheckBox; CheckUseUndo: TCheckBox; ComboSyncTiming: TComboBox; ComboDateFormat: TComboBox; ComboSyncType: TComboBox; ComboHelpLanguage: TComboBox; EditUserName: TEdit; GroupNotesPath: TGroupBox; GroupBoxUser: TGroupBox; GroupBoxToken: TGroupBox; GroupBoxSync: TGroupBox; Label10: TLabel; Label11: TLabel; Label16: TLabel; Label17: TLabel; LabelSyncTiming: TLabel; LabelSyncType: TLabel; Label5: TLabel; Label6: TLabel; Label7: TLabel; Label8: TLabel; Label9: TLabel; LabelSyncInfo2: TLabel; Label4: TLabel; LabelSyncInfo1: TLabel; LabelSyncRepo: TLabel; ButtonSetColours: TButton; ButtonFixedFont: TButton; ButtonFont: TButton; ButtonSetSpellLibrary: TButton; ButtonSetDictionary: TButton; CheckAutoStart : TCheckBox; CheckManyNotebooks: TCheckBox; CheckShowSearchAtStart: TCheckBox; CheckShowSplash: TCheckBox; CheckShowExtLinks: TCheckBox; CheckShowIntLinks: TCheckBox; FontDialog1: TFontDialog; GroupBox4: TGroupBox; GroupBox5: TGroupBox; Label1: TLabel; Label12: TLabel; Label13: TLabel; Label14: TLabel; Label15: TLabel; LabelDicPrompt: TLabel; LabelDic: TLabel; LabelError: TLabel; LabelLibrary: TLabel; LabelDicStatus: TLabel; LabelLibraryStatus: TLabel; Label2: TLabel; LabelNotesPath: TLabel; LabelSettingPath: TLabel; LabelSnapDir: TLabel; LabelToken: TLabel; ListBoxDic: TListBox; MenuItemGetToken: TMenuItem; MenuItemPasteToken: TMenuItem; MenuItemCopyToken: TMenuItem; OpenDialogLibrary: TOpenDialog; OpenDialogDictionary: TOpenDialog; PageControl1: TPageControl; Panel1: TPanel; Panel2: TPanel; Panel3: TPanel; PMenuMain: TPopupMenu; PopupMenuTokenActions: TPopupMenu; RadioAlwaysAsk: TRadioButton; RadioChoose: TRadioButton; RadioTomboyDefault: TRadioButton; RadioTomboyNGDefault: TRadioButton; RadioFontHuge: TRadioButton; RadioFontBig: TRadioButton; RadioFontMedium: TRadioButton; RadioFontSmall: TRadioButton; RadioUseLocal: TRadioButton; RadioUseServer: TRadioButton; SelectDirectoryDialog1: TSelectDirectoryDialog; SelectSnapDir: TSelectDirectoryDialog; SpeedButHide: TSpeedButton; SpeedButHelp: TSpeedButton; SpeedTokenActions: TSpeedButton; SpeedButtTBMenu: TSpeedButton; SpeedSetupSync: TSpeedButton; SpinDaysPerSnapshot: TSpinEdit; SpinMaxSnapshots: TSpinEdit; TabBasic: TTabSheet; TabBackUp: TTabSheet; TabSpell: TTabSheet; TabRecover: TTabSheet; TabSync: TTabSheet; TabDisplay: TTabSheet; TimerAutoSync: TTimer; procedure ButtonSetColoursClick(Sender: TObject); procedure ButtonFixedFontClick(Sender: TObject); procedure ButtonFontClick(Sender: TObject); procedure ButtonManualSnapClick(Sender: TObject); procedure ButtonSetDictionaryClick(Sender: TObject); procedure ButtonSetNotePathClick(Sender: TObject); procedure ButtonSetSnapDirClick(Sender: TObject); procedure ButtonSetSpellLibraryClick(Sender: TObject); procedure ButtonShowBackUpClick(Sender: TObject); procedure ButtonSnapRecoverClick(Sender: TObject); procedure CheckAutoSnapEnabledChange(Sender: TObject); procedure CheckAutostartChange(Sender: TObject); procedure ComboSyncTimingChange(Sender: TObject); procedure MenuItemCopyTokenClick(Sender: TObject); procedure MenuItemGetTokenClick(Sender: TObject); procedure MenuItemPasteTokenClick(Sender: TObject); procedure RadioNotePathChange(Sender: TObject); { Called when ANY of the setting check boxes change so we can save. } procedure SaveSettings(Sender: TObject); procedure ComboHelpLanguageChange(Sender: TObject); procedure ComboSyncTypeChange(Sender: TObject); procedure FormClose(Sender: TObject; var CloseAction: TCloseAction); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure FormHide(Sender: TObject); procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState ); procedure FormShow(Sender: TObject); procedure ListBoxDicClick(Sender: TObject); procedure PageControl1Change(Sender: TObject); procedure SpeedButHelpClick(Sender: TObject); procedure SpeedButHideClick(Sender: TObject); procedure SpeedButtTBMenuClick(Sender: TObject); procedure SpeedSetupSyncClick(Sender: TObject); procedure SpeedTokenActionsClick(Sender: TObject); procedure SpinDaysPerSnapshotChange(Sender: TObject); procedure TabBasicResize(Sender: TObject); procedure TabRecoverResize(Sender: TObject); procedure TabSpellResize(Sender: TObject); { Called every 10 minutes and might trigger a Sync or Snapshot depending on settings. } procedure TimerAutoSyncTimer(Sender: TObject); // Sets default colours, depending on dark or light theme // Called from MainForm.ShowForm procedure SetColours; private SyncTimingFileIndex, SyncTimingGithubIndex : integer; // Holds ComboBox index for each particular sync SyncTimingFileLast, SyncTimingGitHubLast : TDateTime; // The time the last indicated sync was run (manual or auto). { eg /run/user/1000/gvfs/smb-share=greybox,share=store2/TB_Sync/ Being non empty indicates it worked sometime, ie is Valid } SyncFileRepo : string; { eg https://github.com/davidbannon/tb_test, being not empty means it was, at one stage, valid} SyncGithubRepo : string; AutoRefreshVar : boolean; AutoSearchUpdateVar : boolean; // SWYT - search while you type UserSetColours : boolean; fExportPath : ANSIString; SearchIsCaseSensitive : boolean; NextAutoSnapshot : TDateTime; // Clears any Sync we have configured. Only proceeds if lock is available // but DOES NOT grab that lock because it has trashed the Sync anyway. function DidCleanAndLockSync(): boolean; // Recieves messages from the auto sync system, updates searchform status bar // and, if enabled, notifications. procedure HandlePostMessage(var Msg: TLMessage); message WM_SYNCMESSAGES; // ThreadTest procedure SetNotePath(const NewNotePath: string); // Checks WantFileSync, WantGitHubSync if both false, exits. Otherwise it deals with one off them, // mark that one false, create a thread and execute(). procedure StartSyncThread(); // Sets some default colours (find better way) and sets Colour Button hint. procedure CheckUserColours; // Looks in expected place for help notes, populate combo and public vars, HelpNotesPath, HelpNotesLang. procedure LoadHelpLanguages(); // We load settings from confile or, if not available, sensible defaults, save. // then go on to check and make if necessary, other needed directories. // We proceed even if we cannot save settings, after all, user has been warned. procedure CheckConfigAndDirs; // Ret true and displays on screen if passed Full name is a usable dictonary // sets SpellConfig and triggers a config save if successful function CheckDictionary(const FullDicName : string): boolean; // Checks and/or makes indicatd dir, warns user if not there and writable. function CheckDirectory(DirPath: string): boolean; // Returns the number of files that could be dictionaries in indicated directory function CheckForDic(const DictPath: ANSIString): integer; { If LabelLib has a valid full name (of hunspell library), tests it, otherwise asks hunspell to guess some names. In either case, exits if fail, if successful then tries for a dictionary, either using default directories and populating listbox or if it finds one or a full name was provided in DicFullName, just tests that name. If successfull show on screen and saves config } procedure CheckSpelling(const DicFullName: string=''); procedure DicDefaults(out DicPathAlt: string); procedure DoAutoSnapshot; // Returns a good place to save config or user requested place if on cmdline, //function GetDefaultConfigDir: string; // Returns the default place to store notes. It may not be present. function GetDefaultNoteDir(OldTomboy: boolean = false): string; // Has a list of possible fixed font names, returns the first that 'works'. function GetFixedFont(): string; function MyBoolStr(const InBool: boolean) : string; procedure ReadConfigFile; procedure SetFontSizes; // Uses value of HelpNotesLang to make the Combobox agree. procedure SetHelpLanguage(); // Saves all current settings to disk. Call when any change is made. If unable // to write to disk, returns False, If IgnoreMask, writes even if masked. // WriteLstSync is only used just after an auto sync. function WriteConfigFile(IgnoreMask : boolean = false; WriteLastSync : boolean = false): boolean; function fGetValidSync: boolean; // Must be passed either a valid sync repo address, rsSyncNotConfig or '' //procedure fSetValidSync(Repo: string); // Sets AutoRefresh and triggers a write of config file procedure fSetAutoRefresh(AR : boolean); // Just returns AutoRefresh function fGetAutoRefresh() : boolean; procedure fSetAutoSearchUpdate(ASU : boolean); // sets and then triggers config write function fGetAutoSearchUpdate(): boolean; // just set AutoSearchUpdateVar // Make public things agree with internal ones. procedure SyncSettings; function fGetCaseSensitive : boolean; procedure fSetCaseSensitive(IsIt : boolean); //function ZipDate: string; public HelpNotesPath : string; // expected path to help note directories for this OS HelpNotesLang : string; // either two char code or '' AreClosing : boolean; // False until set true by mainUnit FormClose. BackGndColour : TColor; AltBackGndColor : TColor; // When selected Text looses focus TextColour : TColor; HiColour : TColor; TitleColour : TColor; AltColour : TColor; // A colour similar to BackGndColour, alt rows in ListView, buttons in dark mode ? LinkColour : TColor; UsualFont : string; FixedFont : string; DefaultFixedFont : string; DarkThemeSwitch : boolean; // Dark Theme because user provided --dark-theme, set in main unit. DarkTheme : boolean; // Dark Theme because we detected it ourselves. Set by main unit. QtOwnsColours : boolean; // Qt[5,6] is in charge of its own colours, probably using QT_QPA_PLATFORMTHEME, but not for kmemo DebugModeSpell : boolean; // Indicates SettingsChanged should not write out a new config file or // react to changes to Radio buttones ect because we are loading config. MaskSettingsChanged : boolean; AllowClose : Boolean; // review need for this // Indicates we should re-index notes when form hides //NeedRefresh : Boolean; FontSmall : Integer; FontLarge : Integer; FontHuge : Integer; FontTitle : Integer; // Do not set this to one of the other sizes ! FontNormal : Integer; { The directory expected to hold existing or new notes } NoteDirectory : string; { The dir expected to hold config file and, possibly local manifest } LocalConfig : string; SyncOption : TSyncOption; { Indicates user wants to see internal links } ShowIntLinks : boolean; { Says Notes should be treated as read only, a safe choice } NotesReadOnly : boolean; { Indicates Spell is configured and LabelLibrary and LabelDic should contain valid full file names.} SpellConfig : boolean; // Checks to ensure no threads are running. Will hold // up an App exits for up to 5 seconds. procedure CloseNowPlease(); // Triggers a Manual Sync, if its not all setup aready and working, user is shown error. // Called when MainMenu Sync is click if Sett.ValidSync is true. So, a Manual Sync ? procedure Synchronise(); // True is at least one Sync Model has valid config. property ValidSync : boolean read fGetValidSync; property SearchCaseSensitive : boolean read fGetCaseSensitive write fSetCaseSensitive; // Property that triggers write of config when set, reads, sets property AutoRefresh : boolean read fGetAutoRefresh write fSetAutoRefresh; // Property SWYT - search while you type property AutoSearchUpdate : boolean read fgetAutoSearchUpdate write fSetAutoSearchUpdate; // Does not appear to be implemented property ExportPath : ANSIString Read fExportPath write fExportPath; // Called after notes are indexed (from SearchUnit), will start auto timer tha // controls both AutoSync and AutoSnap. Does nothing in SingleNoteMode. procedure StartAutoSyncAndSnap(); // Public : Returns the SyncFileRepo unless its empty, in which case its // returns unusable rubbish to ensure sync aborts. However, a special case // applies when setting up, SyncFileRepo will be empty but ComboSyncType set // to ItemsIndex=0 (being file sync) and a valid URL will be in LabelSyncRepo. function GetSyncFileRepo() : string; end; Type { TSyncThread } TSyncThread = class(TThread) private protected { Runs one sync, either File or Github. The thread will try to lock SyncingNowLock only if SavingNowLock is not set, else will sleep 5s. Eventually it gets going, test transport, fill in SyncLists, Syncronize to mark readonly any open note thats also being downloaded or deleted. Any error, PostMessage (and release lock) and Exits. If it gets to end, PostMessage (WM_SYNCFINISHED) will unlock SyncNowLock and trigger another call to StartSyncThread(). Must get a delay in there to ensure any pending Saves can get in between a pair of Syncs. } procedure Execute; override; public NotesDir : string; debugmode : boolean; ConfigDir : string; Password : string; UserName : string; Transport : TSyncTransport; Constructor Create(CreateSuspended : boolean); end; {x$DEFINE TESTAUTOTIMING} // Makes auto sync faster and very vocal var Sett : TSett; SyncTimingStates : array of string = ('manual', 'hourly', 'daily', 'weekly'); // these are possible auto sync states. {$ifdef TESTAUTOTIMING} SyncTimingFactors : array of real = (0.0, (1.0/2400), 0.01, 0.07); // these are elapsed time for each state to retrigger 100 times faster {$else} SyncTimingFactors : array of real = (0.0, (1.0/24), 1.0, 7.0); // these are elapsed time for each state to retrigger {$endif} // only one or the other can be set. SavingLockNow set and unset in EditBox // and SyncingLockNow set in TSyncThread.Execute and unset in HandlePostMessage() LockSyncingNow, LockSavingNow : boolean; const Placement = 45; // where we position an opening window. Its, on average, 1.5 time Placement; Sleeps = 200; // How many times we allow Sync Thread to sleep waiting for a lock. implementation {$R *.lfm} {X$define DEBUG} { TSett } uses IniFiles, LazLogger, LazFileUtils, // LazFileUtils needed for TrimFileName(), cross platform stuff; SearchUnit, // So we can call IndexNotes() after altering Notes Dir Sync, // in autosync mode, we talk direct to Sync tb_utils, recover, // Recover lost or damaged files mainunit, // so we can call ShowHelpNote() hunspell, // spelling check LCLType, // Keycodes .... Autostart, Colours, Clipbrd, tb_symbol, syncGUI, uQt_Colors, ResourceStr, // only partially so far .... dateutils; // Managing Sync Timing var Spell: THunspell; // Initially the first place we look for dictionaries, later its the path to // dictionaries listed in ListBoxDic DicPath : AnsiString; // when StartSyncThread() is called, neither, one or both may be set. Set in // TimerAutoSyncTimer() and unset just before when StartSyncThread() launches a thread; WantFileSync, WantGitHubSync : boolean; ThreadCount : integer = 0; // A count of any threads we use, only useful to prevent early close of app. StopAllThreads : boolean = false; // Only happens at shutdown time. const TooEarlyDate = '1900-01-01T01:01:10'; // An indication its not a real datetime for our purpose EarlyDate = '1971-01-01T00:00:00'; // Something to compare with, later than TooEarlyData procedure TSett.SetFontSizes; begin if RadioFontHuge.checked then begin FontSmall := 11; FontLarge := 20; FontHuge := 23; FontTitle := 21; // Do not set this to one of the other sizes ! FontNormal := 16; end; if RadioFontBig.checked then begin FontSmall := 9; FontLarge := 17; FontHuge := 20; FontTitle := 18; // Do not set this to one of the other sizes ! FontNormal := 14; end; if RadioFontMedium.checked then begin FontSmall := 8; FontLarge := 14; FontHuge := 18; FontTitle := 16; // Do not set this to one of the other sizes ! FontNormal := 11; end; if RadioFontSmall.Checked then begin FontSmall := 7; FontLarge := 13; FontHuge := 16; FontTitle := 14; // Do not set this to one of the other sizes ! FontNormal := 10; end; end; procedure TSett.SyncSettings; begin if NoteDirectory <> '' then begin LabelNotespath.Caption := NoteDirectory; ShowIntLinks := CheckShowIntLinks.Checked; SetFontSizes(); if RadioAlwaysAsk.Checked then SyncOption := AlwaysAsk else if RadioUseLocal.Checked then SyncOption := UseLocal else if RadioUseServer.Checked then SyncOption := UseServer; end; if NoteDirectory = GetDefaultNoteDir() then RadioTomboyNGDefault.Checked := True else if NoteDirectory = GetDefaultNoteDir(True) then RadioTomboyDefault.Checked := True else RadioChoose.Checked := True; end; // -------------------------------- Search Settings ---------------------------- function TSett.fGetCaseSensitive : boolean; begin result := SearchIsCaseSensitive; end; procedure TSett.fSetCaseSensitive(IsIt : boolean); begin SearchIsCaseSensitive := IsIt; if Not MaskSettingsChanged then WriteConfigFile(); end; procedure TSett.PageControl1Change(Sender: TObject); begin // if NoteDirectory = '' then ButtDefaultNoteDirClick(self); Label15.Caption := ''; SpeedButHelp.Visible := (PageControl1.TabIndex = 2); // Only show for Sync Tab end; procedure TSett.SpeedButHelpClick(Sender: TObject); begin SearchForm.ShowHelpNote('sync-ng.note'); end; procedure TSett.SpeedButHideClick(Sender: TObject); begin Hide; end; procedure TSett.SpeedButtTBMenuClick(Sender: TObject); begin PMenuMain.Popup; end; procedure TSett.TabBasicResize(Sender: TObject); begin buttonSetNotePath.Width := (TabBasic.Width div 2) - 12; end; procedure TSett.TabRecoverResize(Sender: TObject); begin ButtonManualSnap.Width := (TabRecover.Width div 2) -10; end; procedure TSett.TabSpellResize(Sender: TObject); begin ButtonSetSpellLibrary.Width := (TabSpell.Width div 2) -7; ButtonSetDictionary.Width := ButtonSetSpellLibrary.Width; end; { ----------------- S P E L L I N G ----------------------} ResourceString rsSelectLibrary = 'Select your hunspell library'; rsSelectDictionary = 'Select the dictionary you want to use'; rsDictionaryLoaded = 'Dictionary Loaded OK'; rsDictionaryFailed = 'Library Not Loaded'; rsDictionaryNotFound = 'No Dictionary Found'; procedure TSett.ButtonSetSpellLibraryClick(Sender: TObject); begin OpenDialogLibrary.InitialDir := ExtractFilePath(LabelLibrary.Caption); OpenDialogLibrary.Filter := 'Library|libhunspell*'; OpenDialogLibrary.Title := rsSelectLibrary; if OpenDialogLibrary.Execute then begin LabelLibrary.Caption := TrimFilename(OpenDialogLibrary.FileName); CheckSpelling(); end; end; procedure TSett.ButtonSetDictionaryClick(Sender: TObject); begin OpenDialogDictionary.InitialDir := ExtractFilePath(LabelDic.Caption); OpenDialogDictionary.Filter := 'Dictionary|*.dic'; OpenDialogDictionary.Title := rsSelectDictionary; if OpenDialogDictionary.Execute then CheckDictionary(TrimFilename(OpenDialogDictionary.FileName)); end; function TSett.CheckForDic(const DictPath : ANSIString) : integer; var Info : TSearchRec; begin LabelError.Caption := ''; ListBoxDic.Clear; ListBoxDic.Enabled := False; if FindFirst(AppendPathDelim(DictPath) + '*.dic', faAnyFile and faDirectory, Info)=0 then begin repeat ListBoxDic.Items.Add(Info.Name); until FindNext(Info) <> 0; end; FindClose(Info); if DebugModeSpell then debugln('CheckForDic searched ' + DictPath + ' and found ' + inttostr(ListBoxDic.Items.Count)); if ListBoxDic.Items.Count > 0 then begin DicPath := DictPath; LabelDic.Caption := DictPath; end; exit(ListBoxDic.Items.Count); end; procedure TSett.ListBoxDicClick(Sender: TObject); begin if ListBoxDic.ItemIndex > -1 then CheckDictionary(AppendPathDelim(DicPath) + ListBoxDic.Items.Strings[ListBoxDic.ItemIndex]); end; function TSett.CheckDictionary(const FullDicName : string) : boolean; begin result := false; if fileexists(FullDicName) then begin if assigned(Spell) then begin SpellConfig := Spell.SetDictionary(FullDicName); if SpellConfig then begin LabelDicStatus.Caption := rsDictionaryLoaded; LabelDic.Caption := FullDicName; WriteConfigFile(); Result := True; end else begin LabelDicStatus.Caption := rsDictionaryNotFound; end; end; end else debugln('ERROR - called CheckDictionary with Spell nil'); if DebugModeSpell then debugln('CheckDictionary ' + FullDicName + ' return ' + booltostr(Result, True)); end; procedure TSett.DicDefaults(out DicPathAlt : string); begin DicPathAlt := ExtractFilePath(Application.ExeName); {$ifdef WINDOWS} DicPath := 'C:\Program Files\LibreOffice 5\share\extensions\dict-en\'; {$ENDIF} {$ifdef DARWIN} DicPath := '/Library/Spelling/'; DicPathAlt := '/Applications/tomboy-ng.app/Contents/Resources/'; {$endif} {$ifdef LINUX} DicPath := '/usr/share/hunspell/'; DicPathAlt := '/usr/share/myspell/'; {$ENDIF} end; procedure TSett.CheckSpelling(const DicFullName : string = ''); var DicPathAlt : string = ''; DicToCheck : string; begin { The hunspell unit tries to find a library using some educated guesses. Once found, its saved in config and we pass that to hunspell as a suggested first place to try. We set likely dictionary locations here. } DicToCheck := ''; LabelError.Caption:=''; ListBoxDic.enabled:= False; LabelDic.Visible := False; LabelDicStatus.Visible := False; LabelDicPrompt.Visible := False; SpellConfig := False; if DicFullName = '' then DicDefaults(DicPathAlt); // startup mode DebugModeSpell := Application.HasOption('debug-spell'); // LabelLibrary.Caption := '/usr/local/Cellar/hunspell/1.6.2/lib/libhunspell-1.6.0.dylib'; if fileexists(LabelLibrary.Caption) then // make sure file from config is still valid Spell := THunspell.Create(DebugModeSpell, LabelLibrary.Caption) else Spell := THunspell.Create(DebugModeSpell); if Spell.ErrorMessage <> '' then begin LabelLibraryStatus.Caption := rsDictionaryFailed; exit(); end; if DebugModeSpell then debugln('Library OK, lets look for dictionary'); LabelLibraryStatus.caption := rsDictionaryLoaded; LabelLibrary.Caption := Spell.LibraryFullName; LabelDicStatus.Visible := True; LabelDic.Visible := True; if DicFullName = '' then begin if (not DirectoryExistsUTF8(LabelDic.Caption)) and (FileExistsUTF8(LabelDic.Caption)) then // we have a nominated file from config if CheckDictionary(LabelDic.Caption) then exit; // All good, use it ! if 0 = CheckForDic(DicPath) then begin // We'll try our defaults .... if 0 = CheckForDic(DicPathAlt) then begin LabelDicStatus.Caption := rsDictionaryNotFound; exit(); end; end; end else DicToCheck := DicFullName; if ListBoxDic.Items.Count = 1 then DicToCheck := AppendPathDelim(LabelDic.Caption) + ListBoxDic.Items.Strings[0]; if ListBoxDic.Items.Count > 1 then begin // user must select LabelDicStatus.Caption := rsSelectDictionary; ListBoxDic.Enabled:= True; exit(); end; // if to here, we have 1 candidate dictionary, either exactly 1 found or DicFullName has content if CheckDictionary(DicToCheck) then if DebugModeSpell then debugln('Spelling Configured.'); end; { --------------------- H O U S E K E E P I NG -------------------- } procedure TSett.FormHide(Sender: TObject); begin FreeandNil(Spell); end; procedure TSett.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin if {$ifdef DARWIN}ssMeta{$else}ssCtrl{$endif} in Shift then begin if key = ord('N') then begin SearchForm.OpenNote(''); Key := 0; exit(); end; if key = VK_Q then MainForm.Close(); end; end; procedure TSett.FormShow(Sender: TObject); begin if not assigned(Spell) then Spell := THunspell.Create(Application.HasOption('debug-spell'), LabelLibrary.Caption); // user user has 'closed' (ie hide) then Spell was freed. MaskSettingsChanged := False; Label15.Caption:=''; CheckUserColours; end; // We only really close when told by RTSearch that The Exit Menu choice from TrayIcon was clicked. procedure TSett.FormClose(Sender: TObject; var CloseAction: TCloseAction); begin CloseAction := caHide; // We don't really close Settings except at app end, see OnCloseQuery; (* Note this is not called when the app is closing, nor is OnCloseQuery *) (* if AllowClose then begin CloseAction := caFree; SearchForm.Close; end else CloseAction := caHide; *) end; procedure TSett.CloseNowPlease(); var WaitCount : integer = 0; begin {$ifdef debug}debugln({$I %CURRENTROUTINE%}, '() ', {$I %FILE%}, ', ', 'line:', {$I %LINE%}, ' : ' , 'Close Request from MainUnit'); {$endif} StopAllThreads := True; while ThreadCount > 0 do begin // MainForm.ShowNotification('WARNING tomboy-ng is still Syncing', 2000); // {$ifdef debug}debugln({$I %CURRENTROUTINE%}, '() ', {$I %FILE%}, ', ', 'line:', {$I %LINE%}, ' : ' // , 'WARNING, blocking a close while syncing ??'); {$endif} inc(WaitCount); if WaitCount > 100 then begin // Thats five seconds. Seems a lot ..... MainForm.ShowNotification('ERROR tomboy-ng is still Syncing, forced exit !', 2000); debugln({$I %CURRENTROUTINE%}, '() ', {$I %FILE%}, ', ', 'line:', {$I %LINE%}, ' : ' , 'WARNING, tomboy-ng forced to close but it was still syncing ??'); break; end; sleep(100); end; end; procedure TSett.FormCreate(Sender: TObject); var i : integer; begin gTTFontCache.ReadStandardFonts; // needed by PDF export and, at some stage, new font selection window. Caption := 'tomboy-ng Settings'; ButtonSetNotePath.Enabled := False; AreClosing := false; Top := 100; Left := 300; LoadHelpLanguages(); ComboSyncType.Items.Clear; ComboSyncType.Items.Add(rsSyncTypeFile); ComboSyncType.Items.Add(rsSyncTypeGitHub); ComboDateFormat.Items.Clear; for i := 0 to MaxDateStampIndex do ComboDateFormat.Items.add(TB_DateStamp(i)); ComboDateFormat.ItemIndex := 0; DefaultFixedFont := GetFixedFont(); // Tests a list of likely suspects. PageControl1.ActivePage := TabBasic; MaskSettingsChanged := true; // don't trigger save while doing setup ExportPath := ''; LabelLibrary.Caption := ''; //HaveConfig := false; LocalConfig := TB_GetDefaultConfigDir(); // sys dependant unless user has overridden LabelSettingPath.Caption := LocalConfig + 'tomboy-ng.cfg'; NoteDirectory := Sett.GetDefaultNoteDir; labelNotesPath.Caption := NoteDirectory; CheckConfigAndDirs(); // write a new, default one if necessary CheckSpelling(); ComboSyncType.ItemIndex := 0; // Defaults to File if SyncGithubRepo <> '' then ComboSyncType.ItemIndex := 1; // But if we have Github, show that, more going on ComboSyncTypeChange(self); //LabelSyncInfo1.Caption := rsFileSyncInfo1; // ToDo : is this done in ComboSyncTypeChange //LabelSyncInfo2.Caption := rsFileSyncInfo2; MaskSettingsChanged := False; WantFileSync := False; WantGitHubSync := False; LockSyncingNow := False; LockSavingNow := False; end; procedure TSett.FormDestroy(Sender: TObject); begin FreeandNil(Spell); end; { ------------------------- F I L E I / O --------------------------- } RESOURCESTRING rsErrorCreateDir = 'Unable to Create Directory'; rsErrorCannotWrite = 'Cannot write into'; function TSett.CheckDirectory(DirPath : string) : boolean; begin Result := False; if not DirectoryExistsUTF8(DirPath) then ForceDirectoriesUTF8(DirPath); if not DirectoryExistsUTF8(DirPath) then begin ShowMessage(rsErrorCreateDir + ' [' + DirPath + ']'); Debugln('Settings is unable to Create Directory [' + DirPath + ']'); exit(False); end; if DirectoryIsWritable(DirPath) then exit(True); ShowMessage(rsErrorCannotWrite + ' [' + DirPath + ']'); DebugLn('Settings cannot write into [' + DirPath + ']'); end; (* // This has been moved to TB_Utils function TSett.GetDefaultConfigDir : string; begin Result := ''; if Application.HasOption('config-dir') then Result := Application.GetOptionValue('config-dir'); if Result = '' then begin {$ifdef DARWIN} // First we try the right place, if there use it, else try unix place, if // its not there, go back to right place. Result := GetEnvironmentVariable('HOME') + '/Library/Application Support/Tomboy-ng/Config'; if not DirectoryExistsUTF8(Result) then begin Result := GetAppConfigDirUTF8(False); if not DirectoryExistsUTF8(Result) then // must be new install, put in right place Result := GetEnvironmentVariable('HOME') + '/Library/Application Support/Tomboy-ng/Config'; end; {$else} Result := GetAppConfigDirUTF8(False); {$endif} end; Result := AppendPathDelim(Result); {$ifndef DARWIN} // MainForm.SetAltHelpPath(Result); // English help notes in read only space {$endif} end; *) function TSett.GetFixedFont() : string; var T : string; FontNames : array[1..9] of string = ('Ubuntu Mono', 'Monaco', 'Liberation Mono', 'Nimbus Mono PS', 'Nimbus Mono L', 'Lucida Console', 'Lucida Sans Typewriter', 'Courier New', 'Monospace'); // Add as many new names as you like but set array size. Chooses the first in the list it finds that works // Label does not seem to worry about us playing with its canvas. function IsMono(FontName : String) : boolean; begin Label1.Canvas.Font.Name := FontName; {$ifdef LCLGTK3} // Might work on Linux generally ? // https://forum.lazarus.freepascal.org/index.php/topic,20193.msg194575.html Result := Label1.Canvas.Font.IsMonoSpace; {$else} result := Label1.Canvas.TextWidth('i') = Label1.Canvas.TextWidth('w'); {$endif} // That line above triggers a whole load of GTK3 error messages. // I have no idea whats happening here, that line, above, somehow triggers a call // to the RadioFileSync OnChange handler. In turn, that calls SettingsChanged before // we have setup its config path. For now, because its not needed yet, I have // commented out the code in the OnChange end; function IsDifferentSizes() : boolean; // in case they are old non scalable, unlikely but .... var ASize : integer; begin Label1.Canvas.Font.Size := 13; ASize := Label1.Canvas.TextHeight('H'); Label1.Canvas.Font.Size := 14; if ASize = Label1.Canvas.TextHeight('H') then exit(False); ASize := Label1.Canvas.TextHeight('H'); Label1.Canvas.Font.Size := 15; If ASize = Label1.Canvas.TextHeight('H') then exit(False); result := True; end; begin Result := ''; for T in FontNames do begin if not IsMono(T) then continue; if not IsDifferentSizes() then continue; Result := T; exit; end; end; // Will read and apply the config file if available, else sets sensible defaults // Is only called at startup and assumes the config dir has been checked and // LabelSettingPath.Caption contains an appropriate file name. procedure TSett.ReadConfigFile; var ConfigFile : TINIFile; i : integer; Uch : String[10]; // SyncTimingSt : string; function GetSyncTimingIndex(Key, OldAuto, OldEnabled : string) : integer; var SyncTimingSt : string; begin SyncTimingSt := ConfigFile.readstring('SyncSettings', Key, ''); if SyncTimingSt = '' then begin // If blank, maybe user just updated to 0.37+ ? if ('true' = Configfile.ReadString('SyncSettings', OldAuto, 'false')) and ('true' = Configfile.ReadString('SyncSettings', OldEnabled, 'false')) then Result := FindInStringArray(SyncTimingStates, 'hourly') else Result := 0; // 0 represents 'manual', nothing auto happening end else begin Result := FindInStringArray(SyncTimingStates, SyncTimingSt); // look for it in state array 0..x if Result < 0 then begin debugln('ERROR - bad Sync Timing State word in config, SyncSettings:SyncTimingFile:' + SyncTimingSt); Result := 0; // Manual so nothing happens end; end; end; begin // TiniFile does not care it it does not find the config file, just returns default values. ConfigFile := TINIFile.Create(LabelSettingPath.Caption); try NoteDirectory := ConfigFile.readstring('BasicSettings', 'NotesPath', NoteDirectory); CheckShowIntLinks.Checked := ('true' = ConfigFile.readstring('BasicSettings', 'ShowIntLinks', 'true')); CheckShowExtLinks.Checked := ('true' = ConfigFile.readstring('BasicSettings', 'ShowExtLinks', 'true')); CheckManyNoteBooks.checked := ('true' = Configfile.readstring('BasicSettings', 'ManyNotebooks', 'true')); CheckUseUndo.Checked := ('true' = ConfigFile.readstring('BasicSettings', 'UseUndo', 'true')); SearchCaseSensitive := ('true' = Configfile.readstring('BasicSettings', 'CaseSensitive', 'false')); CheckShowSplash.Checked := ('true' = Configfile.ReadString('BasicSettings', 'ShowSplash', 'true')); CheckAutostart.Checked := ('true' = Configfile.ReadString('BasicSettings', 'Autostart', 'false')); CheckShowSearchAtStart.Checked := ('true' = Configfile.ReadString('BasicSettings', 'ShowSearchAtStart', 'false')); CheckNotifications.Checked := ('true' = Configfile.ReadString('BasicSettings', 'ShowNotifications', 'true')); CheckEscClosesNote.Checked := ('true' = Configfile.ReadString('BasicSettings', 'EscClosesNote', 'false')); case ConfigFile.readstring('BasicSettings', 'FontSize', 'medium') of 'huge' : RadioFontHuge.Checked := true; 'big' : RadioFontBig.Checked := true; 'medium' : RadioFontMedium.Checked := true; 'small' : RadioFontSmall.Checked := true; end; AutoRefresh := ('true' = ConfigFile.readstring('BasicSettings', 'AutoRefresh', 'true')); AutoSearchUpdate := ('true' = ConfigFile.readstring('BasicSettings', 'AutoSearchUpdate', 'true')); CheckFindToggles.Checked := ('true' = Configfile.ReadString('BasicSettings', 'FindToggles', 'true')); // ------------------- F O N T S ---------------------- UsualFont := ConfigFile.readstring('BasicSettings', 'UsualFont', GetFontData(Self.Font.Handle).Name); ButtonFont.Hint := UsualFont; FixedFont := ConfigFile.readstring('BasicSettings', 'FixedFont', DefaultFixedFont); if FixedFont = '' then FixedFont := DefaultFixedFont; ButtonFixedFont.Hint := FixedFont; // ------------------- C O L O U R S ------------------- BackGndColour:= StringToColor(Configfile.ReadString('BasicSettings', 'BackGndColour', '0')); HiColour := StringToColor(Configfile.ReadString('BasicSettings', 'HiColour', '0')); TextColour := StringToColor(Configfile.ReadString('BasicSettings', 'TextColour', '0')); TitleColour := StringToColor(Configfile.ReadString('BasicSettings', 'TitleColour', '0')); LinkColour := StringToColor(Configfile.ReadString('BasicSettings', 'LinkColour', '0')); UserSetColours := not ((BackGndColour = 0) and (HiColour = 0) and (TextColour = 0) and (TitleColour = 0) and (LinkColour = 0)); // Note - '0' is a valid colour, black. So, what says its not set is they are all '0'; CheckUserColours; HelpNotesLang := Configfile.ReadString('BasicSettings', 'HelpLanguage', HelpNotesLang); SetHelpLanguage(); // ------------------ S Y N C S E T T I N G S -------------------------- case ConfigFile.readstring('SyncSettings', 'SyncOption', 'AlwaysAsk') of 'AlwaysAsk' : begin SyncOption := AlwaysAsk; RadioAlwaysAsk.Checked := True; end; 'UseLocal' : begin SyncOption := UseLocal; RadioUseLocal.Checked := True; end; 'UseServer' : begin SyncOption := UseServer; RadioUseServer.Checked := True; end; end; SyncTimingFileIndex := GetSyncTimingIndex('SyncTimingFile', 'Autosync', 'FileSyncEnabled'); // this is new in 0.37+ SyncTimingGithubIndex := GetSyncTimingIndex('SyncTimingGitHub', 'AutosyncGit', 'GitSyncEnabled'); { if I > -1 then SyncTimingFileIndex := I else SyncTimingFileIndex := 0; // 0 means manual, ie no auto I := FindInStringArray(SyncTimingStates, ConfigFile.readstring('SyncSettings', 'SyncTimingGithub', '')); if I > -1 then SyncTimingGithubIndex := I else SyncTimingFileIndex := 0; } //ConfigFile.WriteString('SyncSettings', 'SyncTimingFile', SyncTimingStates[SyncTimingFileIndex]); //ConfigFile.WriteString('SyncSettings', 'SyncTimingGithub', SyncTimingStates[SyncTimingGithubIndex]); //FindInStringArray(const AnArray : array of string; const FindMe : string) : integer; SyncFileRepo := ConfigFile.readstring('SyncSettings', 'SyncRepo', ''); // that is for file sync SyncGithubRepo := ConfigFile.readstring('SyncSettings', 'SyncRepoGithub', ''); //ConfigFile.WriteString('SyncSettings', 'SyncTimingFile', SyncTimingStates[SyncTimingFileIndex]); //ConfigFile.WriteString('SyncSettings', 'SyncTimingGithub', SyncTimingStates[SyncTimingGithubIndex]); // SyncFileAuto := ('true' = Configfile.ReadString('SyncSettings', 'Autosync', 'false')); // not used in 0.37+ // SyncGithubAuto := ('true' = Configfile.ReadString('SyncSettings', 'AutosyncGit', 'false')); // not used in 0.37+ // SyncFileEnabled := ('true' = Configfile.ReadString('SyncSettings', 'FileSyncEnabled', 'false')); // not used in 0.37+ // SyncGithubEnabled := ('true' = Configfile.ReadString('SyncSettings', 'GitSyncEnabled', 'false')); // not used in 0.37+ LabelToken.caption := DecodeStringBase64(Configfile.ReadString('SyncSettings', 'GHPassword', '')); EditUserName.text := Configfile.ReadString('SyncSettings', 'GHUserName', ''); ComboSyncTypeChange(self); // remember that an old config file might contain stuff about Filesync, nextcloud, random rubbish ..... SyncTimingFileLast := ISO8601ToDate(Configfile.ReadString('SyncSettings', 'SyncTimingFileLast', TooEarlyDate)); SyncTimingGitHubLast := ISO8601ToDate(Configfile.ReadString('SyncSettings', 'SyncTimingGitHubLast', TooEarlyDate)); {$IFDEF TESTAUTOTIMING} debugln({$I %FILE%}, ', ', {$I %CURRENTROUTINE%}, '(), line:', {$I %LINE%}, 'SyncTimingFileIndex=' + inttostr(SyncTimingFileIndex) + ' SyncTimingGithubIndex=' + inttostr(SyncTimingGithubIndex), ''); {$endif} // ------------- S P E L L I N G --------------------------------------- LabelLibrary.Caption := ConfigFile.readstring('Spelling', 'Library', ''); LabelDic.Caption := ConfigFile.readstring('Spelling', 'Dictionary', ''); SpellConfig := (LabelLibrary.Caption <> '') and (LabelDic.Caption <> ''); // indicates it worked once... // ------------- S N A P S H O T S E T T I N G S ------------------- LabelSnapDir.Caption := ConfigFile.readstring('SnapSettings', 'SnapDir', NoteDirectory + 'Snapshot' + PathDelim); CheckAutoSnapEnabled.Checked := Configfile.ReadBool('Snapshot', 'AutoSnapEnabled', False); NextAutoSnapshot := Configfile.ReadDateTime('Snapshot', 'NextAutoSnapshot', now()); SpinDaysPerSnapshot.Value := Configfile.ReadInteger('Snapshot', 'DaysPerSnapshot', 7); SpinMaxSnapshots.Value := Configfile.ReadInteger('Snapshot', 'DaysMaxSnapshots', 20); // ------------- D A T E S T A M P S E T T I N G ----------------- CheckStampItalics.Checked := Configfile.ReadBool('DateStampSettings', 'Italics', False); CheckStampSmall.Checked := Configfile.ReadBool('DateStampSettings', 'Small', False); CheckStampBold.Checked := Configfile.ReadBool('DateStampSettings', 'Bold', False); ComboDateFormat.ItemIndex := Configfile.ReadInteger('DateStampSettings', 'Format', 0); // ----------------- Symbols --------------------------------------- for i := 0 to high(SymArray) do begin Uch := ConfigFile.readstring('SymbolSettings', 'Symbol_' + inttostr(i), ''); if Uch <> '' then SymArray[i].SymStr := Uch; end; FormSymbol.UpdateSymbols(); //ConfigFile.writestring('SymbolSettings', 'Symbol_' + inttostr(i), SymArray[i].SymStr); finally ConfigFile.free; end; end; { Read config file if it exists or writes a default one. } procedure TSett.CheckConfigAndDirs; //var // ConfigFile : TINIFile; begin CheckDirectory(LocalConfig); // so its created if needed, shows message on error. ReadConfigFile(); // will ensure sensible default config even if file is not present. if LabelSettingPath.Caption = 'LabelSettingPath' then showmessage('WARNING, TSett.CheckConfigFile - writing config before setting filename') else if not fileexists(LabelSettingPath.Caption) then // must be first run WriteConfigFile(True); // write a initial default file, shows user message on error CheckDirectory(NoteDirectory); // user will get a message on error, their problem CheckDirectory(NoteDirectory + 'Backup'); CheckDirectory(LabelSnapDir.Caption); SyncSettings(); // ToDo : can we discard this yet ? end; procedure TSett.fSetAutoRefresh(AR: boolean); begin AutoRefreshVar := AR; WriteConfigFile(); end; function TSett.fGetAutoRefresh() : boolean; begin Result := AutoRefreshVar; end; procedure TSett.fSetAutoSearchUpdate(ASU: boolean); begin AutoSearchUpdateVar := ASU; WriteConfigFile(); end; function TSett.fGetAutoSearchUpdate: boolean; begin Result := AutoSearchUpdateVar; end; function TSett.MyBoolStr(const InBool : boolean) : string; begin if InBool then result := 'true' else result := 'false'; end; function TSett.WriteConfigFile(IgnoreMask : boolean = false; WriteLastSync : boolean = false) : boolean; var ConfigFile : TINIFile; i : integer; begin Result := True; if MaskSettingsChanged and (not IgnoreMask) then exit(); { if LabelSettingPath.Caption = 'LabelSettingPath' then // ToDo : I very occasionally create a file called LabelSettingPath, cannot reproduce showmessage('WARNING, TSett.SettingsChanged - writing config before setting filename'); } ConfigFile := TINIFile.Create(LabelSettingPath.Caption); try try ConfigFile.writestring('BasicSettings', 'NotesPath', NoteDirectory); Configfile.writestring('BasicSettings', 'ManyNotebooks', MyBoolStr(CheckManyNoteBooks.checked)); Configfile.writestring('BasicSettings', 'CaseSensitive', MyBoolStr(SearchCaseSensitive)); ConfigFile.writestring('BasicSettings', 'ShowIntLinks', MyBoolStr(CheckShowIntLinks.Checked)); ConfigFile.writestring('BasicSettings', 'ShowExtLinks', MyBoolStr(CheckShowExtLinks.Checked)); ConfigFile.WriteString('BasicSettings', 'ShowSplash', MyBoolStr(CheckShowSplash.Checked)); ConfigFile.WriteString('BasicSettings', 'Autostart', MyBoolStr(CheckAutostart.Checked)); ConfigFile.WriteString('BasicSettings', 'ShowSearchAtStart', MyBoolStr(CheckShowSearchAtStart.Checked)); ConfigFile.WriteString('BasicSettings', 'ShowNotifications', MyBoolStr(CheckNotifications.Checked)); ConfigFile.WriteString('BasicSettings', 'EscClosesNote', MyBoolStr(CheckEscClosesNote.Checked)); ConfigFile.WriteString('BasicSettings', 'AutoRefresh', MyBoolStr(AutoRefresh)); ConfigFile.WriteString('BasicSettings', 'UseUndo', MyBoolStr(CheckUseUndo.Checked)); ConfigFile.WriteString('BasicSettings', 'AutoSearchUpdate', MyBoolStr(AutoSearchUpdate)); ConfigFile.WriteString('BasicSettings', 'FindToggles', MyBoolStr(CheckFindToggles.checked)); if RadioFontBig.Checked then ConfigFile.writestring('BasicSettings', 'FontSize', 'big') else if RadioFontMedium.Checked then ConfigFile.writestring('BasicSettings', 'FontSize', 'medium') else if RadioFontSmall.Checked then ConfigFile.writestring('BasicSettings', 'FontSize', 'small') else if RadioFontHuge.Checked then ConfigFile.writestring('BasicSettings', 'FontSize', 'huge'); ConfigFile.writestring('BasicSettings', 'UsualFont', UsualFont); ConfigFile.writestring('BasicSettings', 'FixedFont', FixedFont); //(Sel_CText = 0) and (Sel_CBack = 0) and (Sel_CHiBack = 0) and (Sel_CTitle = 0) if UserSetColours then begin ConfigFile.writestring('BasicSettings', 'BackGndColour', ColorToString(BackGndColour)); ConfigFile.writestring('BasicSettings', 'HiColour', ColorToString(HiColour)); ConfigFile.writestring('BasicSettings', 'TextColour', ColorToString(TextColour)); ConfigFile.writestring('BasicSettings', 'TitleColour', ColorToString(TitleColour)); ConfigFile.writestring('BasicSettings', 'LinkColour', ColorToString(LinkColour)); end else begin ConfigFile.writestring('BasicSettings', 'BackGndColour', '0'); ConfigFile.writestring('BasicSettings', 'HiColour', '0'); ConfigFile.writestring('BasicSettings', 'TextColour', '0'); ConfigFile.writestring('BasicSettings', 'TitleColour', '0'); ConfigFile.writestring('BasicSettings', 'LinkColour', '0'); end; if HelpNotesLang <> '' then ConfigFile.writestring('BasicSettings', 'HelpLanguage', HelpNotesLang); // --------- S Y N C S E T T I N G S ---------------------------- { Other entries, such as SyncRepoURL, SyncURL, FileSyncRepo, UseFileSync are distractions introduced by a nasty pull request I stupidly let through, ignore them, they will not go away unless manually deleted ! V0.37+ no longer use 'Autosync', 'AutosyncGit', 'FileSyncEnabled', 'GitSyncEnabled' } // ConfigFile.WriteString('SyncSettings', 'Autosync', MyBoolStr(SyncFileAuto)); // disabled in 0.37+ // ConfigFile.WriteString('SyncSettings', 'AutosyncGit', MyBoolStr(SyncGithubAuto)); // ConfigFile.WriteString('SyncSettings', 'FileSyncEnabled', MyBoolStr(SyncFileEnabled)); // ConfigFile.WriteString('SyncSettings', 'GitSyncEnabled', MyBoolStr(SyncGithubEnabled)); {$IFDEF TESTAUTOTIMING} //if WriteLastSync then // debugln({$I %FILE%}, ', ', {$I %CURRENTROUTINE%}, '(), line:', {$I %LINE%}, ' : ', 'About to write SyncTiming Index.'); {$endif} ConfigFile.WriteString('SyncSettings', 'SyncTimingFile', SyncTimingStates[SyncTimingFileIndex]); ConfigFile.WriteString('SyncSettings', 'SyncTimingGithub', SyncTimingStates[SyncTimingGithubIndex]); if RadioAlwaysAsk.Checked then ConfigFile.writestring('SyncSettings', 'SyncOption', 'AlwaysAsk') else if RadioUseLocal.Checked then ConfigFile.writestring('SyncSettings', 'SyncOption', 'UseLocal') else if RadioUseServer.Checked then ConfigFile.writestring('SyncSettings', 'SyncOption', 'UseServer'); //ConfigFile.writestring('SyncSettings', 'SyncType', SyncType); // Extend sync type here. ConfigFile.writestring('SyncSettings', 'SyncRepo', SyncFileRepo); ConfigFile.writestring('SyncSettings', 'SyncRepoGithub', SyncGithubRepo); ConfigFile.writestring('SyncSettings', 'GHPassword', EncodeStringBase64(LabelToken.Caption)); ConfigFile.writestring('SyncSettings', 'GHUserName', EditUserName.text); if WriteLastSync then begin // only if called from TimerAutoSyncTimer where SyncTimingFileLast and SyncTimingGitHubLast are set. if SyncTimingFileLast > ISO8601ToDate(EarlyDate) then begin // either may not be set {$IFDEF TESTAUTOTIMING} // debugln({$I %FILE%}, ', ', {$I %CURRENTROUTINE%}, '(), line:', {$I %LINE%}, ' : ', 'Writing last File Sync Time.'); {$endif} ConfigFile.writestring('SyncSettings', 'SyncTimingFileLast', FormatDateTime('yyyy-mm-dd"T"hh:mm:ss', SyncTimingFileLast)); end; if SyncTimingGitHubLast > ISO8601ToDate(EarlyDate) then begin // either may not be set {$IFDEF TESTAUTOTIMING} // debugln({$I %FILE%}, ', ', {$I %CURRENTROUTINE%}, '(), line:', {$I %LINE%}, ' : ', 'Writing last GitHub Sync Time.'); {$endif} ConfigFile.writestring('SyncSettings', 'SyncTimingGitHubLast', FormatDateTime('yyyy-mm-dd"T"hh:mm:ss', SyncTimingGitHubLast)); end; { TestSt := FormatDateTime('yyyy-mm-dd"T"hh:mm:ss', SyncTimingFileLast); Writeln('Incoming Datetime is ' + TestSt); SyncTimingGitHubLast := ISO8601ToDate(TestSt); Writeln('Converted and back ' + FormatDateTime('yyyy-mm-dd"T"hh:mm:ss', SyncTimingGitHubLast)); } end; // // SyncTimingFileLast, SyncTimingGitHubLast // --------- S P E L L S E T T I N G S ---------------------------- if SpellConfig then begin ConfigFile.writestring('Spelling', 'Library', LabelLibrary.Caption); ConfigFile.writestring('Spelling', 'Dictionary', LabelDic.Caption); end; // --------- S N A P S H O T S E T T I N G S ------------------- configfile.WriteBool('Snapshot', 'AutoSnapEnabled', CheckAutoSnapEnabled.Checked); configfile.WriteDateTime('Snapshot', 'NextAutoSnapshot', NextAutoSnapshot); // Format can (?) be set in SysUtils but does not matter as long as its consistent on this machine configfile.WriteInteger('Snapshot', 'DaysPerSnapshot', SpinDaysPerSnapshot.Value); configfile.WriteInteger('Snapshot', 'DaysMaxSnapshots', SpinMaxSnapshots.Value); // --------- D A T E S T A M P S E T T I N G ----------------- configfile.Writebool('DateStampSettings', 'Italics', CheckStampItalics.Checked); configfile.Writebool('DateStampSettings', 'Small', CheckStampSmall.Checked); configfile.Writebool('DateStampSettings', 'Bold', CheckStampBold.Checked); configfile.WriteInteger('DateStampSettings', 'Format', ComboDateFormat.ItemIndex); // ----------------- Symbols --------------------------------------- for i := 0 to high(SymArray) do ConfigFile.writestring('SymbolSettings', 'Symbol_' + inttostr(i), SymArray[i].SymStr); finally ConfigFile.Free; end; except on E: Exception do begin showmessage('Unable to write config to ' + LabelSettingPath.Caption); Result := False; end; end; // debugln('just wrote a settings file out'); end; function TSett.GetDefaultNoteDir(OldTomboy : boolean = false) : string; begin {$IFDEF UNIX} Result := GetEnvironmentVariable('HOME') + '/.local/share/tomboy-ng/'; {$ENDIF} {$IFDEF DARWIN} // try the correct place first, if not there, lets try the old, wrong place // if at neither, we go back to correct place. Result := GetEnvironmentVariable('HOME') + '/Library/Application Support/Tomboy-ng/Notes/'; if DirectoryExistsUTF8(Result) then exit; Result := GetEnvironmentVariable('HOME') + '/.local/share/tomboy-ng/'; if not DirectoryExistsUTF8(Result) then Result := GetEnvironmentVariable('HOME') + '/Library/Application Support/Tomboy-ng/Notes/'; // Note we ignore the possibility of Mac having an old Tomboy install. {$ENDIF} {$IFDEF WINDOWS} Result := GetEnvironmentVariable('APPDATA') + '\tomboy-ng\notes\'; // %APPDATA%\Tomboy\notes\ {$ENDIF} if OldTomBoy then Result := Result.Replace('tomboy-ng', 'tomboy', [rfReplaceAll]); end; (* procedure TSett.ButtDefaultNoteDirClick(Sender: TObject); begin NoteDirectory := GetDefaultNoteDir(); if not CheckDirectory(NoteDirectory) then NoteDirectory := Sett.LabelNotesPath.Caption else begin WriteConfigFile(); SyncSettings(); SearchForm.IndexNotes(True); end; end; *) // Called when ever any NotesDir Radiobutton changed. procedure TSett.RadioNotePathChange(Sender: TObject); var APath : string; begin if MaskSettingsChanged then exit; if not DidCleanAndLockSync() then exit; // Also flush notes case TRadioButton(Sender).Name of 'RadioTomboyNGDefault' : begin ButtonSetNotePath.enabled := False; APath := GetDefaultNoteDir(); SetNotePath(APath); end; 'RadioTomboyDefault' : begin ButtonSetNotePath.enabled := False; APath := GetDefaultNoteDir(); APath := NoteDirectory.Replace('tomboy-ng', 'tomboy', [rfReplaceAll]); SetNotePath(APath); end; 'RadioChoose' : begin ButtonSetNotePath.enabled := True; exit; // don't, at this stage, check dir end; end; end; function TSett.DidCleanAndLockSync() : boolean; begin if ValidSync then if mrCancel = QuestionDlg('WARNING', 'This will remove your Sync Settings' , mtConfirmation, [mrOK, mrCancel], 0) then exit(false); SearchForm.FlushOpenNotes(); While LockSyncingNow do begin // Must wait until a sync is finished. if mrCancel = QuestionDlg('Sync In Progress', 'Try Again ?' , mtConfirmation, [mrOK, mrCancel], 0) then exit(False); end; // LockSyncingNow := True; SyncFileRepo := ''; // Must disable Sync if note dir changes, all sync history blown away. SyncGithubRepo := ''; result := true; end; RESOURCESTRING rsDirHasNoNotes = 'That directory does not contain any notes. That is OK, if I can make my own there.'; // Tests the passed path as a potential notes dir, if OK, sets it and indexes // any notes. Does not change NotesDirectory if passed one is unsuitable procedure TSett.SetNotePath(const NewNotePath : string); var Info : TSearchRec; begin if CheckDirectory(NoteDirectory) then begin NoteDirectory := NewNotePath; LabelNotesPath.caption := NoteDirectory; if not FindFirst(NoteDirectory + '*.note', faAnyFile and faDirectory, Info)=0 then showmessage(rsDirHasNoNotes); FindClose(Info); WriteConfigFile(); SearchForm.IndexNotes(True); end; end; { Allow user to point to what they want to call their notes dir. If there are no notes there, pops up a warning and proceeds. } procedure TSett.ButtonSetNotePathClick(Sender: TObject); var // Info : TSearchRec; APath : string; begin if not DidCleanAndLockSync() then exit; // Also flush notes if SelectDirectoryDialog1.Execute then begin APath := TrimFilename(SelectDirectoryDialog1.FileName + PathDelim); SetNotePath(APath); (* if CheckDirectory(NoteDirectory) then begin if not FindFirst(NoteDirectory + '*.note', faAnyFile and faDirectory, Info)=0 then begin showmessage(rsDirHasNoNotes); end; FindClose(Info); CheckShowIntLinks.enabled := true; // Why is this here ???? // CheckReadOnly.enabled := true; // SyncFileAuto := False; // SyncGithubAuto := False; ComboSyncTypeChange(self); WriteConfigFile(); SyncSettings(); SearchForm.IndexNotes(True); end else NoteDirectory := LabelNotesPath.caption; *) end; end; { Colors - if its GTK2 or a Qt5 with a QT_QPA_PLATFORMTHEME=[gtk2, qt5ct] then most colors will be right. However, the KMemo might be wrong as its always set to a defult light set, ignoring OS. So, we must always set Sett's colors for, at least, KMemo to use. DarkThemeSwitch tells us to apply the setting to what ever other components we can too. SetColors is called by TMainForm.TestDarkThemeInUse during startup, DarkTheme* may have been set. It tests for a gtk2, qt5 using qt5ct and defers to qt5ct if possible. Otherwise, sets some (hopefully) appropriate colors for either a light or dark theme. These colors are always used for the KMemo and possibly, when DarkThemeSwich is used, for what other screens I can. } procedure TSett.SetColours; {$if defined(LCLQT5) or defined(LCLQT6)} var Qt_Colors : TQt_Colors; {$endif} // pink = $EEEEFF, White is $FFFFFF, Black is $000000 begin {$ifdef DEBUG} debugln({$I %FILE%}, ', ', {$I %CURRENTROUTINE%}, '(), line:', {$I %LINE%}, ' : ', 'QT_QPA_PLATFORMTHEME is ' + GetEnvironmentVariable('QT_QPA_PLATFORMTHEME')); {$endif} {$if defined(LCLQT5) or defined(LCLQT6)} // First we will try the special Qt5 ways of settings colours // If user has set QT_QPA_PLATFORMTHEME=gtk2 this bit drops through, all components except KMemo are good. Qt_Colors := TQt_Colors.Create; // needs some work for qt6 try if Qt_Colors.FoundColors then begin // Will be false if user not using qt5ct BackGndColour:= Qt_Colors_Rec.QColorBackground; HiColour := Qt_Colors_Rec.QColorHighLight+1; // This is, eg Crtl H type highlighting, not selection. +1 to make unique AltColour := Qt_Colors_Rec.QColorLessBright; // Used for selected Text TextColour := Qt_Colors_Rec.QColorText; TitleColour:= Qt_Colors_Rec.QColorLink; LinkColour := Qt_Colors_Rec.QColorLink; AltBackGndColor := Qt_Colors_Rec.QColorLessBright; // Selected background colour QtOwnsColours := true; {$ifdef DEBUG} debugln({$I %FILE%}, ', ', {$I %CURRENTROUTINE%}, '(), line:', {$I %LINE%}, ' : ', 'Colors set by qt5ct.');{$endif} exit; end; finally Qt_Colors.Free; end; {$endif} if UserSetColours then exit; // will have already been set by config or by colour form. if DarkTheme or DarkThemeSwitch then begin BackGndColour:= $303030; // KMemo Background AltColour := $606060; // Some panel's background color HiColour := $600001; // a dark blue; This is, eg Crtl H type highlighting, not selection ! TextColour := clWhite; TitleColour:= $B8B800; LinkColour := $B8B801; AltBackGndColor := clGray; // Selected text, both focused and unfocused {$ifdef DEBUG} debugln({$I %FILE%}, ', ', {$I %CURRENTROUTINE%}, '(), line:', {$I %LINE%}, ' : ', 'Dark Colors set by code.');{$endif} end else begin BackGndColour := clCream; AltColour := clDefault; HiColour := clYellow-1; TextColour := clBlack; TitleColour := clBlue; LinkColour := clBlue+1; // One unit of red, no one will notice, but don't subtract 1 from xxxx00 or add 1 to xxxxFF AltBackGndColor := clLtGray; {$ifdef DEBUG} debugln({$I %FILE%}, ', ', {$I %CURRENTROUTINE%}, '(), line:', {$I %LINE%}, ' : ', 'Light Colors set by code.');{$endif} end; // if DarkThemeSwitch then color := AltColour; No, cannot change color of the Tabsheet, looks horrible end; procedure TSett.SetHelpLanguage(); var HelpIndex : integer = 0; begin while HelpIndex < ComboHelpLanguage.Items.Count do begin if HelpNotesLang = copy(ComboHelpLanguage.Items[HelpIndex], 1, 2) then begin ComboHelpLanguage.ItemIndex := HelpIndex; break; end; inc(HelpIndex); end; end; procedure TSett.LoadHelpLanguages(); var Info : TSearchRec; begin {$ifdef WINDOWS}HelpNotesPath := AppendPathDelim(ExtractFileDir(Application.ExeName)) + 'HELP' + PathDelim;{$endif} {$ifdef LINUX} HelpNotesPath := '/usr/share/tomboy-ng/HELP/'; {$endif} {$ifdef DARWIN} HelpNotesPath := ExtractFileDir(ExtractFileDir(Application.ExeName))+'/Resources/HELP/';{$endif} HelpNotesLang:= ''; ComboHelpLanguage.enabled := False; ComboHelpLanguage.Items.Clear; if FindFirst(HelpNotesPath + '*', faDirectory, Info)=0 then begin repeat if (((Info.attr and faDirectory) > 0) and (Info.name[1] <> '.')) then begin case Info.Name of 'EN' : ComboHelpLanguage.Items.Add('EN - English'); 'ES' : ComboHelpLanguage.Items.Add('ES - Español'); 'UK' : ComboHelpLanguage.Items.Add('UK - Українська'); 'FR' : ComboHelpLanguage.Items.Add('FR - Français'); otherwise ComboHelpLanguage.Items.Add(Info.Name); end; end; until FindNext(Info) <> 0; end; FindClose(Info); if ComboHelpLanguage.Items.Count > 0 then begin ComboHelpLanguage.enabled := True; if ComboHelpLanguage.Items.IndexOf('EN - English') < 0 then // default to EN if present, else first found. HelpNotesLang:= copy(ComboHelpLanguage.Items[0], 1, 2) else HelpNotesLang:= 'EN'; end; SetHelpLanguage(); end; procedure TSett.ComboHelpLanguageChange(Sender: TObject); begin if ComboHelpLanguage.ItemIndex > -1 then begin HelpNotesLang:= copy(ComboHelpLanguage.Items[ComboHelpLanguage.ItemIndex], 1, 2); WriteConfigFile(); SearchForm.RefreshMenus(mkHelpMenu); end; end; procedure TSett.ButtonSetColoursClick(Sender: TObject); begin FormColours.CBack := BackGndColour; FormColours.CHiBack := HiColour; FormColours.CText := TextColour; FormColours.CTitle := TitleColour; FormColours.CLink := LinkColour; case FormColours.ShowModal of mrRetry : begin UserSetColours := False; SetColours(); WriteConfigFile(); end; mrOK : begin BackGndColour := FormColours.CBack; HiColour := FormColours.CHiBack; TextColour := FormColours.CText; TitleColour := FormColours.CTitle; LinkColour := FormColours.CLink; UserSetColours := True; WriteConfigFile(); end; end; CheckUserColours; end; procedure TSett.CheckUserColours; begin if UserSetColours then begin ButtonSetColours.Hint := 'Custom Colours in use'; // ToDo : AltBackGndColour may not be appropriate here, wot is ? And AltColour ???? AltBackGndColor := clGray; AltColour := clLtGray; end else ButtonSetColours.Hint := 'Default Colours'; end; procedure TSett.ButtonFixedFontClick(Sender: TObject); var ISMono : boolean = false; begin FontDialog1.Font.Name := FixedFont; FontDialog1.Font.Size := 10; FontDialog1.Title := 'Select Fixed Spacing Font'; FontDialog1.PreviewText:= 'abcdef ABCDEF 012345 iiiii wwwww'; // showmessage(FixedFont); FontDialog1.Options := [fdEffects, fdFixedPitchOnly, fdNoSimulations, fdTrueTypeOnly]; // ToDo : this does not show ONLY fixed ! If FontDialog1.Execute then BEGIN FixedFont := FontDialog1.Font.name; WriteConfigFile(); end; ButtonFixedFont.Hint := FixedFont; Label1.Canvas.Font.Name := FixedFont; {$ifdef LCLGTK3} // Might work on Linux generally ? No, not on GTK2 .... // https://forum.lazarus.freepascal.org/index.php/topic,20193.msg194575.html IsMono := Label1.Canvas.Font.IsMonoSpace; {$else} IsMono := Label1.Canvas.TextWidth('i') = Label1.Canvas.TextWidth('w'); // I once experienced some wierd, unrelated things happening doing this, careful ! {$endif} if not IsMono then showmessage('Warning, maybe not a mono spaced font'); end; procedure TSett.ButtonFontClick(Sender: TObject); begin FontDialog1.Font.Name := UsualFont; FontDialog1.Font.Size := 10; FontDialog1.Title := 'Select Usual Font'; FontDialog1.PreviewText:= 'abcdef ABCDEF 012345'; FontDialog1.Options := [fdEffects, fdNoSimulations, fdTrueTypeOnly]; If FontDialog1.Execute then BEGIN UsualFont := FontDialog1.Font.name; WriteConfigFile(); end; ButtonFont.Hint := UsualFont; end; { --------------------- S N A P S H O T S ------------------- } { Totally unvalidated rule of thumb - About a 200 notes = ~ 400K bytes, we get about 4:1 compression with zipper. 120ms on lowend laptop. } procedure TSett.SpinDaysPerSnapshotChange(Sender: TObject); begin if CheckAutoSnapEnabled.Checked then DoAutoSnapShot(); WriteConfigFile(); end; procedure TSett.DoAutoSnapshot; var FR : TFormRecover; {$ifdef TESTAUTOTIMING} Tick, Tock : qword;{$endif} //Notifier : TNotifier; begin if MaskSettingsChanged then exit; // don't trigger this while GUI is being setup. {$ifdef TESTAUTOTIMING} Tick := gettickcount64(); {$endif} FR := TFormRecover.Create(self); try FR.NoteDir := NoteDirectory; FR.FullSnapDir := LabelSnapDir.Caption; FR.ConfigDir:= AppendPathDelim(Sett.LocalConfig); if ('' <> FR.CreateSnapshot(False)) then FR.CleanUpSnapshots(SpinMaxSnapshots.Value); finally FR.Free; end; // do this after snapshot run to ensure we don't queue up a list of calls. {$ifdef TESTAUTOTIMING} tock := gettickcount64(); debugln('DoAutoSnapshot - Finished snapshot, took ' + dbgs(Tock - Tick) + 'mS'); NextAutoSnapshot := now() + (SpinDaysPerSnapshot.value / (24*60)) ; {$else} NextAutoSnapshot := now() + SpinDaysPerSnapshot.value; {$endif} WriteConfigFile(); SearchForm.UpdateStatusBar(1, rsAutosnapshotRun); // ToDo : should snapshots have own status panel ? if CheckNotifications.Checked then begin MainForm.ShowNotification(rsAutosnapshotRun); (* {$ifdef LINUX} ShowNotification('tomboy-ng', rsAutosnapshotRun); {$else} MainForm.TrayIcon.BalloonTitle := 'tomboy-ng'; Mainform.TrayIcon.BalloonHint := 'rsAutosnapshotRun'; Mainform.TrayIcon.ShowBalloonHint; {$endif} *) end; end; procedure TSett.CheckAutoSnapEnabledChange(Sender: TObject); begin if CheckAutoSnapEnabled.Checked then begin DoAutoSnapShot(); end; SaveSettings(self); end; procedure TSett.ButtonManualSnapClick(Sender: TObject); var FR : TFormRecover; FullName : string; begin FR := TFormRecover.Create(self); try Screen.Cursor := crHourGlass; FR.NoteDir := NoteDirectory; FR.FullSnapDir := LabelSnapDir.Caption; FR.ConfigDir:= AppendPathDelim(Sett.LocalConfig); FullName := FR.CreateSnapshot(True); if mrYes = QuestionDlg('Snapshot created', FullName + ' ' + rsSnapShotCreated , mtConfirmation, [mrYes, mrNo], 0) then if SelectSnapDir.Execute then if not CopyFile(FullName, TrimFilename(SelectSnapDir.FileName + PathDelim) + ExtractFileNameOnly(FullName) + '.zip') then showmessage(rsErrorCopyFile + ' ' + TrimFilename(SelectSnapDir.FileName + PathDelim) + ExtractFileNameOnly(FullName) + '.zip'); finally FR.Free; Screen.Cursor := crDefault; end; end; procedure TSett.ButtonSetSnapDirClick(Sender: TObject); begin SelectSnapDir.FileName := LabelSnapDir.Caption; if SelectSnapDir.Execute then begin LabelSnapDir.Caption := TrimFilename(SelectSnapDir.FileName + PathDelim); end; CheckDirectory(LabelSnapDir.Caption); end; procedure TSett.ButtonSnapRecoverClick(Sender: TObject); var FR : TFormRecover; begin FR := TFormRecover.Create(self); try FR.NoteDir := NoteDirectory; FR.FullSnapDir := LabelSnapDir.Caption; FR.ConfigDir:= AppendPathDelim(Sett.LocalConfig); // Danger Will Robertson ! We cannot assume LocalConfig has a trailing slash ! FR.Showmodal; if FR.RequiresIndex then SearchForm.IndexNotes(True); finally FR.Free; end; end; // 108/60 // ============================= S Y N C S T U F F ========================= { Note that AutoSync and AutoSnapshot share a timer. AutoSync runs on each 'tick' of the timer, that is, hourly, but autosnapshop looks at NextAutoSnapshot to decide if its time to do its thing. } { This method manages display of all the controls associated with setting up Sync connections. } procedure TSett.ComboSyncTypeChange(Sender: TObject); var Ctrl : TControl; RememberMask : boolean; begin RememberMask := MaskSettingsChanged; MaskSettingsChanged := true; case ComboSyncType.ItemIndex of 0 : begin LabelSyncInfo1.caption := rsFileSyncInfo1; LabelSyncInfo2.caption := rsFileSyncInfo2; ComboSyncTiming.Enabled := (SyncFileRepo <> ''); //CheckBoxAutoSync.Checked := SyncFileAuto; //CheckSyncEnabled.Checked := SyncFileEnabled; for Ctrl in [GroupBoxToken, GroupBoxUser, LabelToken, EditUserName] do Ctrl.Visible := False; if SyncFileRepo = '' then LabelSyncRepo.Caption := rsSyncNotConfig else LabelSyncRepo.Caption := SyncFileRepo; ComboSyncTiming.ItemIndex := SyncTimingFileIndex; end; 1 : begin LabelSyncInfo1.caption := rsGithubSyncInfo1; LabelSyncInfo2.caption := rsGithubSyncInfo2; ComboSyncTiming.enabled := (SyncGithubRepo <> ''); //CheckBoxAutoSync.Checked := SyncGithubAuto; //CheckSyncEnabled.Checked := SyncGithubEnabled; for Ctrl in [GroupBoxToken, GroupBoxUser, LabelToken, EditUserName] do Ctrl.Visible := True; if SyncGithubRepo = '' then LabelSyncRepo.Caption := rsSyncNotConfig else LabelSyncRepo.Caption := SyncGithubRepo; ComboSyncTiming.ItemIndex := SyncTimingGithubIndex; end; end; if (LabelSyncRepo.Caption = rsSyncNotConfig) or (LabelSyncRepo.Caption = '') then begin SpeedSetUpSync.Caption := rsSetUp; //CheckBoxAutoSync.enabled := false; //CheckSyncEnabled.enabled := false; end else begin SpeedSetUpSync.Caption := rsChangeSync; //CheckBoxAutoSync.enabled := true; //CheckSyncEnabled.enabled := true; end; MaskSettingsChanged := RememberMask; end; procedure TSett.SpeedSetupSyncClick(Sender: TObject); var SyncType : integer; begin { Used by both File and Github sync } // if NoteDirectory = '' then ButtDefaultNoteDirClick(self); FormSync.NoteDirectory := NoteDirectory; FormSync.LocalConfig := LocalConfig; FormSync.SetupSync := True; SyncType := ComboSyncType.ItemIndex; case SyncType of 0 : begin // File Sync if FileExists(LocalConfig + 'manifest.xml') and (mrYes <> QuestionDlg('Warning', rsChangeExistingSync, mtConfirmation, [mrYes, mrNo], 0)) then exit; if SelectDirectoryDialog1.Execute then LabelSyncRepo.Caption := TrimFilename(SelectDirectoryDialog1.FileName + PathDelim) else exit(); SyncFileRepo := ''; // So Sync unit does not use the old one. FormSync.Transport:=TSyncTransport.SyncFile; // The Sync unit will get the remote dir from SyncFileRepo end; 1 : begin if FileExists(LocalConfig + SyncTransportName(SyncGithub) + PathDelim + 'manifest.xml') and (mrYes <> QuestionDlg('Warning', rsChangeExistingSync, mtConfirmation, [mrYes, mrNo], 0)) then exit; FormSync.Transport:=TSyncTransport.SyncGithub; FormSync.Password := LabelToken.Caption; FormSync.UserName := EditUserName.text; // SyncGUI will update LabelSyncRepo.Caption if successful. end; end; if mrOK = FormSync.ShowModal then begin case SyncType of 0 : SyncFileRepo := LabelSyncRepo.Caption; 1 : SyncGithubRepo := LabelSyncRepo.Caption; end; //CheckSyncEnabled.Checked := True; WriteConfigFile(); ComboSyncTypeChange(self); // update button label, timing combo etc end; end; procedure TSett.SpeedTokenActionsClick(Sender: TObject); begin PopupMenuTokenActions.PopUp; end; procedure TSett.MenuItemGetTokenClick(Sender: TObject); begin // ToDo : is it possible to tell if user is logged in at this stage ? OpenURL('https://github.com/settings/tokens'); end; procedure TSett.MenuItemPasteTokenClick(Sender: TObject); begin LabelToken.Caption := Clipboard.AsText; SaveSettings(self); LabelToken.Hint := ''; end; procedure TSett.MenuItemCopyTokenClick(Sender: TObject); begin Clipboard.AsText := LabelToken.Caption; end; function TSett.fGetValidSync: boolean; begin result := (SyncFileRepo <> '') or (SyncGithubRepo <> ''); end; procedure TSett.CheckAutostartChange(Sender: TObject); var Auto : TAutoStartCtrl; begin // This is being called at startup, it should only be called when user changes it. if not visible then exit; Auto := TAutoStartCtrl.Create('tomboy-ng', CheckAutostart.Checked); if Auto.ErrorMessage <> '' then ShowMessage('Error setting autostart' + Auto.ErrorMessage); FreeAndNil(Auto); SaveSettings(Sender); end; {procedure TSett.CheckSyncEnabledChange(Sender: TObject); // ToDo : will not need this in new sync timing control mode. begin if MAskSettingsChanged then exit; case ComboSyncType.ItemIndex of 0 : SyncFileEnabled := CheckSyncEnabled.Checked; 1 : SyncGithubEnabled := CheckSyncEnabled.Checked; end; SaveSettings(self); end; } {procedure TSett.CheckBoxAutoSyncChange(Sender: TObject); // ToDo : will not need this in new sync timing control mode. begin // debugln('WARNING - CheckBoxAutoSyncChange called'); if MAskSettingsChanged then exit; // Don't trigger timer during setup if CheckBoxAutoSync.Checked then begin case ComboSyncType.ItemIndex of 0 : SyncFileAuto := True; 1 : SyncGithubAuto := True; otherwise exit; end; TimerAutoSync.Enabled := false; TimerAutoSync.Interval:= 1000; // wait a second, then sync. AutoSnap will also be checked. TimerAutoSync.Enabled := true; end else case ComboSyncType.ItemIndex of 0 : SyncFileAuto := False; 1 : SyncGithubAuto := False; // ToDo : this should be FALSE ??????? was 'true' ?????????????????????????????????????????????????????????????????????? otherwise exit; end; SaveSettings(Self); end; } procedure TSett.ComboSyncTimingChange(Sender: TObject); begin if MAskSettingsChanged then exit; // Don't trigger during setup case ComboSyncType.ItemIndex of 0 : begin // File Sync SyncTimingFileIndex := ComboSyncTiming.ItemIndex; // 0=off, 1=hourly, 2=dayly, 3=weekly, 4=monthly end; 1 : begin SyncTimingGithubIndex := ComboSyncTiming.ItemIndex; end; end; TimerAutoSyncTimer(self); SaveSettings(Self); ComboSyncTiming.LockRealizeBounds; end; procedure TSett.Synchronise(); begin FormSync.NoteDirectory := Sett.NoteDirectory; FormSync.LocalConfig := AppendPathDelim(Sett.LocalConfig); SearchForm.FlushOpenNotes(); FormSync.SetupSync := False; if (SyncFileRepo <> '') then begin // if SyncFileEnabled then begin FormSync.AnotherSync := (SyncGithubRepo <> ''); FormSync.Transport:=TSyncTransport.SyncFile; if FormSync.busy or FormSync.Visible then // busy should be enough but to be sure .... FormSync.Show else FormSync.ShowModal; end; if (SyncGithubRepo <> '') then begin FormSync.AnotherSync := False; FormSync.Transport:=TSyncTransport.SyncGithub; if FormSync.busy or FormSync.Visible then // busy should be enough but to be sure .... FormSync.Show else FormSync.ShowModal; end; end; procedure TSett.StartAutoSyncAndSnap(); begin if (MainUnit.SingleNoteFileName = '') then begin TimerAutoSync.Interval:= 15000; // wait 15 seconds after indexing to allow settling down TimerAutoSync.Enabled := true; // Note that this timer will also trigger checking of AutoSnapshot. But AutoSnapshot only // does something if NextAutoSnapshot is > now(), while AutoSync always runs on timer if enabled. end; end; function TSett.GetSyncFileRepo(): string; begin if SyncFileRepo <> '' then Result := SyncFileRepo else if (ComboSyncType.ItemIndex = 0) and (LabelSyncRepo.Caption <> rsSyncNotConfig) and (LabelSyncRepo.Caption <> '') then result := LabelSyncRepo.Caption else Result := 'File Sync is not configured'; end; { New Ctrl of auto sync for v0.37+ Two vars per sync model - SyncTimingFileLast, SyncTimingGitHubLast : TDataTime being last time that syn was run. Set to TooEarlyDate if nothing in config, otherwise loaded from config at startup. SyncTimingFileIndex, SyncTimingGithubIndex : int, index into array of possible auto sync timing states, 0 is manual or 'off' if an Index is 0, then no auto will take place but manual is possible if a sync is configured. Set from config at startup, if not in config, looks for [Autosync and FileSyncEnabled] and [AutosyncGit and GitSyncEnabled] setting appropriate index to hourly if true. ValidSync : property ret true if one or the other sync appear valid, that is, have a repo set. We determine that a sync should be run by anding - (SyncRepo <> '') eg result := (SyncFileRepo <> '') or (SyncGithubRepo <> ''); not busy *Index > 0 Now() > (*Last + SyncTimingFactors) or, perhaps, Now() > (*Last + SyncTimingFactors[Index]) where SyncTimingFactors is an array using same index and is time between sync for a particular timing setting } procedure TSett.HandlePostMessage(var Msg: TLMessage); var St : string; begin // We cannot trigger a SaveThread from here because we don't know which EditBox wants one. // Sadly, if two Syncs are configured, we will trigger second one as soon as the first is finished // thats tough on the saveThread but they must not run concurrently. case Msg.wParam of WM_SYNCFINISHED : St := rsLastSync + ' Changes ' + inttostr(Msg.LParam); WM_SYNCNOTPOSSIBLE : St := rsAutoSyncNotPossible; WM_SYNCTIMEOUT : St := 'Sync timeout waiting for lock'; WM_SYNCERROR : St := rsSyncError; WM_SYNCCLASH : St := rsSyncClash; WM_SAVEERROR : St := 'ERROR, failed to save note'; WM_SAVETIMEOUT : St := 'ERROR Save timeout waiting for lock'; WM_SAVEFINISHED : St := 'Save completed'; else St := rsSyncError; end; case Msg.wParam of WM_SYNCFINISHED, WM_SYNCNOTPOSSIBLE, WM_SYNCTIMEOUT, WM_SYNCERROR, WM_SYNCCLASH : begin // The Sync Group if CheckNotifications.Checked then MainForm.ShowNotification(St, 2000); LockSyncingNow := False; if Msg.WParam = WM_SYNCCLASH then // Clashes in AutoSync are problematic, don't start another Sync. ShowMessage(rsSyncClash + lineEnding + rsSyncClashAdvice) else if not StopAllThreads then StartSyncThread(); // Check for another outstanding sync. SearchForm.UpdateStatusBar(1, St + ', ' + FormatDateTime('YYYY-MM-DD hh:mm', now)); if Msg.wParam = WM_SYNCFINISHED then // We only update the timestamp in the config file after a successful sync, so, if unsuccessful, will happen on next startup WriteConfigFile(false, True); // WriteConfigFile is called from all over the place, only this call should update last sync times. end; WM_SAVEERROR, WM_SAVETIMEOUT, WM_SAVEFINISHED : begin // The Save Group LockSavingNow := false; if (Msg.wParam <> WM_SAVEFINISHED) then begin // No notification necessary for good save if CheckNotifications.Checked then MainForm.ShowNotification(St, 2000); Debugln('ERROR, failed to save note'); end; end; end; end; procedure TSett.StartSyncThread(); var SyncThread : TSyncThread; begin if LockSyncingNow then exit; // Wow, why would that happen ? if not (WantFileSync or WantGitHubSync) then exit; // Nothing to see here folks, move along //debugln('TSett.StartSyncThread : about to flush notes.'); SearchForm.FlushOpenNotes(); SyncThread := TSyncThread.Create(True); SyncThread.NotesDir := NoteDirectory; SyncThread.debugmode := Application.HasOption('s', 'debug-sync'); SyncThread.ConfigDir := AppendPathDelim(Sett.LocalConfig); SyncThread.Password := Sett.LabelToken.Caption; SyncThread.UserName := Sett.EditUserName.text; if WantFileSync then SyncThread.Transport := TSyncTransport.SyncFile else SyncThread.Transport := TSyncTransport.SyncGitHub; SyncThread.Start(); // Thread will clean up after it self, NOTE Start note execute ! end; procedure TSett.TimerAutoSyncTimer(Sender: TObject); var ASyncRan : boolean = false; // ASync : TSync; // St : string; procedure RunAutoSync(const SyncTimingIndex : integer; var SyncTimingLast : TDateTime; Transport : TSyncTransport); {$IFDEF TESTAUTOTIMING}var St : string;{$endif} begin if (SyncTimingIndex = 0) then exit; // don't do ones set to Manual // {$IFDEF TESTAUTOTIMING} {$ifdef debug} if Transport = SyncFile then St := 'FileSync : ' + FormatDateTime('YYYY-MM-DD hh:mm', SyncTimingFileLast + SyncTimingFactors[SyncTimingFileIndex]) else St := 'GitHubSync : ' + FormatDateTime('YYYY-MM-DD hh:mm', SyncTimingGitHubLast + SyncTimingFactors[SyncTimingGitHubIndex]); debugln('TSett.TimerAutoSyncTimer : AutoSync ? Now=' + FormatDateTime('YYYY-MM-DD hh:mm', now()) + ' Target:' + St); {$endif} {$ifNdef debug} // ie, if debug, run sync every time 10 minutes happens, disregard SyncTimingFactors if (Now() < (SyncTimingLast + SyncTimingFactors[SyncTimingIndex])) then exit; // exit if time is not yet ripe. {$endif} {$IFDEF TESTAUTOTIMING} debugln('TSett.TimerAutoSyncTimer : ' + St + ' Needs Sync'); {$endif} case Transport of SyncFile : begin WantFileSync := true; SyncTimingFileLast := Now(); end; SyncGitHub : begin WantGitHubSync := true; SyncTimingGitHubLast := Now(); end; end; ASyncRan := True; end; begin // debugln('TSett.TimerAutoSyncTimer #' + {$I %LINE%} + ' Called ' + FormatDateTime('YYYY-MM-DD hh:mm', now())); TimerAutoSync.Interval:= 10*60*1000; // check again in 10 minutes {$IFDEF TESTAUTOTIMING} TimerAutoSync.Interval:= 60*1000; debugln({$I %FILE%}, ', ', {$I %CURRENTROUTINE%}, '(), line:', {$I %LINE%}, ' : TESTAUTOTIMING defined, AutoSync x100 faster'); {$ENDIF} if FormSync.Busy then exit; // No Auto Sync during manual Sync ! if (SyncFileRepo <> '') then RunAutoSync(SyncTimingFileIndex, SyncTimingFileLast, TSyncTransport.SyncFile); // Might update the time stamp if (SyncGitHubRepo <> '') then RunAutoSync(SyncTimingGitHubIndex, SyncTimingGitHubLast, TSyncTransport.SyncGitHub); // Might update the time stamp if ASyncRan then StartSyncThread(); // will write the timestamp to config file IF sync successful. if CheckAutoSnapEnabled.Checked and (NextAutoSnapshot < now()) then DoAutoSnapshot; end; procedure TSett.ButtonShowBackUpClick(Sender: TObject); var BV : TFormBackupView; begin BV := TFormBackupView.Create(self); try BV.ShowModal; finally FreeandNil(BV); end; end; procedure TSett.SaveSettings(Sender: TObject); begin WriteConfigFile(); // Write to disk SyncSettings(); end; { TSyncThread } procedure TSyncThread.Execute; var ASync : TSync; OutComeMessage : longint = WM_SYNCNOTPOSSIBLE; sleepcnt : integer = 0; Changes : integer = 0; begin // debugln('TSyncThread.Execute : +++ Starting (with delay)'); if StopAllThreads then exit; sleep(300); // Might let SaveThread sneak in. if StopAllThreads then exit; inc(ThreadCount); while (LockSyncingNow or LockSavingNow) do begin // Wait until we can get a lock if StopAllThreads then begin // App is exiting, lets get out of here. dec(ThreadCount); exit; end; sleep(300); inc(SleepCnt); if SleepCnt > Sleeps then begin PostMessage(sett.Handle, WM_SYNCMESSAGES, WM_SYNCTIMEOUT, 0); dec(ThreadCount); exit; end; // debugln('TSyncThread.Execute : LockSyncNow=' + booltostr(LockSyncingNow, true) + ' LockSavingNow=' + booltostr(LockSavingNow, True)); end; LockSyncingNow := True; // OK, we have a lock ! ASync := TSync.Create; try if StopAllThreads then // Finally will dec threadcount and Postmessage will release LockSyncingNow exit; if Transport = SyncFile then // Clear the one we are dealing with WantFileSync := False else WantGitHubSync := False; {$ifdef DEBUG} debugln({$I %CURRENTROUTINE%}, '() ', {$I %FILE%}, ', ', 'line:', {$I %LINE%}, ' : Starting Sync Thread.'); // ToDo : remove {$endif} ASync.NotesDir := Sett.NoteDirectory; ASync.debugmode := Application.HasOption('s', 'debug-sync'); ASync.ConfigDir := AppendPathDelim(Sett.LocalConfig); ASync.Password := Sett.LabelToken.Caption; ASync.UserName := Sett.EditUserName.text; if ASync.AutoSetUp(Transport) then begin // Might fail if network or shared drive not available if not ASync.GetSyncData() then begin // A sync clash, we cannot resolve in Auto Sync Mode // PostMessage(sett.Handle, WM_SYNCMESSAGES, WM_SYNCCLASH, 0); // goes to TSett.HandlePostMessage, shows a popup message OutComeMessage := WM_SYNCCLASH; // Triggers popup message, might send a notification too {$ifdef DEBUG} debugln({$I %CURRENTROUTINE%}, '() ', {$I %FILE%}, ', ', 'line:', {$I %LINE%}, ' : Acting on Sync Clash'); // ToDo : remove {$endif} exit; // Finally will deal with it end; if StopAllThreads then exit; {$ifdef DEBUG} debugln({$I %CURRENTROUTINE%}, '() ', {$I %FILE%}, ', ', 'line:', {$I %LINE%}, ' : Proceeding with Auto Sync'); // ToDo : remove {$endif} Synchronize(@(ASync.AdjustNoteList)); // Mark open notes read only if also being downloaded/deleted {$ifdef DEBUG} debugln({$I %CURRENTROUTINE%}, '() ', {$I %FILE%}, ', ', 'line:', {$I %LINE%}, ' : After Synchronize, will UseData'); // ToDo : remove {$endif} Changes := ASync.ReportChanges(); if StopAllThreads then exit; if ASync.UseSyncData() then // No real error checking here, if problem, do manual sync (* {$IFDEF TESTAUTOTIMING} debugln({$I %FILE%}, ', ', {$I %CURRENTROUTINE%}, '(), line:', {$I %LINE%}, ' : Auto Sync Finished OK') else debugln({$I %FILE%}, ', ', {$I %CURRENTROUTINE%}, '(), line:', {$I %LINE%}, ' : Auto Sync Returned False !!!') {$endif} *) ; OutComeMessage := WM_SYNCFINISHED; {$ifdef DEBUG} debugln({$I %CURRENTROUTINE%}, '() ', {$I %FILE%}, ', ', 'line:', {$I %LINE%}, ' : Finished Thread syncing'); // ToDo : remove {$endif} end else OutComeMessage := WM_SYNCNOTPOSSIBLE; finally ASync.Free; PostMessage(sett.Handle, WM_SYNCMESSAGES, OutComeMessage, Changes); // goes to TSett.HandlePostMessage, might shows a popup message dec(ThreadCount); // ThreadCount is all about keeping app running if Close is requested. end; end; constructor TSyncThread.Create(CreateSuspended: boolean); begin inherited Create(CreateSuspended); FreeOnTerminate := True; end; end. (* This is getmem's blowfish model, might use it to encrypt both notes and token https://forum.lazarus.freepascal.org/index.php/topic,56489.msg419952.html#msg419952 unit uCrypto; {$mode objfpc}{$H+} interface uses Classes, SysUtils, BlowFish, Base64; function Encrypt(const AKey, AText: String): String; function Decrypt(const AKey, AText: String): String; implementation function Encrypt(const AKey, AText: String): String; var SS: TStringStream; BES: TBlowFishEncryptStream; begin Result := ''; if Trim(AText) = '' then Exit; SS := TStringStream.Create(''); try BES := TBlowFishEncryptStream.Create(AKey, SS); try BES.Write(Pointer(AText)^, Length(AText)); finally BES.Free; end; Result := EncodeStringBase64(SS.DataString); finally SS.Free; end; end; function Decrypt(const AKey, AText: String): String; var SS: TStringStream; BDS: TBlowFishDeCryptStream; Str, Txt: String; begin Result := ''; if Trim(AText) = '' then Exit; Str := ''; Txt := DecodeStringBase64(AText); SS := TStringStream.Create(Txt); try BDS := TBlowFishDeCryptStream.Create(AKey, SS); try SetLength(Str, SS.Size); BDS.Read(Pointer(Str)^, SS.Size); Result := Str; finally BDS.Free; end; finally SS.Free; end; end; end. *) tomboy-ng_0.39-1/source/rollback.lfm0000644000175000017500000000331714551457644017234 0ustar dbannondbannonobject FormRollBack: TFormRollBack Left = 499 Height = 274 Top = 276 Width = 586 Caption = 'FormRollBack' ClientHeight = 274 ClientWidth = 586 OnCreate = FormCreate OnShow = FormShow LCLVersion = '2.1.0.0' object SpeedCancel: TSpeedButton Left = 25 Height = 32 Top = 82 Width = 200 Caption = 'Cancel' OnClick = SpeedCancelClick end object SpeedRollToOpen: TSpeedButton AnchorSideLeft.Control = SpeedCancel AnchorSideTop.Control = SpeedCancel AnchorSideTop.Side = asrBottom Left = 25 Height = 32 Top = 144 Width = 200 BorderSpacing.Top = 30 Caption = 'Opening Backup' OnClick = SpeedRollToOpenClick end object SpeedRollToTitle: TSpeedButton AnchorSideLeft.Control = SpeedCancel AnchorSideTop.Control = SpeedRollToOpen AnchorSideTop.Side = asrBottom Left = 25 Height = 32 Top = 206 Width = 200 BorderSpacing.Top = 30 Caption = 'Title Change Backup' OnClick = SpeedRollToTitleClick end object LabelOpn: TLabel Left = 248 Height = 19 Top = 157 Width = 68 Caption = 'LabelOpn' ParentColor = False end object Labelttl: TLabel Left = 248 Height = 19 Top = 219 Width = 54 Caption = 'Labelttl' ParentColor = False end object LabelOpnTitle: TLabel Left = 249 Height = 19 Top = 133 Width = 100 Caption = 'LabelOpnTitle' ParentColor = False end object LabelttlTitle: TLabel Left = 249 Height = 19 Top = 192 Width = 86 Caption = 'LabelttlTitle' ParentColor = False end object Label1: TLabel Left = 28 Height = 19 Top = 42 Width = 47 Caption = 'Label1' ParentColor = False end end tomboy-ng_0.39-1/source/mainunit.lrj0000644000175000017500000000552114551457644017277 0ustar dbannondbannon{"version":1,"strings":[ {"hash":220274030,"name":"tmainform.hint","sourcebytes":[73,102,32,116,104,101,32,121,101,108,108,111,119,32,116,111,109,98,111,121,45,110,103,32,105,99,111,110,32,105,115,32,118,105,115,105,98,108,101,32,105,110,32,121,111,117,114,32,83,121,115,116,101,109,32,84,114,97,121,44,32,121,111,117,32,99,97,110,32,100,105,115,109,105,115,115,32,116,104,105,115,32,119,105,110,100,111,119,46],"value":"If the yellow tomboy-ng icon is visible in your System Tray, you can dismiss this window."}, {"hash":60217639,"name":"tmainform.caption","sourcebytes":[116,111,109,98,111,121,45,110,103],"value":"tomboy-ng"}, {"hash":87847529,"name":"tmainform.label3.caption","sourcebytes":[68,105,99,116,105,111,110,97,114,121,32,67,111,110,102,105,103,32,40,111,112,116,105,111,110,97,108,41],"value":"Dictionary Config (optional)"}, {"hash":3892505,"name":"tmainform.label4.caption","sourcebytes":[83,121,110,99,32,67,111,110,102,105,103,32,40,111,112,116,105,111,110,97,108,41],"value":"Sync Config (optional)"}, {"hash":230572289,"name":"tmainform.label5.caption","sourcebytes":[87,101,108,99,111,109,101,32,116,111,32,116,111,109,98,111,121,45,110,103,32,33],"value":"Welcome to tomboy-ng !"}, {"hash":88,"name":"tmainform.labelnotesfound.caption","sourcebytes":[88],"value":"X"}, {"hash":108199710,"name":"tmainform.labelerror.hint","sourcebytes":[76,97,117,110,99,104,32,102,114,111,109,32,99,111,109,109,97,110,100,108,105,110,101,32,116,111,32,115,101,101,32,101,114,114,111,114,115,32,111,114,32,115,101,101,32,67,111,110,102,105,103,45,62,83,110,97,112,83,104,111,116,45,62,82,101,99,111,118,101,114,32,46,46,46],"value":"Launch from commandline to see errors or see Config->SnapShot->Recover ..."}, {"hash":88,"name":"tmainform.labelerror.caption","sourcebytes":[88],"value":"X"}, {"hash":205434003,"name":"tmainform.checkboxdontshow.hint","sourcebytes":[89,111,117,32,99,97,110,32,114,101,118,101,114,115,101,32,116,104,105,115,32,102,114,111,109,32,83,101,116,116,105,110,103,115],"value":"You can reverse this from Settings"}, {"hash":215954672,"name":"tmainform.checkboxdontshow.caption","sourcebytes":[68,111,110,39,116,32,83,104,111,119,32,102,111,114,32,110,111,114,109,97,108,32,115,116,97,114,116,117,112],"value":"Don't Show for normal startup"}, {"hash":343125,"name":"tmainform.buttmenu.caption","sourcebytes":[77,101,110,117],"value":"Menu"}, {"hash":68883765,"name":"tmainform.labelbadnoteadvice.caption","sourcebytes":[76,97,98,101,108,66,97,100,78,111,116,101,65,100,118,105,99,101],"value":"LabelBadNoteAdvice"}, {"hash":363524,"name":"tmainform.bitbtnquit.caption","sourcebytes":[81,117,105,116],"value":"Quit"}, {"hash":323493,"name":"tmainform.bitbtnhide.caption","sourcebytes":[72,105,100,101],"value":"Hide"}, {"hash":218390960,"name":"tmainform.buttsystrayhelp.caption","sourcebytes":[83,121,115,84,114,97,121,32,72,101,108,112],"value":"SysTray Help"} ]} tomboy-ng_0.39-1/source/rollback.pas0000644000175000017500000001363014551457644017240 0ustar dbannondbannonunit RollBack; { Copyright (C) 2017-2022 David Bannon License: This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html ------------------ This form will allow a user to roll back an open note to either the backup made when it was opened or a backup made if the Title was changed. It will close the open note, swap the files as required, advise Note_lister and reopen. It can toggle, repeatedly switch between. But if end user changes the title, it (obviously) writes a new backup, probably not what they want but I cannot determine their intentions. HISTORY 2022/10/18 When renaming a file, delete target if its exists first, its a windows problem } {$mode objfpc}{$H+} interface uses Classes, SysUtils, Forms, Controls, Graphics, Dialogs, Buttons, StdCtrls, EditBox; type { TFormRollBack } TFormRollBack = class(TForm) Label1: TLabel; LabelOpnTitle: TLabel; LabelttlTitle: TLabel; LabelOpn: TLabel; Labelttl: TLabel; SpeedCancel: TSpeedButton; SpeedRollToOpen: TSpeedButton; SpeedRollToTitle: TSpeedButton; procedure FormCreate(Sender: TObject); procedure FormShow(Sender: TObject); procedure SpeedCancelClick(Sender: TObject); procedure SpeedRollToOpenClick(Sender: TObject); procedure SpeedRollToTitleClick(Sender: TObject); private function GetNoteTitle(FullFileName: ANSIString): ANSIString; procedure RollBackNote(FileType, Title: string); public NoteFileName : string; // Give me ID, Filename or FullFilename before show. { The EditBox that opened this form, only it can close this form and this form can close that EditBox } ShownBy : TForm; end; var FormRollBack: TFormRollBack; implementation {$R *.lfm} { TFormRollBack } uses LazFileUtils, SyncUtils, Settings, LazLogger, FileUtil, SearchUnit, laz2_DOM, laz2_XMLRead, ResourceStr; procedure TFormRollBack.FormCreate(Sender: TObject); begin Label1.Caption := rsRollBackIntro; end; procedure TFormRollBack.FormShow(Sender: TObject); var ttlName, opnName : string; LCDstr, ErrorStr : string; begin SpeedRollToOpen.Enabled:= False; SpeedRollToTitle.Enabled:= False; LabelttlTitle.Caption := ''; ttlName := ExtractFileNameOnly(NoteFileName); // following must match name mangling rules from TSearchForm.BackupNote() opnName := Sett.NoteDirectory + 'Backup' + PathDelim + copy(ttlName, 1, 32) + '-opn.note'; ttlName := Sett.NoteDirectory + 'Backup' + PathDelim + copy(ttlName, 1, 32) + '-ttl.note'; if FileExistsUTF8(opnName) then begin // should always be there ? LCDStr := GetNoteLastChangeSt(opnName, ErrorStr); if LCDStr = '' then LabelOpn.Caption := ErrorStr else begin LCDStr[11] := ' '; LabelOpn.Caption := rsContentDated + ' ' + copy(LCDStr, 1, 16); LabelOpnTitle.Caption := GetNoteTitle(opnName); SpeedRollToOpen.Enabled := True; end; end; if FileExistsUTF8(ttlName) then begin LCDStr := GetNoteLastChangeSt(ttlName, ErrorStr); if LCDStr = '' then Labelttl.Caption := ErrorStr else begin LCDStr[11] := ' '; Labelttl.Caption := rsContentDated + ' ' + copy(LCDStr, 1, 16); LabelttlTitle.Caption := GetNoteTitle(ttlName); SpeedRollToTitle.Enabled := True; end; end else Labelttl.Caption := rsNotAvailable; end; procedure TFormRollBack.RollBackNote(FileType, Title : string); var FFName : string; LCDStr, ErrorStr : string; begin FFName := Sett.NoteDirectory + 'Backup' + PathDelim + copy(ExtractFileNameOnly(NoteFileName), 1, 32) + FileType + '.note'; if FileExists(FFName+'-temp') then DeleteFile(FFName+'-temp'); if not (RenameFile(FFName, FFName+'-temp') and fileexistsUTF8(FFName+'-temp')) then begin debugln('ERROR, failed to move : ' + FFName); exit; end; TEditBoxForm(ShownBy).SetReadOnly(False); // Prevent a resave ShownBy.Close; // The editBox is a bit slow closing, make sure its disregarded. We did save before opening this form. SearchForm.NoteClosing(ExtractFileNameOnly(NoteFileName)); // Maybe not necessary cos we call UpdateList below ? if FileExistsUTF8(FFName) then DeleteFileUTF8(FFName); RenameFileUTF8(NoteFileName, FFName); if FileExistsUTF8(FFName) then DeleteFileUTF8(FFName); RenameFileUTF8(FFName+'-temp', NoteFileName); LCDStr := GetNoteLastChangeSt(NoteFileName, ErrorStr); // Hmm, not checking for errors ? SearchForm.UpdateList(Title, LCDStr, NoteFileName, nil); SearchForm.OpenNote(Title, NoteFileName, '', False); close; end; procedure TFormRollBack.SpeedRollToOpenClick(Sender: TObject); begin RollBackNote('-opn', LabelopnTitle.Caption); end; procedure TFormRollBack.SpeedRollToTitleClick(Sender: TObject); begin RollBackNote('-ttl', LabelttlTitle.Caption); end; procedure TFormRollBack.SpeedCancelClick(Sender: TObject); begin close; end; function TFormRollBack.GetNoteTitle(FullFileName : ANSIString) : ANSIString; var Doc : TXMLDocument; Node : TDOMNode; begin Result := 'ERROR, Title Not Found'; if FileExistsUTF8(FullFileName) then begin try try ReadXMLFile(Doc, FullFileName); Node := Doc.DocumentElement.FindNode('title'); Result := Node.FirstChild.NodeValue; except on EXMLReadError do Result := 'Note has no Title '; on EAccessViolation do Result := 'Access Violation ' + FullFileName; end; finally Doc.free; end; end; end; end. tomboy-ng_0.39-1/source/index.pas0000644000175000017500000001000514551457644016547 0ustar dbannondbannonunit Index; { Copyright (C) 2017-2020 David Bannon License: This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html ------------------ This unit find and displays all the 'headings' in a note, returns with the block index of the one user clicked. A Heading is any complete line that is all either Large or Huge text. We indent Huge, Large Bold and just Large differently so easy to see relative heading importance. HISTORY 2019/05/14 Display strings all (?) moved to resourcestrings 2020/06/14 Added lockout to deal with RH issue. } {$mode objfpc}{$H+} interface uses Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls, KMemo; type { TFormIndex } TFormIndex = class(TForm) Label1: TLabel; ListBox1: TListBox; Panel1: TPanel; procedure FormActivate(Sender: TObject); procedure FormShow(Sender: TObject); procedure ListBox1Click(Sender: TObject); private BlockClose : boolean; function IsHeading(const BlkNo: integer): integer; public TheKMemo : TKMemo; SelectedBlock : integer; end; var FormIndex: TFormIndex; implementation {$R *.lfm} { TFormIndex } uses Settings, lazlogger; procedure TFormIndex.FormShow(Sender: TObject); var Index : integer = 0; begin BlockClose := True; ModalResult := mrNone; SelectedBlock := -1; ListBox1.Items.BeginUpdate; try while Index < TheKmemo.Blocks.Count do begin while TheKMemo.Blocks.Items[Index].ClassNameIs('TKMemoParagraph') do begin inc(Index); if Index >= TheKMemo.Blocks.Count then exit; end; Index := IsHeading(Index); end; finally ListBox1.Items.EndUpdate; end; end; procedure TFormIndex.FormActivate(Sender: TObject); begin BlockClose := False; end; procedure TFormIndex.ListBox1Click(Sender: TObject); begin if (Listbox1.ItemIndex = -1) or BlockClose then begin ListBox1.ItemIndex := -1; exit; end; SelectedBlock := PtrInt(Listbox1.Items.Objects[Listbox1.ItemIndex]); //ShowMessage('Attached value: ' + IntToStr(SelectedBlock)); Modalresult := mrOK; end; function TFormIndex.IsHeading(const BlkNo : integer) : integer; var Index : integer; St : string = ''; begin Index := BlkNo; Result := BlkNo; // write('[CALLED=' + inttostr(blkno) + '] '); while Result < TheKmemo.Blocks.Count do begin if TheKMemo.Blocks.Items[Result].ClassNameIs('TKMemoParagraph') then break; inc(result); end; // writeln('[PARA=' + inttostr(Result)+']'); // Result is now pointing to first Para beyond BlkNo OR beyond kmemo content while Index < Result do begin // writeln('[' + inttostr(Index) + '] ' + TKmemoTextBlock(TheKMemo.Blocks.Items[Index]).Text); if (TheKMemo.Blocks.Items[Index].ClassNameIs('TKMemoTextBlock') and (TKmemoTextBlock(TheKMemo.Blocks.Items[Index]).TextStyle.Font.Size in [Sett.FontTitle, Sett.FontLarge, Sett.FontHuge])) then {begin writeln('================ Examined ' + TKmemoTextBlock(TheKMemo.Blocks.Items[Index]).Text);} inc(Index){; end } else // its not a heading exit(Result) // Remember we may be beyond the content .... end; // OK, its a heading, all blocks are Large or Huge. Huge=NoSpaces; LargeBold=2 spaces; Large=4 spaces if TKmemoTextBlock(TheKMemo.Blocks.Items[BlkNo]).TextStyle.Font.Size = Sett.FontLarge then begin St := '. '; if not (fsBold in TKmemoTextBlock(TheKMemo.Blocks.Items[BlkNo]).TextStyle.Font.style) then St := St + ' '; end; Index := BlkNo; while Index < Result do begin St := St + TKmemoTextBlock(TheKMemo.Blocks.Items[Index]).Text; inc(Index); end; ListBox1.AddItem(St, TObject(PtrInt(BlkNo))); inc(Result); end; end. tomboy-ng_0.39-1/source/loadnote.pas0000644000175000017500000004525014551457644017257 0ustar dbannondbannonunit LoadNote; { Copyright (C) 2017-2023 David Bannon License: This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html ------------------ This unit is responsible for loading a note into the passed Kmemo. The note is expected to be in Tomboy's XML format. Note that the class expects a few things to be passed to it, after creation that it will need before you call LoadNote(). Apart from Title and HiLight colours, this unit defers to the preset KMemo Colours. History - 20170928 - showed it how to set the title during loading rather than afterwards. saves about 200mS in a big (20K) file. 20171003 - Added a line in load file to drop any CR (#13) on the floor. Otherwise on Windows, we were reading two newlines, one for the CR and one for the LF. Its not worth an ifdef, we'll only see #13 on windows I assume ? Set the title, as loaded by this unit, to be FontTitle big. ?? 2017/10/07 - enabled bullets. 2017/11/12 - added code to restore < and > 2018/01/31 - and & 2018/03/18 Nothing 2018/03/18 Added a test it AddText to ensure we don't put an empty text block in. Issue #27 2018/07/27 Called ReplaceAngles() on string assigned to Title. 2018/08/15 ReplaceAngles() works with bytes, not char, so don't use UTF8Copy and UTF8Length .... 2018/10/13 Altered LoadFile() so Tabs are allowed through 2019/04/29 Restore note's previous previous position and size. 2019/07/21 Use Sett.TitleColour; 2020/05/01 Stop using local replaceAngles(), use tb_utils.RestoreBadXMLChar() 2021/08/27 Extensive changes to support multilevel bullets, use Tomboy or Conboy model 2022/10/31 Force default background colour while loading, it shows up ok without doing it here but blocks do not always report the correct color when asked. 2023/03/11 Allow Qt to set Text and Background colour, force Gray for Inactive Background cos Kmemo get it wrong } {$mode objfpc}{$H+} interface uses Classes, SysUtils, KMemo, Graphics; type { TBLoadNote } TBLoadNote = class private InContent : boolean; FirstTime : boolean; // Set when first line (Title) is added to KMemo Bold : boolean; Italic : boolean; HighLight : boolean; Underline : boolean; Strikeout : boolean; FixedWidth : boolean; //InBullet, BulletOwing : boolean; BulletLevel : integer; InStr : ANSIString; KM : TKMemo; { Is passed an XML tag content, such as bold or /italics and sets up the regional vars so that AddText knows how to markup the next block} procedure ActOnTag(buff: string); { This procedure writes note content to the KMemo in EditBox. It relies on the Global constants (in the Settings Unit) to tell it about style, and size. The Regional InStr has what to write. A number of 'state' regional vars (ie Bold, Strikeout) tell it about the active styles at present. This method adds one textblock (or possibly parablock) from InStr to the kmemo. It gets called when LoadFile() encounters a newline or the start of a Tag.} procedure AddText(AddPara : Boolean); { called when ReadTag encounters a , process through to corresponding including any intermediat pairs. Ignores any newlines in content during this period. Drops any content that is not between tags. We arrive here after having read the first '. Remove trailing newline before returning. InStr should be empty and BulletLevel should be zero.} procedure ReadList(fs: TFileStream); { Gets called when LoadFile finds the start of a tag. It immediatly calls AddText to flush any existing content to Kmemo and then looks at tag.} Procedure ReadTag(fs : TFileStream); public FontSize : integer; // Must be set externally after creation // FontName : ANSIstring; // Must be set externally after creation Title : ANSIString; // Read from the note being loaded. // BulletString : ANSIString; // as above FontNormal : integer; // as above CreateDate : ANSIString; X, Y : integer; Height, Width : integer; { Public : the main, lets do it method } procedure LoadFile(FileName : ANSIString; RM : TKMemo); end; implementation uses // For some font style defs LazUTF8, Settings, // User settings and some defines across units. TB_Utils, LazLogger; procedure TBLoadNote.LoadFile(FileName : ANSIString; RM : TKMemo); var fs : TFileStream; ch : char = ' '; Blocks : longint = 0; begin KM := RM; FirstTime := True; fs := TFileStream.Create(Utf8ToAnsi(FileName), fmOpenRead or fmShareDenyNone); try while fs.Position < fs.Size do begin fs.read(ch, 1); if Ch = #13 then fs.read(ch, 1); // drop #13 on floor. Silly Windows double newline. if Ch = #9 then Ch := ' '; // ToDo : this is temp cludge, KMemo cannot handle tabs, they // come in via pasted text, better fix during the paste process. // This might mess with UTF8 ?? if (Ch = '<') or (Ch < ' ') then begin // start of tag or ctrl char if (Ch < ' ') then // thats a newline (other ctrl ? drop on floor) AddText(True) // flush through to kMemo, new paragraph else begin AddText(false); // flush through to kmemo ReadTag(fs); // deals with _only_ tag unless its a list tag ! end; inc(Blocks); InStr := ''; // AddText does that ???? Maybe not in every case ? end else InStr := InStr + ch; end; finally FreeAndNil(fs); end; //debugln('TBLoadNote.LoadFile Height=' + inttostr(Height) + ' Width=' + inttostr(Width)); end; procedure TBLoadNote.AddText(AddPara : Boolean); var FT : TFont; PB : TKMemoParagraph; TB : TKMemoTextBlock ; //T1, T2 : qword; begin if not InContent then exit; if (InStr = '') and (not AddPara) then exit; // if to here, we have content to flush or a new para has been requested. //debugln('TBLoadNote.AddText bulletlevel=' + inttostr(bulletLevel) + ', BOLD=' + booltostr(Bold, true) + ' and InStr=[' + ']'); if InStr <> '' then begin FT := TFont.Create(); if FirstTime then begin // Title FT.Style := [fsUnderline]; Title := RestoreBadXMLChar(InStr); // SyncUtils Function FT.Size := Sett.FontTitle; FT.Color := Sett.TitleColour; end else begin FT.Style := []; FT.Size:= FontSize; FT.Color := Sett.TextColour; end; TB := KM.Blocks.AddTextBlock(RestoreBadXMLChar(InStr)); // TB.TextStyle.Brush.Color := Sett.BackGndColour; //LocalBackGndColour; if Bold then FT.Style := FT.Style + [fsBold]; if Italic then FT.Style := FT.Style + [fsItalic]; if HighLight then TB.TextStyle.Brush.Color := Sett.HiColour; if Underline then FT.Style := Ft.Style + [fsUnderline]; if Strikeout then FT.Style := Ft.Style + [fsStrikeout]; if FixedWidth then FT.Name := Sett.FixedFont; if FixedWidth then FT.Pitch := fpFixed; if not FixedWidth then FT.Name := Sett.UsualFont; // Because 'FixedWidth := false;' does not specify a font to return to // if Sett.DarkTheme then Ft.Color:=Sett.DarkTextColour; TB.TextStyle.Font := Ft; FT.Free; end; InStr := ''; if AddPara then begin PB := KM.Blocks.AddParagraph; if BulletLevel > 0 then begin {$if declared(pnuCircleBullets)} // Note IDE assumes true, versions of KControls earlier than Late August 2021 are FALSE case BulletLevel of 1 : begin //debugln('AddText - BulletLevel One'); PB.Numbering:=BulletOne; PB.NumberingListLevel.FirstIndent:=-20; // Ahh ! some magic numbers ? PB.NumberingListLevel.LeftIndent := 30; // Note, these numbers need match SettBullet() in editbox end; 2 : begin //debugln('AddText - BulletLevel Two'); PB.Numbering:=pnuNone; PB.Numbering := BulletTwo; PB.NumberingListLevel.FirstIndent:=-20; PB.NumberingListLevel.LeftIndent := 50; end; 3 : begin PB.Numbering:=pnuNone; PB.Numbering := BulletThree; PB.NumberingListLevel.FirstIndent:=-20; PB.NumberingListLevel.LeftIndent := 70; end; 4 : begin PB.Numbering:=pnuNone; PB.Numbering := BulletFour; PB.NumberingListLevel.FirstIndent:=-20; PB.NumberingListLevel.LeftIndent := 90; end; 5 : begin PB.Numbering:=pnuNone; PB.Numbering := BulletFive; PB.NumberingListLevel.FirstIndent:=-20; PB.NumberingListLevel.LeftIndent := 110; end; 6,7,8,9 : begin PB.Numbering:=pnuNone; PB.Numbering := BulletSix; PB.NumberingListLevel.FirstIndent:=-20; PB.NumberingListLevel.LeftIndent := 130; end; otherwise debugln('LoadNote.AddText - BulletLevel otherwise, ' + inttostr(BulletLevel)); // we just stop at 4 end; BulletLevel := 0; {$else} PB.Numbering := pnuBullets; PB.NumberingListLevel.FirstIndent := -20; // Note, these numbers need match SettBullet() in editbox PB.NumberingListLevel.LeftIndent := 30; {$endif} end; end; if FirstTime then begin FirstTime := false; KM.Blocks.DeleteEOL(0); end; end; procedure TBLoadNote.ActOnTag(buff : string); begin case Buff of 'note-content' : InContent := true; '/note-content' : InContent := false; 'bold' : Bold := True; '/bold' : Bold := False; 'italic' : Italic := True; '/italic' : Italic := false; 'highlight' : HighLight := true; '/highlight' : HighLight := false; 'underline' : Underline := true; '/underline' : Underline := false; 'strikeout' : Strikeout := true; '/strikeout' : Strikeout := false; 'monospace' : FixedWidth := true; '/monospace' : FixedWidth := false; 'size:small' : FontSize := Sett.FontSmall; '/size:small' : FontSize := Sett.FontNormal; 'size:large' : FontSize := Sett.FontLarge; '/size:large' : FontSize := Sett.FontNormal; 'size:huge' : FontSize := Sett.FontHuge; '/size:huge' : FontSize := Sett.FontNormal; '/create-date' : CreateDate := InStr; '/x' : X := strtointDef(InStr, 20); '/y' : Y := strtointDef(InStr, 20); // '/width' : Width := strtointdef(InStr, 300); // '/height' : height := strtointdef(InStr, 200); 'text', 'note' : ; // a block of tags we ignore here. 'x', 'y', 'title', '/title', '?xml', 'last-change-date', '/last-change-date', 'width', 'height', '/text' : ; 'create-date', 'cursor-position', '/cursor-position', 'selection-bound-position', '/selection-bound-position' : ; 'open-on-startup', '/open-on-startup', '/note', 'last-metadata-change-date', '/last-metadata-change-date' : ; 'tag', '/tag', 'tags', '/tags', 'link:broken', '/link:broken', '/width', '/height' : ; // Note we do not process AND should not get 'list', '/list', 'list-item', '/list-item' here. otherwise debugln('TBLoadNote.ActOnTag ERROR sent an unrecognised tag [' + Buff + ']'); end; end; procedure TBLoadNote.ReadList(fs : TFileStream); var Buff : String; Ch : char = ' '; ST : string = ''; ListCount : integer = 1; function FindNextTag(OnIt : boolean) : boolean; begin Buff := ''; Result := false; if (not OnIt) and (fs.Position < fs.Size) then fs.read(Ch, 1); while fs.Position < fs.Size do begin if ch='<' then break; fs.read(Ch, 1); end; if Ch <> '<' then begin debugln('TBLoadNote.ReadList - ERROR, early exit from FindNextTag'); exit(false); end; while fs.Position < fs.Size do begin // Capture the tag fs.read(Ch, 1); if (Ch = '>') or (Ch = ' ') then break; // end of the content we need. Buff := Buff + ch; end; if Ch in [' ', '>'] then begin while (ch<>'>') and (fs.Position < fs.Size) do begin fs.read(Ch, 1); if Ch = '>' then break; end; Result := Ch = '>'; end else debugln('TBLoadNote.ReadList - ERROR failed to find end of list'); //if result then debugln('FindNextTag = ' + buff ); end; procedure ListSt2KMemo(); var i : integer = 1; ATag : string = ''; begin // debugln('++++++++++ LstSt2KMemo : ' + St); InStr := ''; BulletLevel := ListCount; while i <= St.length do begin if St[i] = '<' then begin // start of a tag while i < St.length do begin inc(i); if St[i] = '>' then break else ATag := ATag + St[i]; end; if St[i] <> '>' then begin debugln('TBLoadNote.ReadList ERROR missing > in ' + St); exit; end; AddText(False); //debugln('call ActOnTag with ' + ATag); ActOnTag(ATag); ATag := ''; inc(i); end else begin InStr := InStr + St[i]; inc(i); end; end; AddText(True); BulletLevel := 0; St := ''; //debugln('++++++++++ Leaving LstSt2KMemo : ' + St); end; begin if (InStr <> '') or (BulletLevel <> 0) then debugln('--------------- Bugger --------------'); // Find the next tag, should always be list-item, ignore anything between //debugln('----------- We have just entered ReadList ---------'); try if FindNextTag(False) and (Buff='list-item') then // Anything up to next list related tag is content. while fs.Position < fs.Size do begin fs.read(Ch, 1); if Ch in [#10, #13] then continue; // ignore newline in list mode if ch='<' then begin if FindNextTag(True) then begin // debugln('ReadList, tag=[' + Buff + '] and St=' + St); case Buff of 'list' : begin if St <> '' then ListSt2KMemo(); inc(ListCount); end; '/list' : if ListCount = 1 then exit else dec(ListCount); '/list-item' : if St <> '' then ListSt2KMemo(); 'list-item' : ; // I THINK we don't need do anything with that ?? otherwise St := St + '<' + Buff + '>'; // put it back where you found it end; end; end else St := St + Ch; end else exit; debugln('TBLoadNote.ReadList - ERROR, hit bottom of method'); finally { We are left here with a trailing newline, remove it but we don't know if the note was created in Unix or Windows } if fs.Position < fs.Size then begin fs.read(Ch, 1); if ch <> #10 then begin // Linux and mac, what we expect if ch = #13 then begin // B8#$# Windows fs.read(Ch, 1); // OK, is probably #13#10 if ch <> #10 then // Woops, stop messing here ! fs.Seek(-1, fsFromCurrent); // That should never happen end else fs.Seek(-1, fsFromCurrent); // note #10, not #13 poke it back and run away ! end; end; //debugln('----------- We have just left ReadList ---------'); end; end; Procedure TBLoadNote.ReadTag(fs : TFileStream); // we are here because '<' var Buff : String; Ch : char = ' '; begin //Addtext(False); // Write the text we have so far with existing params Buff := ''; // now, lets set new params or get other data while fs.Position < fs.Size do begin fs.read(Ch, 1); if (Ch = '>') or (Ch = ' ') then begin // we will exit after case statement // if InContent then debugln('ReadTag - Testing ' + Buff); if Buff = 'list' then ReadList(fs) else begin // debugln('Sending tag to ActOnTag =' + Buff); ActOnTag(Buff); end; while Ch <> '>' do fs.read(Ch, 1); // eat everything else in the tag exit; end; Buff := Buff + Ch; end; end; { When we hit a List or a /list-item, if there is content in InStr, flush it. } end. tomboy-ng_0.39-1/source/colours.lfm0000644000175000017500000002310414551457644017125 0ustar dbannondbannonobject FormColours: TFormColours Left = 342 Height = 274 Top = 235 Width = 450 Caption = 'FormColours' ClientHeight = 274 ClientWidth = 450 OnCreate = FormCreate OnShow = FormShow LCLVersion = '2.2.0.2' object KMemo1: TKMemo Left = 8 Height = 168 Top = 40 Width = 256 ContentPadding.Left = 5 ContentPadding.Top = 5 ContentPadding.Right = 5 ContentPadding.Bottom = 5 ParentFont = False TabOrder = 0 Visible = True end object Label1: TLabel Left = 10 Height = 21 Top = 16 Width = 58 Caption = 'Sample' end object Label2: TLabel Left = 280 Height = 21 Top = 16 Width = 91 Caption = 'Set Colours' end object SpeedTitle: TSpeedButton Left = 280 Height = 26 Top = 40 Width = 140 Caption = 'Title' OnClick = SpeedTitleClick end object SpeedText: TSpeedButton Left = 280 Height = 26 Top = 75 Width = 140 Caption = 'Text' OnClick = SpeedTextClick end object SpeedBackground: TSpeedButton Left = 280 Height = 26 Top = 111 Width = 140 Caption = 'Background' OnClick = SpeedBackgroundClick end object SpeedHighlight: TSpeedButton Left = 280 Height = 26 Top = 146 Width = 140 Caption = 'Highlight' OnClick = SpeedHighlightClick end object SpeedDefault: TSpeedButton Left = 128 Height = 26 Top = 224 Width = 100 Caption = 'Default' Glyph.Data = { 36040000424D3604000000000000360000002800000010000000100000000100 2000000000000004000064000000640000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00002F2F8EFF1F1F86FF1C1C85FF1C1C85FF1C1C85FF1C1C85FF1C1C85FF1C1C 84FF1C1C83FF1B1B81C61B1B7E6A1B1B7D070000000000000000000000000000 0000323299FF232392FF202091FF202091FF202091FF202091FF202091FF2020 91FF20208FFF1E1E8CFF1C1C85FF1B1B7FD51B1B7D1500000000000000000000 000039399EFF33339BFF32329AFF32329AFF32329AFF32329AFF32329AFF3232 9AFF31319AFF2E2E98FF252592FF1D1D88FF1A1A7FD51B1B7D07000000000000 0000000000000000000000000000000000000000000000000000000000000000 00003C3C9F0E3A3A9F6A35359CF8252592FF1C1C85FF1B1B7E6A000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000003A3A9F6A2E2E98FF1E1E8CFF1B1B81C6000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000003C3C9F0E30309AFF20208FFF1C1C83FF000000000000 0000000000002929842B00000000000000000000000000000000000000000000 0000000000000000000034349A0E2C2C97FF1F1F90FF1D1D85FF000000000000 000029298C2B222284EA00000000000000000000000000000000000000000000 000000000000000000002A2A956A232393FF1E1E8FFF1E1E86C6000000002929 8F2B24248EEA1C1C85FF00000000000000000000000000000000000000000000 00001F1F850E21218B6A212190F81E1E91FF1F1F8DFF2222876A3131932B2626 91EA1F1F90FF1C1C89FF1C1C85FF1C1C85FF1C1C85FF1C1C85FF1C1C85FF1C1C 85FF1D1D89FF1E1E8EFF1E1E91FF202091FF25258DD52727880738389AD52B2B 97FF202092FF1E1E90FF1F1F90FF202091FF202091FF202091FF202091FF2020 91FF202091FF212193FF252593FF2A2A92D52C2C8F15000000003C3C9F2B3838 9EEA2A2A97FF202092FF262694FF303099FF32329AFF32329AFF32329AFF3232 9AFF32329AFF313198C63232976A333394070000000000000000000000003C3C A02B38389DEA2A2A92FF00000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00003C3C9C2B363692EA00000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000003A3A8F2B00000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000 } OnClick = SpeedDefaultClick end object SpeedCancel: TSpeedButton Left = 232 Height = 26 Top = 224 Width = 100 Caption = 'Cancel' Glyph.Data = { 36040000424D3604000000000000360000002800000010000000100000000100 2000000000000004000064000000640000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000500B6690500B669000000000000000000000000000000000000 0000000000000500B6690500B669000000000000000000000000000000000000 00000200B5680C00CFE90D00D0EB0500B66D0000000000000000000000000000 00000200B56B0C00CFE90D00D0EB0500B86B0000000000000000000000000000 00000200B5680C00CFE91400E6FF0D00D0EB0500B66D00000000000000000200 B56B0C00CFE91400E6FF0D00D0EB0500B86B0000000000000000000000000000 0000000000000300B7660C00CFE91400E6FF0D00D1EB0500B66D0300B6650C00 CFE91400E6FF0D00D1EB0500B66D000000000000000000000000000000000000 000000000000000000000500B66C0C00CFEA1400E6FF0C00D0EA0C00D0EA1400 E6FF0C00CFEA0500B66C00000000000000000000000000000000000000000000 00000000000000000000000000000200B56B0C00D0E81400E6FF1400E6FF0D00 D0EB0500B66D0000000000000000000000000000000000000000000000000000 00000000000000000000000000000200B56B0C00D0E81400E6FF1400E6FF0D00 D0EB0500B66D0000000000000000000000000000000000000000000000000000 000000000000000000000500B66C0C00CFEA1400E6FF0C00D0EA0C00D0EA1400 E6FF0C00CFEA0500B66C00000000000000000000000000000000000000000000 0000000000000300B6650C00CFE91400E6FF0D00D1EB0500B66D0300B7660C00 CFE91400E6FF0D00D1EB0500B66D000000000000000000000000000000000000 00000200B5680C00CFE91400E6FF0D00D0EB0500B66D00000000000000000200 B56B0C00CFE91400E6FF0D00D0EB0500B86B0000000000000000000000000000 00000200B5680C00CFE90D00D0EB0500B66D0000000000000000000000000000 00000200B56B0C00CFE90D00D0EB0500B86B0000000000000000000000000000 0000000000000500B66C0500B66C000000000000000000000000000000000000 0000000000000500B6690500B669000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000 } OnClick = SpeedCancelClick end object SpeedOK: TSpeedButton Left = 336 Height = 26 Top = 224 Width = 100 Caption = 'OK' Glyph.Data = { 36040000424D3604000000000000360000002800000010000000100000000100 2000000000000004000064000000640000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000001007B001D00000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00000000000000000000000000010D9019A3149927DC0A870F33000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000010D9019A12CBA5AF937C771FF18A031DB0A870F330000 0000000000000000000000000000000000000000000000000000000000000000 0000000000010D9019A12CBA5AF937C871FF37C871FF37C771FF18A031DB0A87 0F33000000000000000000000000000000000000000000000000000000000000 00010D9019A32DBC5DF837C871FF2DBC5DF819A133E337C771FF37C771FF179E 30DB0A870F330000000000000000000000000000000000000000000000000A8D 159B2DBC5DF837C871FF2DBC5DF80D9019A30A890F34179E30DB37C771FF37C7 71FF179E30DB0A870F3300000000000000000000000000000000000000000587 0A31169D2EDA2EBD5EFA0E901AA6008000020000000005870A31169D2EDA37C7 70FF37C771FF18A031DB0A870F33000000000000000000000000000000000000 00000A870F330A8D149B000000010000000000000000000000000A870F33179E 30DB37C771FF37C771FF179E30DB0A870F330000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000587 0A31169D2EDA37C770FF37C771FF18A031DB0A870F3300000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00000A870F33179E30DB37C771FF2DBC5DF80A8D159B00000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00000000000005870A31139928DB0E901AA60000000100000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00000000000000000000007B001D000000010000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000 } OnClick = SpeedOKClick end object SpeedLinks: TSpeedButton Left = 280 Height = 26 Top = 182 Width = 140 Caption = 'Links' OnClick = SpeedLinksClick end object ColorDialog1: TColorDialog Color = clBlack CustomColors.Strings = ( 'ColorA=000000' 'ColorB=000080' 'ColorC=008000' 'ColorD=008080' 'ColorE=800000' 'ColorF=800080' 'ColorG=808000' 'ColorH=808080' 'ColorI=C0C0C0' 'ColorJ=0000FF' 'ColorK=00FF00' 'ColorL=00FFFF' 'ColorM=FF0000' 'ColorN=FF00FF' 'ColorO=FFFF00' 'ColorP=FFFFFF' 'ColorQ=C0DCC0' 'ColorR=F0CAA6' 'ColorS=F0FBFF' 'ColorT=A4A0A0' ) Left = 160 end end tomboy-ng_0.39-1/source/settings.lfm0000644000175000017500000014027014551457644017303 0ustar dbannondbannonobject Sett: TSett Left = 736 Height = 530 Top = 259 Width = 726 BorderIcons = [] Caption = 'Form Caption' ClientHeight = 530 ClientWidth = 726 OnClose = FormClose OnCreate = FormCreate OnDestroy = FormDestroy OnHide = FormHide OnKeyDown = FormKeyDown OnShow = FormShow LCLVersion = '3.0.0.3' object PageControl1: TPageControl AnchorSideLeft.Control = Owner AnchorSideTop.Control = Owner AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = SpeedButHide Left = 0 Height = 488 Top = 0 Width = 726 ActivePage = TabDisplay Anchors = [akTop, akLeft, akRight, akBottom] BorderSpacing.Bottom = 2 TabIndex = 1 TabOrder = 0 OnChange = PageControl1Change object TabBasic: TTabSheet Caption = 'Basic' ClientHeight = 449 ClientWidth = 720 OnResize = TabBasicResize object LabelSettingPath: TLabel AnchorSideLeft.Control = Label1 AnchorSideTop.Control = Label1 AnchorSideTop.Side = asrBottom Left = 7 Height = 21 Top = 39 Width = 136 BorderSpacing.Top = 3 Caption = 'LabelSettingPath' end object LabelNotesPath: TLabel AnchorSideLeft.Control = Label1 AnchorSideTop.Control = Label2 AnchorSideTop.Side = asrBottom Left = 7 Height = 21 Top = 109 Width = 127 BorderSpacing.Top = 3 Caption = 'LabelNotesPath' end object Label1: TLabel AnchorSideLeft.Control = TabBasic AnchorSideTop.Control = TabBasic Left = 7 Height = 21 Top = 15 Width = 195 BorderSpacing.Left = 7 BorderSpacing.Top = 15 Caption = 'Settings will be saved in :' end object Label2: TLabel AnchorSideLeft.Control = Label1 AnchorSideTop.Control = LabelSettingPath AnchorSideTop.Side = asrBottom Left = 7 Height = 21 Top = 85 Width = 297 BorderSpacing.Top = 25 Caption = 'Notes will be looked for and saved in :' end object CheckAutostart: TCheckBox AnchorSideLeft.Control = CheckShowSplash AnchorSideTop.Control = CheckNotifications AnchorSideTop.Side = asrBottom Left = 20 Height = 25 Top = 383 Width = 173 BorderSpacing.Top = 25 Caption = 'Autostart at Logon' TabOrder = 0 OnChange = CheckAutostartChange end object CheckShowSearchAtStart: TCheckBox AnchorSideTop.Control = CheckShowSplash Left = 380 Height = 25 Top = 283 Width = 186 BorderSpacing.Left = 10 Caption = 'Show Search at Start' TabOrder = 1 OnChange = SaveSettings end object CheckShowSplash: TCheckBox AnchorSideLeft.Control = GroupNotesPath AnchorSideTop.Control = GroupNotesPath AnchorSideTop.Side = asrBottom Left = 20 Height = 25 Hint = 'Always shown if error loading notes.' Top = 283 Width = 184 BorderSpacing.Left = 10 BorderSpacing.Top = 35 Caption = 'Show Splash at Start' Checked = True ParentShowHint = False ShowHint = True State = cbChecked TabOrder = 2 OnChange = SaveSettings end object CheckNotifications: TCheckBox AnchorSideLeft.Control = CheckShowSplash AnchorSideTop.Control = CheckShowSplash AnchorSideTop.Side = asrBottom Left = 20 Height = 25 Top = 333 Width = 171 BorderSpacing.Top = 25 Caption = 'Show Notifications' Checked = True State = cbChecked TabOrder = 3 OnChange = SaveSettings end object CheckEscClosesNote: TCheckBox AnchorSideLeft.Control = CheckShowSearchAtStart AnchorSideTop.Control = CheckNotifications Left = 380 Height = 25 Top = 333 Width = 154 Caption = 'ESC Closes Note' TabOrder = 4 OnChange = SaveSettings end object GroupNotesPath: TGroupBox AnchorSideLeft.Control = TabBasic AnchorSideTop.Control = LabelNotesPath AnchorSideRight.Control = TabBasic AnchorSideRight.Side = asrBottom Left = 10 Height = 104 Top = 144 Width = 700 Anchors = [akTop, akLeft, akRight] BorderSpacing.Left = 10 BorderSpacing.Top = 35 BorderSpacing.Right = 10 Caption = 'Notes Path' ClientHeight = 81 ClientWidth = 696 TabOrder = 5 object RadioChoose: TRadioButton AnchorSideLeft.Control = ButtonSetNotePath AnchorSideTop.Control = RadioTomboyNGDefault AnchorSideTop.Side = asrCenter Left = 454 Height = 25 Top = 8 Width = 83 Caption = 'Choose' TabOrder = 0 OnClick = RadioNotePathChange end object RadioTomboyDefault: TRadioButton AnchorSideLeft.Control = RadioTomboyNGDefault AnchorSideTop.Control = RadioTomboyNGDefault AnchorSideTop.Side = asrBottom Left = 10 Height = 25 Top = 43 Width = 184 BorderSpacing.Top = 10 Caption = 'Old Tomboy Default' TabOrder = 1 OnClick = RadioNotePathChange end object RadioTomboyNGDefault: TRadioButton AnchorSideLeft.Control = GroupNotesPath Left = 10 Height = 25 Top = 8 Width = 179 BorderSpacing.Left = 10 Caption = 'tomboy-ng Default' Checked = True Font.Style = [fsBold] ParentFont = False TabOrder = 3 TabStop = True OnClick = RadioNotePathChange end object ButtonSetNotePath: TButton AnchorSideTop.Control = RadioTomboyDefault AnchorSideTop.Side = asrCenter AnchorSideRight.Control = GroupNotesPath AnchorSideRight.Side = asrBottom Left = 454 Height = 32 Hint = 'If you have notes somewhere else' Top = 39 Width = 232 Anchors = [akTop, akRight] BorderSpacing.Top = 4 BorderSpacing.Right = 10 Caption = 'Set Path to Note Files' ParentShowHint = False ShowHint = True TabOrder = 2 OnClick = ButtonSetNotePathClick end end end object TabDisplay: TTabSheet Caption = 'Notes' ClientHeight = 449 ClientWidth = 720 ParentShowHint = False ShowHint = True object GroupBox5: TGroupBox Left = 32 Height = 176 Top = 24 Width = 264 Caption = 'Font Size' ClientHeight = 153 ClientWidth = 260 TabOrder = 7 object RadioFontBig: TRadioButton AnchorSideLeft.Control = GroupBox5 Left = 19 Height = 25 Top = 52 Width = 49 Anchors = [akLeft] BorderSpacing.Left = 19 Caption = 'Big' Checked = True TabOrder = 0 TabStop = True OnChange = SaveSettings end object RadioFontMedium: TRadioButton AnchorSideLeft.Control = GroupBox5 Left = 19 Height = 25 Top = 88 Width = 88 Anchors = [akLeft] BorderSpacing.Left = 19 Caption = 'Medium' TabOrder = 1 OnChange = SaveSettings end object RadioFontSmall: TRadioButton AnchorSideLeft.Control = GroupBox5 Left = 19 Height = 25 Top = 124 Width = 67 Anchors = [akLeft] BorderSpacing.Left = 19 Caption = 'Small' TabOrder = 2 OnChange = SaveSettings end object RadioFontHuge: TRadioButton AnchorSideLeft.Control = GroupBox5 Left = 19 Height = 25 Top = 17 Width = 66 Anchors = [akLeft] BorderSpacing.Left = 19 Caption = 'Huge' TabOrder = 3 OnChange = SaveSettings end end object CheckShowIntLinks: TCheckBox AnchorSideLeft.Control = GroupBox5 AnchorSideTop.Control = GroupBox5 AnchorSideTop.Side = asrBottom Left = 32 Height = 25 Top = 220 Width = 177 BorderSpacing.Top = 20 Caption = 'Show Internal Links' TabOrder = 0 OnChange = SaveSettings end object CheckShowExtLinks: TCheckBox AnchorSideLeft.Control = GroupBox5 AnchorSideTop.Control = CheckShowIntLinks AnchorSideTop.Side = asrBottom Left = 32 Height = 25 Top = 263 Width = 181 BorderSpacing.Top = 18 Caption = 'Show External Links' TabOrder = 1 OnChange = SaveSettings end object CheckManyNotebooks: TCheckBox AnchorSideLeft.Control = GroupBox5 AnchorSideTop.Control = CheckShowExtLinks AnchorSideTop.Side = asrBottom Left = 32 Height = 25 Hint = 'This may adversly affect traditional Tomboy, take care.' Top = 306 Width = 354 BorderSpacing.Top = 18 Caption = 'Allow a Note to be in Multiple Notebooks.' ParentShowHint = False ShowHint = True TabOrder = 2 OnChange = SaveSettings end object ButtonFont: TButton AnchorSideLeft.Control = ComboHelpLanguage AnchorSideRight.Side = asrBottom Left = 402 Height = 25 Top = 32 Width = 167 Anchors = [akTop, akLeft, akRight] Caption = 'Usual Font' ParentShowHint = False ShowHint = True TabOrder = 4 OnClick = ButtonFontClick end object ButtonFixedFont: TButton AnchorSideLeft.Control = ComboHelpLanguage AnchorSideTop.Control = ButtonFont AnchorSideTop.Side = asrBottom AnchorSideRight.Control = ButtonFont AnchorSideRight.Side = asrBottom Left = 402 Height = 25 Top = 74 Width = 167 Anchors = [akTop, akLeft, akRight] BorderSpacing.Top = 17 Caption = 'Fixed Font' ParentShowHint = False ShowHint = True TabOrder = 5 OnClick = ButtonFixedFontClick end object ButtonSetColours: TButton AnchorSideLeft.Control = ComboHelpLanguage AnchorSideTop.Control = CheckUseUndo AnchorSideTop.Side = asrBottom AnchorSideRight.Side = asrBottom Left = 402 Height = 32 Top = 392 Width = 240 BorderSpacing.Top = 18 Caption = 'Set Colours' TabOrder = 3 OnClick = ButtonSetColoursClick end object ComboHelpLanguage: TComboBox AnchorSideLeft.Control = ButtonFont AnchorSideRight.Control = TabDisplay AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = GroupBox5 AnchorSideBottom.Side = asrBottom Left = 402 Height = 32 Top = 168 Width = 288 Anchors = [akRight, akBottom] AutoSize = False BorderSpacing.Right = 30 ItemHeight = 0 Style = csDropDownList TabOrder = 6 OnChange = ComboHelpLanguageChange end object Label10: TLabel AnchorSideLeft.Control = ComboHelpLanguage AnchorSideTop.Control = ComboHelpLanguage AnchorSideTop.Side = asrBottom AnchorSideBottom.Control = ComboHelpLanguage Left = 402 Height = 21 Top = 146 Width = 170 Anchors = [akLeft, akBottom] BorderSpacing.Bottom = 1 Caption = 'Help Notes Language' end object CheckUseUndo: TCheckBox AnchorSideTop.Control = CheckManyNotebooks AnchorSideTop.Side = asrBottom Left = 32 Height = 25 Hint = 'Close and reopen a note to take effect. Use Ctrl-Z Ctrl-Y' Top = 349 Width = 293 BorderSpacing.Top = 18 Caption = 'Use Undo Redo (may slow editing)' Checked = True ParentShowHint = False ShowHint = True State = cbChecked TabOrder = 8 OnChange = SaveSettings end object ComboDateFormat: TComboBox AnchorSideLeft.Control = ComboHelpLanguage AnchorSideTop.Control = Label17 AnchorSideTop.Side = asrBottom AnchorSideRight.Control = ComboHelpLanguage AnchorSideRight.Side = asrBottom Left = 402 Height = 32 Top = 258 Width = 288 Anchors = [akTop, akLeft, akRight] AutoSize = False BorderSpacing.Top = 5 ItemHeight = 0 Style = csDropDownList TabOrder = 9 OnChange = SaveSettings end object Label17: TLabel AnchorSideLeft.Control = ComboHelpLanguage AnchorSideTop.Control = ComboHelpLanguage AnchorSideTop.Side = asrBottom Left = 402 Height = 21 Top = 232 Width = 153 BorderSpacing.Top = 32 Caption = 'Date Stamp Format' end object CheckStampItalics: TCheckBox AnchorSideLeft.Control = ComboDateFormat AnchorSideTop.Control = CheckStampSmall Left = 402 Height = 25 Top = 298 Width = 70 Caption = 'Italics' ParentShowHint = False TabOrder = 10 OnChange = SaveSettings end object CheckStampSmall: TCheckBox AnchorSideTop.Control = ComboDateFormat AnchorSideTop.Side = asrBottom AnchorSideRight.Control = ComboDateFormat AnchorSideRight.Side = asrBottom Left = 623 Height = 25 Top = 298 Width = 67 Anchors = [akTop, akRight] BorderSpacing.Top = 8 Caption = 'Small' ParentShowHint = False TabOrder = 11 OnChange = SaveSettings end object CheckStampBold: TCheckBox AnchorSideLeft.Control = CheckStampItalics AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = CheckStampItalics AnchorSideRight.Control = CheckStampSmall Left = 522 Height = 25 Top = 298 Width = 60 BorderSpacing.Left = 50 Caption = 'Bold' ParentShowHint = False TabOrder = 12 OnChange = SaveSettings end object CheckFindToggles: TCheckBox AnchorSideLeft.Control = CheckUseUndo AnchorSideTop.Control = CheckUseUndo AnchorSideTop.Side = asrBottom Left = 32 Height = 25 Hint = 'eg Ctrl-F opens and closes Find Window' Top = 392 Width = 207 BorderSpacing.Top = 18 Caption = 'Find Command Toggles' Checked = True State = cbChecked TabOrder = 13 OnChange = SaveSettings end end object TabSync: TTabSheet Caption = 'Sync' ClientHeight = 449 ClientWidth = 720 object GroupBox4: TGroupBox AnchorSideLeft.Control = TabSync AnchorSideTop.Control = GroupBoxSync AnchorSideTop.Side = asrBottom AnchorSideRight.Control = TabSync AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = TabSync AnchorSideBottom.Side = asrBottom Left = 3 Height = 142 Top = 304 Width = 714 Anchors = [akTop, akLeft, akRight, akBottom] BorderSpacing.Left = 3 BorderSpacing.Top = 6 BorderSpacing.Right = 3 BorderSpacing.Bottom = 3 Caption = 'When a conflict is detected between a local note and remote one :' ClientHeight = 119 ClientWidth = 710 ParentColor = False TabOrder = 0 object RadioAlwaysAsk: TRadioButton AnchorSideLeft.Control = GroupBox4 AnchorSideTop.Control = GroupBox4 Left = 15 Height = 25 Top = 15 Width = 234 BorderSpacing.Left = 15 BorderSpacing.Top = 15 Caption = 'Always Ask me what to do.' Checked = True TabOrder = 0 TabStop = True end object RadioUseLocal: TRadioButton AnchorSideLeft.Control = RadioAlwaysAsk AnchorSideTop.Control = RadioAlwaysAsk AnchorSideTop.Side = asrBottom Left = 15 Height = 25 Top = 55 Width = 363 BorderSpacing.Top = 15 Caption = 'Use Local Note and Overwrite Server Note.' TabOrder = 1 end object RadioUseServer: TRadioButton AnchorSideLeft.Control = RadioAlwaysAsk AnchorSideTop.Control = RadioUseLocal AnchorSideTop.Side = asrBottom Left = 15 Height = 25 Top = 95 Width = 348 BorderSpacing.Top = 15 Caption = 'Use Server Note and Rename Local Note.' TabOrder = 2 end end object Label12: TLabel Left = 14 Height = 1 Top = 49 Width = 1 end object GroupBoxSync: TGroupBox AnchorSideLeft.Control = TabSync AnchorSideTop.Control = LabelSyncType AnchorSideTop.Side = asrBottom AnchorSideRight.Control = TabSync AnchorSideRight.Side = asrBottom Left = 3 Height = 247 Top = 51 Width = 714 Anchors = [akTop, akLeft, akRight] BorderSpacing.Left = 3 BorderSpacing.Top = 15 BorderSpacing.Right = 3 Caption = ' Sync ' ClientHeight = 243 ClientWidth = 710 ParentColor = False TabOrder = 1 object Label4: TLabel AnchorSideLeft.Control = GroupBoxSync AnchorSideTop.Control = LabelSyncInfo2 AnchorSideTop.Side = asrBottom Left = 15 Height = 21 Top = 85 Width = 53 BorderSpacing.Left = 15 BorderSpacing.Top = 18 Caption = 'Repo : ' end object LabelSyncRepo: TLabel AnchorSideLeft.Control = Label4 AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = Label4 Left = 69 Height = 21 Top = 85 Width = 117 BorderSpacing.Left = 1 Caption = 'not configured' end object SpeedSetupSync: TSpeedButton AnchorSideRight.Control = GroupBoxSync AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = GroupBoxSync AnchorSideBottom.Side = asrBottom Left = 546 Height = 28 Top = 205 Width = 154 Anchors = [akRight, akBottom] BorderSpacing.Right = 10 BorderSpacing.Bottom = 10 Caption = 'Setup' OnClick = SpeedSetupSyncClick end object LabelSyncInfo1: TLabel AnchorSideLeft.Control = GroupBoxSync AnchorSideTop.Control = GroupBoxSync Left = 15 Height = 21 Top = 15 Width = 121 BorderSpacing.Left = 15 BorderSpacing.Top = 15 Caption = 'LabelSyncInfo1' end object LabelSyncInfo2: TLabel AnchorSideLeft.Control = GroupBoxSync AnchorSideTop.Control = LabelSyncInfo1 AnchorSideTop.Side = asrBottom Left = 15 Height = 21 Top = 46 Width = 121 BorderSpacing.Left = 15 BorderSpacing.Top = 10 Caption = 'LabelSyncInfo2' end object GroupBoxToken: TGroupBox AnchorSideLeft.Control = GroupBoxUser AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = Label4 AnchorSideTop.Side = asrBottom AnchorSideRight.Control = SpeedSetupSync AnchorSideRight.Side = asrBottom Left = 215 Height = 58 Top = 111 Width = 485 Anchors = [akTop, akLeft, akRight] BorderSpacing.Left = 15 BorderSpacing.Top = 5 Caption = 'Token' ClientHeight = 54 ClientWidth = 481 TabOrder = 0 object LabelToken: TLabel AnchorSideLeft.Control = SpeedTokenActions AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = SpeedTokenActions AnchorSideTop.Side = asrCenter AnchorSideBottom.Side = asrCenter Left = 106 Height = 21 Top = 7 Width = 91 BorderSpacing.Left = 5 Caption = 'LabelToken' ParentShowHint = False ShowHint = True end object SpeedTokenActions: TSpeedButton AnchorSideLeft.Control = GroupBoxToken AnchorSideTop.Control = GroupBoxToken Left = 5 Height = 28 Top = 3 Width = 96 BorderSpacing.Left = 5 BorderSpacing.Top = 3 Caption = 'Actions' OnClick = SpeedTokenActionsClick end end object GroupBoxUser: TGroupBox AnchorSideLeft.Control = Label4 AnchorSideTop.Control = Label4 AnchorSideTop.Side = asrBottom Left = 15 Height = 58 Top = 111 Width = 185 BorderSpacing.Top = 5 Caption = 'User' ClientHeight = 35 ClientWidth = 181 TabOrder = 1 object EditUserName: TEdit AnchorSideLeft.Control = GroupBoxUser AnchorSideTop.Control = GroupBoxUser AnchorSideTop.Side = asrCenter AnchorSideRight.Control = GroupBoxSync AnchorSideRight.Side = asrBottom AnchorSideBottom.Side = asrCenter Left = 5 Height = 29 Top = 3 Width = 154 BorderSpacing.Left = 5 BorderSpacing.Right = 10 TabOrder = 0 Text = 'EditUserName' end end object ComboSyncTiming: TComboBox AnchorSideLeft.Control = LabelSyncTiming AnchorSideLeft.Side = asrBottom AnchorSideBottom.Control = SpeedSetupSync AnchorSideBottom.Side = asrCenter Left = 128 Height = 31 Top = 203 Width = 194 Anchors = [akLeft, akBottom] BorderSpacing.Left = 20 BorderSpacing.Right = 10 ItemHeight = 0 Items.Strings = ( 'Manual' 'Hourly' 'Daily' 'Weekly' 'Monthly' ) TabOrder = 2 Text = 'ComboSyncTiming' OnChange = ComboSyncTimingChange end object LabelSyncTiming: TLabel AnchorSideLeft.Control = LabelSyncInfo1 AnchorSideBottom.Control = SpeedSetupSync AnchorSideBottom.Side = asrCenter Left = 15 Height = 21 Top = 208 Width = 93 Anchors = [akLeft, akBottom] Caption = 'Sync Timing' end end object ComboSyncType: TComboBox AnchorSideLeft.Control = LabelSyncType AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = LabelSyncType Left = 103 Height = 31 Hint = 'Github or File Sync' Top = 15 Width = 359 BorderSpacing.Left = 15 ItemHeight = 0 Items.Strings = ( 'rsSyncTypeFile' 'rsSyncTypeGithub' ) ParentShowHint = False ShowHint = True TabOrder = 2 Text = 'ComboSyncType' OnChange = ComboSyncTypeChange end object LabelSyncType: TLabel AnchorSideLeft.Control = TabSync AnchorSideTop.Control = TabSync Left = 10 Height = 21 Top = 15 Width = 78 BorderSpacing.Left = 10 BorderSpacing.Top = 15 Caption = 'Sync Type' end end object TabBackUp: TTabSheet Caption = 'BackUp' ClientHeight = 449 ClientWidth = 720 Enabled = False TabVisible = False object Panel1: TPanel AnchorSideLeft.Control = TabBackUp AnchorSideTop.Control = TabBackUp AnchorSideRight.Control = TabBackUp AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = TabBackUp AnchorSideBottom.Side = asrBottom Left = 0 Height = 449 Top = 0 Width = 720 Anchors = [akTop, akLeft, akRight, akBottom] TabOrder = 0 end end object TabRecover: TTabSheet BorderWidth = 1 Caption = 'Recover' ClientHeight = 449 ClientWidth = 720 OnResize = TabRecoverResize object Panel2: TPanel AnchorSideLeft.Control = TabRecover AnchorSideTop.Control = Panel3 AnchorSideTop.Side = asrBottom AnchorSideRight.Control = TabRecover AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = TabRecover AnchorSideBottom.Side = asrBottom Left = 1 Height = 183 Top = 265 Width = 718 Anchors = [akTop, akLeft, akRight, akBottom] BorderSpacing.Left = 1 BorderSpacing.Top = 9 BorderSpacing.Right = 1 BorderSpacing.Bottom = 1 BevelInner = bvLowered ClientHeight = 183 ClientWidth = 718 TabOrder = 0 object Label6: TLabel AnchorSideLeft.Control = Label11 AnchorSideTop.Control = Label11 AnchorSideTop.Side = asrBottom Left = 31 Height = 21 Top = 47 Width = 515 BorderSpacing.Top = 10 Caption = 'Backup files are made when you delete a note or the sync system' end object Label7: TLabel AnchorSideLeft.Control = Label11 AnchorSideTop.Control = Label6 AnchorSideTop.Side = asrBottom Left = 31 Height = 21 Top = 78 Width = 205 BorderSpacing.Top = 10 Caption = 'is about to overwrite one. ' end object Label8: TLabel AnchorSideLeft.Control = Label11 AnchorSideTop.Control = Label7 AnchorSideTop.Side = asrBottom Left = 31 Height = 21 Top = 109 Width = 468 BorderSpacing.Top = 10 Caption = 'They remain, forever, unless you do something about them.' end object ButtonShowBackUp: TButton AnchorSideRight.Control = Panel2 AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = Panel2 AnchorSideBottom.Side = asrBottom Left = 600 Height = 40 Top = 134 Width = 109 Anchors = [akRight, akBottom] BorderSpacing.Right = 7 BorderSpacing.Bottom = 7 Caption = 'Show Me' TabOrder = 0 OnClick = ButtonShowBackUpClick end object Label11: TLabel AnchorSideLeft.Control = Panel2 AnchorSideTop.Control = Panel2 Left = 31 Height = 21 Top = 16 Width = 103 BorderSpacing.Left = 29 BorderSpacing.Top = 14 Caption = 'Backup Files' Font.Style = [fsBold] ParentFont = False end end object Panel3: TPanel AnchorSideLeft.Control = TabRecover AnchorSideTop.Control = TabRecover AnchorSideRight.Control = TabRecover AnchorSideRight.Side = asrBottom Left = 0 Height = 256 Top = 0 Width = 720 Anchors = [akTop, akLeft, akRight] BevelInner = bvLowered ClientHeight = 256 ClientWidth = 720 TabOrder = 1 object Label9: TLabel AnchorSideLeft.Control = Panel3 AnchorSideTop.Control = Panel3 Left = 32 Height = 21 Top = 26 Width = 411 BorderSpacing.Left = 30 BorderSpacing.Top = 24 Caption = 'A snaphot is a copy of your current note directory.' Font.Style = [fsBold] ParentFont = False end object LabelSnapDir: TLabel AnchorSideLeft.Control = Label9 AnchorSideTop.Control = Label9 AnchorSideTop.Side = asrBottom Left = 32 Height = 21 Top = 63 Width = 63 BorderSpacing.Top = 16 Caption = 'Snap dir' end object SpinDaysPerSnapshot: TSpinEdit AnchorSideLeft.Control = Label9 AnchorSideTop.Control = LabelSnapDir AnchorSideTop.Side = asrBottom Left = 32 Height = 29 Top = 117 Width = 76 BorderSpacing.Top = 33 MaxValue = 31 MinValue = 1 OnChange = SpinDaysPerSnapshotChange TabOrder = 0 Value = 7 end object SpinMaxSnapshots: TSpinEdit AnchorSideLeft.Control = Label9 AnchorSideTop.Control = SpinDaysPerSnapshot AnchorSideTop.Side = asrBottom Left = 32 Height = 29 Top = 157 Width = 76 BorderSpacing.Top = 11 MaxValue = 10 MinValue = 10 OnChange = SaveSettings TabOrder = 1 Value = 20 end object CheckAutoSnapEnabled: TCheckBox AnchorSideTop.Control = SpinDaysPerSnapshot AnchorSideTop.Side = asrCenter Left = 344 Height = 25 Top = 119 Width = 178 Caption = 'Use auto snapshots' TabOrder = 2 OnChange = CheckAutoSnapEnabledChange end object Label5: TLabel AnchorSideTop.Control = SpinDaysPerSnapshot AnchorSideTop.Side = asrCenter Left = 131 Height = 21 Top = 121 Width = 145 Caption = 'Days per snapshot' end object Label16: TLabel AnchorSideTop.Control = SpinMaxSnapshots AnchorSideTop.Side = asrCenter Left = 131 Height = 21 Top = 161 Width = 248 Caption = 'Maximum number of snapshots' end object ButtonSnapRecover: TButton AnchorSideLeft.Control = ButtonManualSnap AnchorSideLeft.Side = asrBottom AnchorSideRight.Control = Panel3 AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = Panel3 AnchorSideBottom.Side = asrBottom Left = 360 Height = 40 Hint = 'If you have previously taken a snapshot ...' Top = 206 Width = 351 Anchors = [akLeft, akRight, akBottom] BorderSpacing.Left = 7 BorderSpacing.Right = 7 BorderSpacing.Bottom = 8 Caption = 'Recover Lost Notes' ParentShowHint = False ShowHint = True TabOrder = 3 OnClick = ButtonSnapRecoverClick end object ButtonManualSnap: TButton AnchorSideLeft.Control = Panel3 AnchorSideBottom.Control = Panel3 AnchorSideBottom.Side = asrBottom Left = 9 Height = 40 Hint = 'Take a time stamped snapshot of notes and config' Top = 206 Width = 344 Anchors = [akLeft, akBottom] BorderSpacing.Left = 7 BorderSpacing.Bottom = 8 Caption = 'Take a Manual Snapshot' ParentShowHint = False ShowHint = True TabOrder = 4 OnClick = ButtonManualSnapClick end end end object TabSpell: TTabSheet Caption = 'Spell' ClientHeight = 449 ClientWidth = 720 OnResize = TabSpellResize object Label13: TLabel AnchorSideLeft.Control = TabSpell AnchorSideTop.Control = TabSpell Left = 10 Height = 21 Top = 13 Width = 371 BorderSpacing.Left = 10 BorderSpacing.Top = 13 Caption = 'Spell Check requires the Hunspell Libraries and' end object Label14: TLabel AnchorSideLeft.Control = Label13 AnchorSideTop.Control = Label13 AnchorSideTop.Side = asrBottom Left = 10 Height = 21 Top = 44 Width = 307 BorderSpacing.Top = 10 Caption = 'an appropriate Hunspell Dictionary set.' end object LabelError: TLabel AnchorSideLeft.Control = Label13 AnchorSideTop.Control = ButtonSetDictionary AnchorSideTop.Side = asrBottom Left = 10 Height = 21 Top = 362 Width = 84 BorderSpacing.Top = 20 Caption = 'LabelError' end object LabelLibraryStatus: TLabel AnchorSideLeft.Control = Label13 AnchorSideTop.Control = Label14 AnchorSideTop.Side = asrBottom Left = 10 Height = 21 Top = 93 Width = 148 BorderSpacing.Top = 28 Caption = 'LabelLibraryStatus' end object LabelDicStatus: TLabel AnchorSideLeft.Control = Label13 AnchorSideTop.Control = ButtonSetSpellLibrary AnchorSideTop.Side = asrBottom Left = 10 Height = 21 Top = 249 Width = 117 BorderSpacing.Top = 63 Caption = 'LabelDicStatus' end object LabelLibrary: TLabel AnchorSideLeft.Control = Label13 AnchorSideTop.Control = LabelLibraryStatus AnchorSideTop.Side = asrBottom Left = 10 Height = 21 Top = 122 Width = 98 BorderSpacing.Top = 8 Caption = 'LabelLibrary' end object LabelDic: TLabel AnchorSideLeft.Control = Label13 AnchorSideTop.Control = LabelDicStatus AnchorSideTop.Side = asrBottom Left = 10 Height = 21 Top = 278 Width = 67 BorderSpacing.Top = 8 Caption = 'LabelDic' end object ListBoxDic: TListBox AnchorSideLeft.Control = ButtonSetSpellLibrary AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = ButtonSetSpellLibrary AnchorSideRight.Control = TabSpell AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = ButtonSetDictionary AnchorSideBottom.Side = asrBottom Left = 165 Height = 196 Top = 146 Width = 548 Anchors = [akTop, akLeft, akRight, akBottom] BorderSpacing.Left = 12 BorderSpacing.Right = 7 ItemHeight = 0 ScrollWidth = 456 TabOrder = 0 TopIndex = -1 OnClick = ListBoxDicClick end object LabelDicPrompt: TLabel AnchorSideRight.Control = ListBoxDic AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = ListBoxDic Left = 586 Height = 21 Top = 118 Width = 127 Anchors = [akRight, akBottom] BorderSpacing.Bottom = 7 Caption = 'LabelDicPrompt' end object ButtonSetSpellLibrary: TButton AnchorSideLeft.Control = Label13 AnchorSideTop.Control = LabelLibrary AnchorSideTop.Side = asrBottom Left = 10 Height = 40 Top = 146 Width = 143 BorderSpacing.Top = 3 Caption = 'Set Spell Library' TabOrder = 1 OnClick = ButtonSetSpellLibraryClick end object ButtonSetDictionary: TButton AnchorSideLeft.Control = Label13 AnchorSideTop.Control = LabelDic AnchorSideTop.Side = asrBottom Left = 10 Height = 40 Top = 302 Width = 143 BorderSpacing.Top = 3 Caption = 'Set Dictionary' TabOrder = 2 OnClick = ButtonSetDictionaryClick end end end object Label15: TLabel AnchorSideBottom.Side = asrBottom Left = 24 Height = 21 Top = 500 Width = 63 Anchors = [akLeft, akBottom] BorderSpacing.Bottom = 7 Caption = 'Label15' end object SpeedButHide: TSpeedButton AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = Owner AnchorSideBottom.Side = asrBottom Left = 630 Height = 40 Top = 490 Width = 96 Anchors = [akRight, akBottom] Caption = 'Close' OnClick = SpeedButHideClick end object SpeedButtTBMenu: TSpeedButton AnchorSideTop.Control = SpeedButHide AnchorSideRight.Control = SpeedButHide AnchorSideBottom.Control = Owner AnchorSideBottom.Side = asrBottom Left = 514 Height = 40 Top = 490 Width = 116 Anchors = [akTop, akRight, akBottom] Caption = 'Menu' Glyph.Data = { 36090000424D3609000000000000360000002800000018000000180000000100 2000000000000009000064000000640000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000003232 3238333333050000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00000000000000000000000000000000000000000000000000002E2E2E163636 36F93C3C3CF0393939863737371C000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00000000000000000000000000000000000000000000000000003737377D8080 80F6DEDEDEFF727272FA3A3A3ADC000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00000000000000000000000000003434348D34343440555555033D3D3DEBD9D9 D9FFFFFFFFFF777777F536363672000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00000000000000000000000000003E3E3EEB464646F53B3B3BEB595959F2FFFF FFFFEEEEEEFF3A3A3AF630303010000000000000000000000000000000000000 000000000000000000004D4D4DFF4D4D4DFF4D4D4DFF4D4D4DFF4D4D4DFF4D4D 4DFF4D4D4DFF4D4D4DFF4D4D4DFF3E3E3EFFE8E8E8FFCDCDCDFFCECECEFFFFFF FFFF9E9E9EFC3E3E3EB100000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFF474747FFEAEAEAFFFFFFFFFFFFFFFFFFFFFF FFFFACACACFC434343F5404040D0323232510000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFF454545FFEDEDEDFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFCFCFCFFF383838F9323232420000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFF000000FF000000FF000000FF0000 00FF000000FFFFFFFFFFFFFFFFFF414141FFF0F0F0FFFFFFFFFFFFFFFFFFFFFF FFFFD8D8D8FF3E3E3EF43333334B000000000000000000000000000000000000 000000000000000000004D4D4DFFFAFAFAFFFAFAFAFFFAFAFAFFFAFAFAFFFAFA FAFFFAFAFAFFFAFAFAFFFAFAFAFF3F3F3FFFF2F2F2FFFFFFFFFFFFFFFFFFD9D9 D9FF3E3E3EF53434344E00000000000000000000000000000000000000000000 000000000000000000004D4D4DFF4D4D4DFF4D4D4DFF4D4D4DFF4D4D4DFF4D4D 4DFF4D4D4DFF4D4D4DFF4D4D4DFF383838FFF5F5F5FFFFFFFFFFDBDBDBFF3E3E 3EF6353535570000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFAFAFAFFFAFAFAFFFAFAFAFFFAFAFAFFFAFA FAFFFAFAFAFFFAFAFAFFFAFAFAFF3A3A3AFFF8F8F8FFE0E0E0FF424242F53636 365A000000000000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFF000000FF000000FF000000FF0000 00FF000000FFFFFFFFFFFFFFFFFF383838FFDDDDDDFF424242FF3636365E0000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFF363636FF494949FF454545FF000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFF000000FF000000FF000000FF0000 00FFFFFFFFFFFFFFFFFFFFFFFFFF353535FFAEAEAEFF4D4D4DFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFDFDFDFFA9A9A9FFFFFFFFFF4D4D4DFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFF000000FF000000FF000000FF0000 00FF000000FF000000FFFFFFFFFFFFFFFFFFFFFFFFFF4D4D4DFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF4D4D4DFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFF000000FF000000FF000000FF0000 00FF000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF4D4D4DFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF4D4D4DFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000004D4D4DFF4D4D4DFF4D4D4DFF4D4D4DFF4D4D4DFF4D4D 4DFF4D4D4DFF4D4D4DFF4D4D4DFF4D4D4DFF4D4D4DFF4D4D4DFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000 } OnClick = SpeedButtTBMenuClick PopupMenu = PMenuMain end object SpeedButHelp: TSpeedButton AnchorSideTop.Control = SpeedButHide AnchorSideRight.Control = SpeedButtTBMenu AnchorSideBottom.Control = SpeedButHide AnchorSideBottom.Side = asrBottom Left = 418 Height = 40 Top = 490 Width = 96 Anchors = [akTop, akRight, akBottom] Caption = 'Help' Glyph.Data = { 36090000424D3609000000000000360000002800000018000000180000000100 2000000000000009000064000000640000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000D45500FFD45500FFD45500FF000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000D45500FFD45500FFD45500FF000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000D45500FFD45500FFD45500FF000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000D4540088D4540088D4540088FF0000010000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000000000000000000000FF80 0002D45500FFD45500FFD45500FFDB4900070000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000D45500F2D45500FFD45500FFD65300250000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000D45500C2D45500FFD45500FFD55500AECC66000500000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000D355004BD45500FED45500FFD45500FFD35500B5D15D000B000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000D3560074D45500FED45500FFD45500FFD45500C8D55500120000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00000000000000000000D3560062D45500FBD45500FFD45500FFD35500C1CC66 0005000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000D656004AD55500F6D45500FFD45500FFD456 0065000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000D9590014D555003CD356005CD656003E0000 000000000000000000000000000000000000D4560095D45500FFD45500FFD555 00AE000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000D356007AD45500FFD45500FFD55500CCFF00 000100000000000000000000000000000000D554008BD45500FFD45500FFD455 00B3000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000D5550030D45500FFD45500FFD45500FFD456 007DFF0000010000000000000000D3570029D45500EDD45500FFD45500FFD356 0074000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000D45600A1D45500FFD45500FFD455 00FFD35500D3D455009FD45500B3D45500F8D45500FFD45500FFD45500DBD15D 000B000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000DB490007D35400A9D45500FFD455 00FFD45500FFD45500FFD45500FFD45500FFD45500FFD55500D2D15500210000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000D4560047D454 00A6D45500D9D55500EAD45500DCD45500B3D3550063DB490007000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000 } Visible = False OnClick = SpeedButHelpClick end object SelectDirectoryDialog1: TSelectDirectoryDialog Options = [ofShareAware, ofEnableSizing] Left = 408 end object OpenDialogLibrary: TOpenDialog Options = [ofPathMustExist, ofFileMustExist, ofNoDereferenceLinks, ofEnableSizing, ofViewDetail] Left = 480 end object OpenDialogDictionary: TOpenDialog Left = 656 Top = 104 end object FontDialog1: TFontDialog MinFontSize = 0 MaxFontSize = 0 Left = 552 end object PMenuMain: TPopupMenu Left = 280 Top = 128 end object TimerAutoSync: TTimer Enabled = False OnTimer = TimerAutoSyncTimer Left = 736 Top = 48 end object SelectSnapDir: TSelectDirectoryDialog Left = 640 end object PopupMenuTokenActions: TPopupMenu Left = 480 Top = 88 object MenuItemGetToken: TMenuItem Caption = 'Get a Token in your Browser' OnClick = MenuItemGetTokenClick end object MenuItemPasteToken: TMenuItem Caption = 'Paste a New Token' OnClick = MenuItemPasteTokenClick end object MenuItemCopyToken: TMenuItem Caption = 'Copy Existing Token' OnClick = MenuItemCopyTokenClick end end end tomboy-ng_0.39-1/source/uqt_colors.pas0000644000175000017500000001236514551457644017645 0ustar dbannondbannonunit uQt_Colors; { Copyright (C) 2023 David Bannon License: This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html ------------------ This is a unit, only invoked if using the Qt5 widget set (some mods needed for Qt6) that will alter how the app manages colours if (and only IF) the user has the QT_QPA_PLATFORMTHEME=qt5ct in the env. It does NOT respect the -platformtheme switch because one dash means one char switch in POSIX, so, we don't consider -platformtheme qt5ct is a switch. (TApplication does make the commandline available Davo ....) This unit reads the colours that qt5ct wants us to use and passes a subset of them back for KMemo to use. Note : Unix only, makes some assumptions about paths, easy fix .... History : 2023-03-13 Initial release. 2023-05-01 Handle the possiblity of no qt5ct conf file. } {$mode ObjFPC}{$H+} interface uses Classes, SysUtils, graphics; type TQt_Colors_Rec = record QColorLink : TColor; QColorBright : TColor; QColorLessBright : TColor; QColorBackground : TColor; QColorAltBackGround : TColor; QColorText : TColor; QColorHighLight : Tcolor; end; { TQt_Colors } type TQt_Colors = class private function GetActiveColors : string; function GetIndexedColor(CSt : string; const Index : integer) : TColor; public FoundColors : boolean; constructor Create(); end; var Qt_Colors_Rec : TQt_Colors_Rec; implementation uses IniFiles, Forms; const CONF = '/.config/qt5ct/qt5ct.conf'; // the conf file has an entry that points to the selected color_scheme { TQt_Colors } function TQt_Colors.GetActiveColors: string; var ConfigFile : TINIFile; begin result := GetEnvironmentVariable('HOME') + CONF; if FileExists(result) then begin ConfigFile := TINIFile.Create(result); try result := ConfigFile.readstring('Appearance', 'color_scheme_path', ''); finally ConfigFile.free; end; end else Result := ''; if Result = '' then exit; // either no qt5ct.conf file or no color_scheme file found. if FileExists(Result) then begin ConfigFile := TINIFile.Create(Result); try result := ConfigFile.readstring('ColorScheme', 'active_colors', ''); finally ConfigFile.free; end; end; end; function TQt_Colors.GetIndexedColor(CSt: string; const Index: integer): TColor; var StL : TStringList; St : String; CValue : Cardinal; R, G, B : byte; // thats the order in Qt's view begin StL := TStringList.Create; // probably more efficent to use CSt.Split ..... StL.Delimiter := ' '; Stl.DelimitedText := CSt; St := StL[Index]; Stl.Free; if St.length < 1 then exit(clBlack); // ToDo : That is an uncaught error St[1] := '$'; St := St.Replace(',', ''); CValue := strtoInt(St) and $ffffff; B := CValue and $ff; CValue := CValue shr 8; G := CValue and $ff; CValue := CValue shr 8; R := CValue and $ff; result := TColor((B shl 16) + (G shl 8) + R); // Thats TColor order. end; constructor TQt_Colors.Create(); var St : String; begin if (GetEnvironmentVariable('QT_QPA_PLATFORMTHEME') <> 'qt5ct') then exit; // Note : not responding to -platformtheme switch St := GetActiveColors(); if St = '' then exit; Qt_Colors_Rec.QColorText := GetIndexedColor(St, 0); // 0 is Text - used for usual text Qt_Colors_Rec.QColorBright := GetIndexedColor(St, 2); // 2 is Bright Qt_Colors_Rec.QColorLessBright := GetIndexedColor(St, 3); // 3 is LessBright Qt_Colors_Rec.QColorBackground := GetIndexedColor(St, 9); // 9 is background Qt_Colors_Rec.QColorLink := GetIndexedColor(St, 14); // 14 is Link index 0..19 Qt_Colors_Rec.QColorHighLight := GetIndexedColor(St, 12); Qt_Colors_rec.QColorAltBackGround := GetIndexedColor(St, 16); FoundColors := True; //writeln('We have found suitable qt5ct colors'); end; end. { WindowText = 0; NormalBackGround = 1; Link = 14; if we have a qt env setting, QT_QPA_PLATFORMTHEME=qt5ct we can look in /$HOME/.config/qt5ct/qt5ct.conf Its an ini file that we will find, in section [Appearance], color_scheme_path, value being eg /usr/share/qt5ct/colors/darker.conf We open this file, also ini, the value of [ColorScheme], has a line that looks like this - active_colors=#ffffff, #424245, #979797, #5e5c5b, #302f2e, #4a4947, #ffffff, #ffffff, #ffffff, #3d3d3d, #222020, #e7e4e0, #12608a, #f9f9f9, #0986d3, #a70b06, #5c5b5a, #ffffff, #3f3f36, #ffffff each subvalue may be 6 or 8 hex digits, we loose the first two if its 8. White = #FFFFFF (careful, apparently Qt can be funny about ffffff) Six Digits, Red, Green, Blue, 2 each. Higher value means lighter. Black is #222222 - I guess it gets blacker than this but not in the themes I see. Red = #ff0000 Green = #00FF00 Blue = #0000FF Digits to left of 6 rightmost characters are Opacity. Strip them off. TColor - Blue-Green-Red ========= clBlue = TColor($FF0000); clRed = TColor($0000FF); clGreen = TColor($008000); clBlack = TColor($000000); clWhite = TColor($FFFFFF); } tomboy-ng_0.39-1/source/rollback.lrj0000644000175000017500000000237414551457644017247 0ustar dbannondbannon{"version":1,"strings":[ {"hash":50730251,"name":"tformrollback.caption","sourcebytes":[70,111,114,109,82,111,108,108,66,97,99,107],"value":"FormRollBack"}, {"hash":77089212,"name":"tformrollback.speedcancel.caption","sourcebytes":[67,97,110,99,101,108],"value":"Cancel"}, {"hash":37921584,"name":"tformrollback.speedrolltoopen.caption","sourcebytes":[79,112,101,110,105,110,103,32,66,97,99,107,117,112],"value":"Opening Backup"}, {"hash":107677856,"name":"tformrollback.speedrolltotitle.caption","sourcebytes":[84,105,116,108,101,32,67,104,97,110,103,101,32,66,97,99,107,117,112],"value":"Title Change Backup"}, {"hash":126620494,"name":"tformrollback.labelopn.caption","sourcebytes":[76,97,98,101,108,79,112,110],"value":"LabelOpn"}, {"hash":126631564,"name":"tformrollback.labelttl.caption","sourcebytes":[76,97,98,101,108,116,116,108],"value":"Labelttl"}, {"hash":88329237,"name":"tformrollback.labelopntitle.caption","sourcebytes":[76,97,98,101,108,79,112,110,84,105,116,108,101],"value":"LabelOpnTitle"}, {"hash":157534917,"name":"tformrollback.labelttltitle.caption","sourcebytes":[76,97,98,101,108,116,116,108,84,105,116,108,101],"value":"LabelttlTitle"}, {"hash":86477809,"name":"tformrollback.label1.caption","sourcebytes":[76,97,98,101,108,49],"value":"Label1"} ]} tomboy-ng_0.39-1/source/settings.lrj0000644000175000017500000003753214551457644017322 0ustar dbannondbannon{"version":1,"strings":[ {"hash":223420702,"name":"tsett.caption","sourcebytes":[70,111,114,109,32,67,97,112,116,105,111,110],"value":"Form Caption"}, {"hash":4753907,"name":"tsett.tabbasic.caption","sourcebytes":[66,97,115,105,99],"value":"Basic"}, {"hash":72385672,"name":"tsett.labelsettingpath.caption","sourcebytes":[76,97,98,101,108,83,101,116,116,105,110,103,80,97,116,104],"value":"LabelSettingPath"}, {"hash":222591720,"name":"tsett.labelnotespath.caption","sourcebytes":[76,97,98,101,108,78,111,116,101,115,80,97,116,104],"value":"LabelNotesPath"}, {"hash":258040074,"name":"tsett.label1.caption","sourcebytes":[83,101,116,116,105,110,103,115,32,119,105,108,108,32,98,101,32,115,97,118,101,100,32,105,110,32,58],"value":"Settings will be saved in :"}, {"hash":38840874,"name":"tsett.label2.caption","sourcebytes":[78,111,116,101,115,32,119,105,108,108,32,98,101,32,108,111,111,107,101,100,32,102,111,114,32,97,110,100,32,115,97,118,101,100,32,105,110,32,58],"value":"Notes will be looked for and saved in :"}, {"hash":140021374,"name":"tsett.checkautostart.caption","sourcebytes":[65,117,116,111,115,116,97,114,116,32,97,116,32,76,111,103,111,110],"value":"Autostart at Logon"}, {"hash":28987956,"name":"tsett.checkshowsearchatstart.caption","sourcebytes":[83,104,111,119,32,83,101,97,114,99,104,32,97,116,32,83,116,97,114,116],"value":"Show Search at Start"}, {"hash":204462302,"name":"tsett.checkshowsplash.hint","sourcebytes":[65,108,119,97,121,115,32,115,104,111,119,110,32,105,102,32,101,114,114,111,114,32,108,111,97,100,105,110,103,32,110,111,116,101,115,46],"value":"Always shown if error loading notes."}, {"hash":196767252,"name":"tsett.checkshowsplash.caption","sourcebytes":[83,104,111,119,32,83,112,108,97,115,104,32,97,116,32,83,116,97,114,116],"value":"Show Splash at Start"}, {"hash":192901619,"name":"tsett.checknotifications.caption","sourcebytes":[83,104,111,119,32,78,111,116,105,102,105,99,97,116,105,111,110,115],"value":"Show Notifications"}, {"hash":153045573,"name":"tsett.checkescclosesnote.caption","sourcebytes":[69,83,67,32,67,108,111,115,101,115,32,78,111,116,101],"value":"ESC Closes Note"}, {"hash":206585352,"name":"tsett.groupnotespath.caption","sourcebytes":[78,111,116,101,115,32,80,97,116,104],"value":"Notes Path"}, {"hash":77555349,"name":"tsett.radiochoose.caption","sourcebytes":[67,104,111,111,115,101],"value":"Choose"}, {"hash":199722692,"name":"tsett.radiotomboydefault.caption","sourcebytes":[79,108,100,32,84,111,109,98,111,121,32,68,101,102,97,117,108,116],"value":"Old Tomboy Default"}, {"hash":207987428,"name":"tsett.radiotomboyngdefault.caption","sourcebytes":[116,111,109,98,111,121,45,110,103,32,68,101,102,97,117,108,116],"value":"tomboy-ng Default"}, {"hash":250232021,"name":"tsett.buttonsetnotepath.hint","sourcebytes":[73,102,32,121,111,117,32,104,97,118,101,32,110,111,116,101,115,32,115,111,109,101,119,104,101,114,101,32,101,108,115,101],"value":"If you have notes somewhere else"}, {"hash":121012803,"name":"tsett.buttonsetnotepath.caption","sourcebytes":[83,101,116,32,80,97,116,104,32,116,111,32,78,111,116,101,32,70,105,108,101,115],"value":"Set Path to Note Files"}, {"hash":5597891,"name":"tsett.tabdisplay.caption","sourcebytes":[78,111,116,101,115],"value":"Notes"}, {"hash":90566245,"name":"tsett.groupbox5.caption","sourcebytes":[70,111,110,116,32,83,105,122,101],"value":"Font Size"}, {"hash":18679,"name":"tsett.radiofontbig.caption","sourcebytes":[66,105,103],"value":"Big"}, {"hash":87797949,"name":"tsett.radiofontmedium.caption","sourcebytes":[77,101,100,105,117,109],"value":"Medium"}, {"hash":5912620,"name":"tsett.radiofontsmall.caption","sourcebytes":[83,109,97,108,108],"value":"Small"}, {"hash":326613,"name":"tsett.radiofonthuge.caption","sourcebytes":[72,117,103,101],"value":"Huge"}, {"hash":36234723,"name":"tsett.checkshowintlinks.caption","sourcebytes":[83,104,111,119,32,73,110,116,101,114,110,97,108,32,76,105,110,107,115],"value":"Show Internal Links"}, {"hash":136897987,"name":"tsett.checkshowextlinks.caption","sourcebytes":[83,104,111,119,32,69,120,116,101,114,110,97,108,32,76,105,110,107,115],"value":"Show External Links"}, {"hash":224827470,"name":"tsett.checkmanynotebooks.hint","sourcebytes":[84,104,105,115,32,109,97,121,32,97,100,118,101,114,115,108,121,32,97,102,102,101,99,116,32,116,114,97,100,105,116,105,111,110,97,108,32,84,111,109,98,111,121,44,32,116,97,107,101,32,99,97,114,101,46],"value":"This may adversly affect traditional Tomboy, take care."}, {"hash":107781534,"name":"tsett.checkmanynotebooks.caption","sourcebytes":[65,108,108,111,119,32,97,32,78,111,116,101,32,116,111,32,98,101,32,105,110,32,77,117,108,116,105,112,108,101,32,78,111,116,101,98,111,111,107,115,46],"value":"Allow a Note to be in Multiple Notebooks."}, {"hash":132194532,"name":"tsett.buttonfont.caption","sourcebytes":[85,115,117,97,108,32,70,111,110,116],"value":"Usual Font"}, {"hash":190850740,"name":"tsett.buttonfixedfont.caption","sourcebytes":[70,105,120,101,100,32,70,111,110,116],"value":"Fixed Font"}, {"hash":169650899,"name":"tsett.buttonsetcolours.caption","sourcebytes":[83,101,116,32,67,111,108,111,117,114,115],"value":"Set Colours"}, {"hash":2213269,"name":"tsett.label10.caption","sourcebytes":[72,101,108,112,32,78,111,116,101,115,32,76,97,110,103,117,97,103,101],"value":"Help Notes Language"}, {"hash":141148457,"name":"tsett.checkuseundo.hint","sourcebytes":[67,108,111,115,101,32,97,110,100,32,114,101,111,112,101,110,32,97,32,110,111,116,101,32,116,111,32,116,97,107,101,32,101,102,102,101,99,116,46,32,85,115,101,32,67,116,114,108,45,90,32,67,116,114,108,45,89],"value":"Close and reopen a note to take effect. Use Ctrl-Z Ctrl-Y"}, {"hash":173353,"name":"tsett.checkuseundo.caption","sourcebytes":[85,115,101,32,85,110,100,111,32,82,101,100,111,32,40,109,97,121,32,115,108,111,119,32,101,100,105,116,105,110,103,41],"value":"Use Undo Redo (may slow editing)"}, {"hash":20422100,"name":"tsett.label17.caption","sourcebytes":[68,97,116,101,32,83,116,97,109,112,32,70,111,114,109,97,116],"value":"Date Stamp Format"}, {"hash":11022323,"name":"tsett.checkstampitalics.caption","sourcebytes":[73,116,97,108,105,99,115],"value":"Italics"}, {"hash":5912620,"name":"tsett.checkstampsmall.caption","sourcebytes":[83,109,97,108,108],"value":"Small"}, {"hash":300580,"name":"tsett.checkstampbold.caption","sourcebytes":[66,111,108,100],"value":"Bold"}, {"hash":193625159,"name":"tsett.checkfindtoggles.hint","sourcebytes":[101,103,32,67,116,114,108,45,70,32,111,112,101,110,115,32,97,110,100,32,99,108,111,115,101,115,32,70,105,110,100,32,87,105,110,100,111,119],"value":"eg Ctrl-F opens and closes Find Window"}, {"hash":254798339,"name":"tsett.checkfindtoggles.caption","sourcebytes":[70,105,110,100,32,67,111,109,109,97,110,100,32,84,111,103,103,108,101,115],"value":"Find Command Toggles"}, {"hash":372803,"name":"tsett.tabsync.caption","sourcebytes":[83,121,110,99],"value":"Sync"}, {"hash":201511066,"name":"tsett.groupbox4.caption","sourcebytes":[87,104,101,110,32,97,32,99,111,110,102,108,105,99,116,32,105,115,32,100,101,116,101,99,116,101,100,32,98,101,116,119,101,101,110,32,97,32,108,111,99,97,108,32,110,111,116,101,32,97,110,100,32,114,101,109,111,116,101,32,111,110,101,32,58],"value":"When a conflict is detected between a local note and remote one :"}, {"hash":209241694,"name":"tsett.radioalwaysask.caption","sourcebytes":[65,108,119,97,121,115,32,65,115,107,32,109,101,32,119,104,97,116,32,116,111,32,100,111,46],"value":"Always Ask me what to do."}, {"hash":72224622,"name":"tsett.radiouselocal.caption","sourcebytes":[85,115,101,32,76,111,99,97,108,32,78,111,116,101,32,97,110,100,32,79,118,101,114,119,114,105,116,101,32,83,101,114,118,101,114,32,78,111,116,101,46],"value":"Use Local Note and Overwrite Server Note."}, {"hash":58056046,"name":"tsett.radiouseserver.caption","sourcebytes":[85,115,101,32,83,101,114,118,101,114,32,78,111,116,101,32,97,110,100,32,82,101,110,97,109,101,32,76,111,99,97,108,32,78,111,116,101,46],"value":"Use Server Note and Rename Local Note."}, {"hash":95438592,"name":"tsett.groupboxsync.caption","sourcebytes":[32,32,83,121,110,99,32,32],"value":" Sync "}, {"hash":147264400,"name":"tsett.label4.caption","sourcebytes":[82,101,112,111,32,58,32],"value":"Repo : "}, {"hash":177761188,"name":"tsett.labelsyncrepo.caption","sourcebytes":[110,111,116,32,99,111,110,102,105,103,117,114,101,100],"value":"not configured"}, {"hash":5884864,"name":"tsett.speedsetupsync.caption","sourcebytes":[83,101,116,117,112],"value":"Setup"}, {"hash":66344129,"name":"tsett.labelsyncinfo1.caption","sourcebytes":[76,97,98,101,108,83,121,110,99,73,110,102,111,49],"value":"LabelSyncInfo1"}, {"hash":66344130,"name":"tsett.labelsyncinfo2.caption","sourcebytes":[76,97,98,101,108,83,121,110,99,73,110,102,111,50],"value":"LabelSyncInfo2"}, {"hash":5988798,"name":"tsett.groupboxtoken.caption","sourcebytes":[84,111,107,101,110],"value":"Token"}, {"hash":203458110,"name":"tsett.labeltoken.caption","sourcebytes":[76,97,98,101,108,84,111,107,101,110],"value":"LabelToken"}, {"hash":128648723,"name":"tsett.speedtokenactions.caption","sourcebytes":[65,99,116,105,111,110,115],"value":"Actions"}, {"hash":379330,"name":"tsett.groupboxuser.caption","sourcebytes":[85,115,101,114],"value":"User"}, {"hash":226381813,"name":"tsett.editusername.text","sourcebytes":[69,100,105,116,85,115,101,114,78,97,109,101],"value":"EditUserName"}, {"hash":188537447,"name":"tsett.combosynctiming.text","sourcebytes":[67,111,109,98,111,83,121,110,99,84,105,109,105,110,103],"value":"ComboSyncTiming"}, {"hash":99957783,"name":"tsett.labelsynctiming.caption","sourcebytes":[83,121,110,99,32,84,105,109,105,110,103],"value":"Sync Timing"}, {"hash":186325059,"name":"tsett.combosynctype.hint","sourcebytes":[71,105,116,104,117,98,32,111,114,32,70,105,108,101,32,83,121,110,99],"value":"Github or File Sync"}, {"hash":103494789,"name":"tsett.combosynctype.text","sourcebytes":[67,111,109,98,111,83,121,110,99,84,121,112,101],"value":"ComboSyncType"}, {"hash":72743781,"name":"tsett.labelsynctype.caption","sourcebytes":[83,121,110,99,32,84,121,112,101],"value":"Sync Type"}, {"hash":75997376,"name":"tsett.tabbackup.caption","sourcebytes":[66,97,99,107,85,112],"value":"BackUp"}, {"hash":146435218,"name":"tsett.tabrecover.caption","sourcebytes":[82,101,99,111,118,101,114],"value":"Recover"}, {"hash":33245741,"name":"tsett.label6.caption","sourcebytes":[66,97,99,107,117,112,32,102,105,108,101,115,32,97,114,101,32,109,97,100,101,32,119,104,101,110,32,121,111,117,32,100,101,108,101,116,101,32,97,32,110,111,116,101,32,111,114,32,116,104,101,32,115,121,110,99,32,115,121,115,116,101,109],"value":"Backup files are made when you delete a note or the sync system"}, {"hash":170155600,"name":"tsett.label7.caption","sourcebytes":[105,115,32,97,98,111,117,116,32,116,111,32,111,118,101,114,119,114,105,116,101,32,111,110,101,46,32],"value":"is about to overwrite one. "}, {"hash":61900782,"name":"tsett.label8.caption","sourcebytes":[84,104,101,121,32,114,101,109,97,105,110,44,32,102,111,114,101,118,101,114,44,32,117,110,108,101,115,115,32,121,111,117,32,100,111,32,115,111,109,101,116,104,105,110,103,32,97,98,111,117,116,32,116,104,101,109,46],"value":"They remain, forever, unless you do something about them."}, {"hash":167155045,"name":"tsett.buttonshowbackup.caption","sourcebytes":[83,104,111,119,32,77,101],"value":"Show Me"}, {"hash":113991683,"name":"tsett.label11.caption","sourcebytes":[66,97,99,107,117,112,32,70,105,108,101,115],"value":"Backup Files"}, {"hash":14368846,"name":"tsett.label9.caption","sourcebytes":[65,32,115,110,97,112,104,111,116,32,105,115,32,97,32,99,111,112,121,32,111,102,32,121,111,117,114,32,99,117,114,114,101,110,116,32,110,111,116,101,32,100,105,114,101,99,116,111,114,121,46],"value":"A snaphot is a copy of your current note directory."}, {"hash":75657378,"name":"tsett.labelsnapdir.caption","sourcebytes":[83,110,97,112,32,100,105,114],"value":"Snap dir"}, {"hash":16909939,"name":"tsett.checkautosnapenabled.caption","sourcebytes":[85,115,101,32,97,117,116,111,32,115,110,97,112,115,104,111,116,115],"value":"Use auto snapshots"}, {"hash":60902068,"name":"tsett.label5.caption","sourcebytes":[68,97,121,115,32,112,101,114,32,115,110,97,112,115,104,111,116],"value":"Days per snapshot"}, {"hash":99028035,"name":"tsett.label16.caption","sourcebytes":[77,97,120,105,109,117,109,32,110,117,109,98,101,114,32,111,102,32,115,110,97,112,115,104,111,116,115],"value":"Maximum number of snapshots"}, {"hash":7809598,"name":"tsett.buttonsnaprecover.hint","sourcebytes":[73,102,32,121,111,117,32,104,97,118,101,32,112,114,101,118,105,111,117,115,108,121,32,116,97,107,101,110,32,97,32,115,110,97,112,115,104,111,116,32,46,46,46],"value":"If you have previously taken a snapshot ..."}, {"hash":262535843,"name":"tsett.buttonsnaprecover.caption","sourcebytes":[82,101,99,111,118,101,114,32,76,111,115,116,32,78,111,116,101,115],"value":"Recover Lost Notes"}, {"hash":47647895,"name":"tsett.buttonmanualsnap.hint","sourcebytes":[84,97,107,101,32,97,32,116,105,109,101,32,115,116,97,109,112,101,100,32,115,110,97,112,115,104,111,116,32,111,102,32,110,111,116,101,115,32,97,110,100,32,99,111,110,102,105,103],"value":"Take a time stamped snapshot of notes and config"}, {"hash":106332564,"name":"tsett.buttonmanualsnap.caption","sourcebytes":[84,97,107,101,32,97,32,77,97,110,117,97,108,32,83,110,97,112,115,104,111,116],"value":"Take a Manual Snapshot"}, {"hash":5925932,"name":"tsett.tabspell.caption","sourcebytes":[83,112,101,108,108],"value":"Spell"}, {"hash":180692596,"name":"tsett.label13.caption","sourcebytes":[83,112,101,108,108,32,67,104,101,99,107,32,114,101,113,117,105,114,101,115,32,116,104,101,32,72,117,110,115,112,101,108,108,32,76,105,98,114,97,114,105,101,115,32,97,110,100],"value":"Spell Check requires the Hunspell Libraries and"}, {"hash":214004590,"name":"tsett.label14.caption","sourcebytes":[97,110,32,97,112,112,114,111,112,114,105,97,116,101,32,72,117,110,115,112,101,108,108,32,68,105,99,116,105,111,110,97,114,121,32,115,101,116,46],"value":"an appropriate Hunspell Dictionary set."}, {"hash":201965794,"name":"tsett.labelerror.caption","sourcebytes":[76,97,98,101,108,69,114,114,111,114],"value":"LabelError"}, {"hash":158633795,"name":"tsett.labellibrarystatus.caption","sourcebytes":[76,97,98,101,108,76,105,98,114,97,114,121,83,116,97,116,117,115],"value":"LabelLibraryStatus"}, {"hash":254182419,"name":"tsett.labeldicstatus.caption","sourcebytes":[76,97,98,101,108,68,105,99,83,116,97,116,117,115],"value":"LabelDicStatus"}, {"hash":131990665,"name":"tsett.labellibrary.caption","sourcebytes":[76,97,98,101,108,76,105,98,114,97,114,121],"value":"LabelLibrary"}, {"hash":126619603,"name":"tsett.labeldic.caption","sourcebytes":[76,97,98,101,108,68,105,99],"value":"LabelDic"}, {"hash":267742116,"name":"tsett.labeldicprompt.caption","sourcebytes":[76,97,98,101,108,68,105,99,80,114,111,109,112,116],"value":"LabelDicPrompt"}, {"hash":147480761,"name":"tsett.buttonsetspelllibrary.caption","sourcebytes":[83,101,116,32,83,112,101,108,108,32,76,105,98,114,97,114,121],"value":"Set Spell Library"}, {"hash":111338153,"name":"tsett.buttonsetdictionary.caption","sourcebytes":[83,101,116,32,68,105,99,116,105,111,110,97,114,121],"value":"Set Dictionary"}, {"hash":41467669,"name":"tsett.label15.caption","sourcebytes":[76,97,98,101,108,49,53],"value":"Label15"}, {"hash":4863637,"name":"tsett.speedbuthide.caption","sourcebytes":[67,108,111,115,101],"value":"Close"}, {"hash":343125,"name":"tsett.speedbutttbmenu.caption","sourcebytes":[77,101,110,117],"value":"Menu"}, {"hash":322608,"name":"tsett.speedbuthelp.caption","sourcebytes":[72,101,108,112],"value":"Help"}, {"hash":162747682,"name":"tsett.menuitemgettoken.caption","sourcebytes":[71,101,116,32,97,32,84,111,107,101,110,32,105,110,32,121,111,117,114,32,66,114,111,119,115,101,114],"value":"Get a Token in your Browser"}, {"hash":242261982,"name":"tsett.menuitempastetoken.caption","sourcebytes":[80,97,115,116,101,32,97,32,78,101,119,32,84,111,107,101,110],"value":"Paste a New Token"}, {"hash":205020542,"name":"tsett.menuitemcopytoken.caption","sourcebytes":[67,111,112,121,32,69,120,105,115,116,105,110,103,32,84,111,107,101,110],"value":"Copy Existing Token"} ]} tomboy-ng_0.39-1/source/transfile.pas0000644000175000017500000003403114551457644017434 0ustar dbannondbannonunit transfile; { Copyright (C) 2017-2020 David Bannon License: This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html ------------------ A unit that does the file transfer side of a FileSync operation HISTORY 2018/10/25 Much testing, support for Tomdroid. 2018/06/05 Change to doing Tomboy's sync dir names, rev 431 is in ~/4/341 2019/10/17 Ensure DownloadFile returns true remote dir name, irrespective of above. 2021/09/15 Added progress indicator to uploads and downloads } {$mode objfpc}{$H+} interface uses Classes, SysUtils, trans, SyncUtils, tb_utils, ResourceStr; // we share resources with GithubSync type { TFileSync } TFileSync = Class(TTomboyTrans) private function GetNoteLastChange(const FullFileName: string): string; // Reads the (filesync) remote Manifest for synced note details. It gets ID, RevNo // and, if its there the LastChangeDate. If LCD is not in manifest and GetLCD // is True, gets it from the file. function ReadRemoteManifest(const NoteMeta: TNoteInfoList; const GetLCD : boolean): boolean; public //RemoteDir : string; // where the remote filesync repo lives. function SetTransport(): TSyncAvailable; override; function TestTransport(const WriteNewServerID : boolean = False) : TSyncAvailable; override; function GetRemoteNotes(const NoteMeta : TNoteInfoList; const GetLCD : boolean) : boolean; override; function DownloadNotes(const DownLoads : TNoteInfoList) : boolean; override; function DeleteNote(const ID : string; const ExistRev : integer) : boolean; override; function UploadNotes(const Uploads : TStringList) : boolean; override; function DoRemoteManifest(const RemoteManifest : string; MetaData : TNoteInfoList = nil) : boolean; override; function DownLoadNote(const ID : string; const RevNo : Integer) : string; Override; // function SetRemoteRepo(ManFile : string = '') : boolean; override; constructor Create(); end; implementation uses laz2_DOM, laz2_XMLRead, LazFileUtils, FileUtil, LazLogger; { TFileSync } function TFileSync.SetTransport(): TSyncAvailable; begin Result := SyncReady; end; function TFileSync.TestTransport(const WriteNewServerID : boolean = False): TSyncAvailable; var Doc : TXMLDocument; GUID : TGUID; ManExists, ZeroExists : boolean; // for readability of code only begin RemoteAddress := AppendPathDelim(RemoteAddress); if not DirectoryExists(RemoteAddress) then if not DirectoryExists(RemoteAddress) then begin // try again because it might be just remounted. ErrorString := 'Remote Dir does not exist ' + #10 + RemoteAddress; exit(SyncNoRemoteDir); end; if not DirectoryIsWritable(RemoteAddress) then begin ErrorString := 'Remote directory NOT writable ' + RemoteAddress; exit(SyncNoRemoteWrite); end; if ANewRepo then begin CreateGUID(GUID); ServerID := copy(GUIDToString(GUID), 2, 36); // it arrives here wrapped in {} RemoteServerRev := -1; exit(SyncReady); end; ManExists := FileExists(RemoteAddress + 'manifest.xml'); ZeroExists := DirectoryExists(RemoteAddress + '0'); if (not ManExists) and (not ZeroExists) then begin ErrorString := 'Remote dir does not contain a Repo ' + RemoteAddress; exit(SyncNoRemoteRepo); end; if (ManExists) and (not ZeroExists) then begin ErrorString := 'Apparently damaged repo, missing 0 dir at ' + RemoteAddress; exit(SyncBadRemote); end; if (not ManExists) and (ZeroExists) then begin ErrorString := 'Apparently damaged repo, missing manifest at ' + RemoteAddress; exit(SyncBadRemote); end; // If to here, looks and feels like a repo, lets see what it can tell ! try try ReadXMLFile(Doc, RemoteAddress + 'manifest.xml'); ServerID := Doc.DocumentElement.GetAttribute('server-id'); RemoteServerRev := strtoint(Doc.DocumentElement.GetAttribute('revision')); except on E: EConvertError do begin ErrorString := E.Message; exit(SyncXMLERROR); // probably means we did not find an expected attribute end; on E: EAccessViolation do begin ErrorString := E.Message; exit(SyncXMLERROR); // probably means we did not find an expected attribute end; on E: EFOpenError do begin ErrorString := E.Message; exit(SyncNoRemoteMan); // File is not present. end; end; finally Doc.free; end; (* try try ReadXMLFile(Doc, RemoteAddress + 'manifest.xml'); ServerID := Doc.DocumentElement.GetAttribute('server-id'); { ToDo : must check for error on next line, it might raise EConvertError } RemoteServerRev := strtoint(Doc.DocumentElement.GetAttribute('revision')); finally Doc.Free; end; except on E: EAccessViolation do begin ErrorString := E.Message; exit(SyncXMLERROR); // probably means we did not find an expected attribute end; on E: EFOpenError do begin ErrorString := E.Message; exit(SyncNoRemoteMan); // File is not present. end; end; *) if 36 <> length(ServerID) then begin ErrorString := 'Invalid ServerID'; exit(SyncXMLError); end; Result := SyncReady; end; function TFileSync.GetRemoteNotes(const NoteMeta: TNoteInfoList; const GetLCD : boolean): boolean; begin if NoteMeta = Nil then begin ErrorString := 'Passed an uncreated list to GetNewNotes()'; exit(False); end; if FileExists(RemoteAddress + 'manifest.xml') then ReadRemoteManifest(NoteMeta, GetLCD); // No remote manifest is aceptable here, new repo result := True; end; function TFileSync.ReadRemoteManifest(const NoteMeta: TNoteInfoList; const GetLCD : boolean) : boolean; var Doc : TXMLDocument; NodeList : TDOMNodeList; Node : TDOMNode; j : integer; NoteInfo : PNoteInfo; begin Result := true; try try ReadXMLFile(Doc, RemoteAddress + 'manifest.xml'); NodeList := Doc.DocumentElement.ChildNodes; if assigned(NodeList) then begin for j := 0 to NodeList.Count-1 do begin new(NoteInfo); NoteInfo^.Action:=SyUnset; Node := NodeList.Item[j].Attributes.GetNamedItem('id'); NoteInfo^.ID := Node.NodeValue; // ID does not contain '.note'; Node := NodeList.Item[j].Attributes.GetNamedItem('rev'); NoteInfo^.Rev := strtoint(Node.NodeValue); // what happens if its empty ? Node := NodeList.Item[j].Attributes.GetNamedItem('last-change-date'); if assigned(node) then NoteInfo^.LastChange:=Node.NodeValue else if GetLCD then begin // Only bother to get it if we really need it if UsingRightRevisionPath(RemoteAddress, NoteInfo^.Rev) then NoteInfo^.LastChange := GetNoteLastChange(GetRevisionDirPath(RemoteAddress, NoteInfo^.Rev, NoteInfo^.ID)) else NoteInfo^.LastChange := GetNoteLastChange(RemoteAddress + '0' + pathdelim + inttostr(NoteInfo^.Rev) // Ugly Hack + pathdelim + NoteInfo^.ID + '.note'); end; if NoteInfo^.LastChange <> '' then NoteInfo^.LastChangeGMT := TB_GetGMTFromStr(NoteInfo^.LastChange); NoteMeta.Add(NoteInfo); end; end; finally Doc.Free; end; except on E: EAccessViolation do Result := false; // probably means we did not find an expected attribute on E: EFOpenError do Result := False; // File is not present. end; if Result = True then begin if debugmode then Debugln('Transfile.ReadRemoteManifest - read OK'); end else DebugLn('We failed to read the remote manifest file ', RemoteAddress + 'manifest.xml'); end; function TFileSync.GetNoteLastChange(const FullFileName : string) : string; begin Result := GetNoteLastChangeSt(FullFileName, ErrorString); // syncutils function end; function TFileSync.DownloadNotes(const DownLoads: TNoteInfoList): boolean; var I : integer; DLCount : integer = 0; FullFileName : string; DownCount : integer = 0; begin if ProgressProcedure <> nil then progressProcedure(rsDownloadNotes); if not DirectoryExists(NotesDir + 'Backup') then if not ForceDirectory(NotesDir + 'Backup') then begin ErrorString := 'Failed to create Backup directory.'; exit(False); end; for I := 0 to DownLoads.Count-1 do begin if DownLoads.Items[I]^.Action = SyDownLoad then begin inc(DLCount); if (DLCount mod 5 = 0) and (ProgressProcedure <> nil) then ProgressProcedure(rsDownLoaded + ' ' + inttostr(DLCount) + ' notes'); if FileExists(NotesDir + Downloads.Items[I]^.ID + '.note') then // First make a Backup copy if not CopyFile(NotesDir + Downloads.Items[I]^.ID + '.note', NotesDir + 'Backup' + PathDelim + Downloads.Items[I]^.ID + '.note') then begin ErrorString := 'Failed to copy file to Backup ' + NotesDir + Downloads.Items[I]^.ID + '.note'; exit(False); end; // OK, now copy the file. if UsingRightRevisionPath(RemoteAddress, DownLoads.Items[i]^.Rev) then FullFilename := GetRevisionDirPath(RemoteAddress, DownLoads.Items[i]^.Rev , Downloads.Items[I]^.ID) else FullFilename := RemoteAddress + '0' + pathdelim + inttostr(DownLoads.Items[i]^.Rev) // Ugly Hack + pathdelim + Downloads.Items[I]^.ID + '.note'; if DebugMode then debugln({$I %CURRENTROUTINE%}, '() ', {$I %FILE%}, ', ', 'line:', {$I %LINE%}, ' : ' , 'Will download - CopyFile(' + FullFileName + ', ' + NotesDir + Downloads.Items[I]^.ID + '.note'+ ')'); if not CopyFile(FullFileName, NotesDir + Downloads.Items[I]^.ID + '.note') then begin ErrorString := 'Failed to copy ' + Downloads.Items[I]^.ID + '.note'; exit(False); end; inc(DownCount); if (DownCount mod 10 = 0) then if ProgressProcedure <> nil then ProgressProcedure(rsDownLoaded + ' ' + inttostr(DownCount) + ' notes'); end; end; result := True; end; function TFileSync.DeleteNote(const ID: string; const ExistRev : integer ): boolean; begin // I _THINK_ all that happens is deleted note is not listed in remote manifest // and that is done. But other thansport modes might need to do something here ? result := True; end; function TFileSync.UploadNotes(const Uploads: TStringList): boolean; var Index : integer; UpCount : integer = 0; FullDirName : string; begin if ProgressProcedure <> nil then progressProcedure('Uploading ' + inttostr(UpLoads.Count) + ' notes'); if UsingRightRevisionPath(RemoteAddress, RemoteServerRev + 1) then FullDirName := GetRevisionDirPath(RemoteAddress, RemoteServerRev + 1) else FullDirName := RemoteAddress + '0' + PathDelim + inttostr(RemoteServerRev + 1) + PathDelim; // Ugly Hack for Index := 0 to Uploads.Count -1 do begin if DebugMode then debugln(rsUpLoading + ' ' + Uploads.Strings[Index] + '.note'); if not copyFile(NotesDir + Uploads.Strings[Index] + '.note', FullDirname + Uploads.Strings[Index] + '.note') then begin ErrorString := 'ERROR copying ' + NotesDir + Uploads.Strings[Index] + '.note to ' + FullDirName + Uploads.Strings[Index] + '.note'; debugln(ErrorString); exit(False); end; inc(UpCount); if (UpCount mod 5 = 0) and (ProgressProcedure <> nil) then progressProcedure(rsUpLoaded + ' ' + inttostr(UpCount) + ' notes'); end; result := True; end; function TFileSync.DoRemoteManifest(const RemoteManifest: string; MetaData : TNoteInfoList = nil): boolean; begin if not ForceDirectoriesUTF8(GetRevisionDirPath(RemoteAddress, RemoteServerRev + 1)) then begin ErrorString := 'Failed to create new remote revision dir ' + GetRevisionDirPath(RemoteAddress, RemoteServerRev + 1); debugln(ErrorString); exit(False); end; if debugmode then debugln('Remote Manifest is ' + RemoteManifest); if not CopyFile(RemoteManifest, RemoteAddress + 'manifest.xml') then begin ErrorString := 'Failed to move new root remote manifest file ' + RemoteManifest; debugln(ErrorString); exit(False); end; if not CopyFile(RemoteManifest, GetRevisionDirPath(RemoteAddress, RemoteServerRev + 1) + 'manifest.xml') then begin ErrorString := 'Failed to move new remote manifest file to revision dir'; debugln(ErrorString); exit(False); end; Result := True; end; function TFileSync.DownLoadNote(const ID: string; const RevNo: Integer): string; begin //Result := RemoteAddress + '0' + PathDelim + inttostr(RevNo) + PathDelim + ID + '.note'; // Due to early bug in -ng, its possible that a file on eg sync rev 393 is in // either ~/0/393 or in ~/3/393 - we cannot assume here folks ! Result := GetRevisionDirPath(RemoteAddress, RevNo, ID); if FileExists(Result) then exit; Result := RemoteAddress + '0' + PathDelim + inttostr(RevNo) + PathDelim + ID + '.note'; if not FileExists(Result) then debugln('transfile -> Download() Unable to locate file ' + inttostr(RevNo) + ' ' + ID); end; constructor TFileSync.Create(); begin ProgressProcedure := nil; end; end. tomboy-ng_0.39-1/kcontrols/0000755000175000017500000000000014551457755015460 5ustar dbannondbannontomboy-ng_0.39-1/kcontrols/.gitignore0000644000175000017500000000162614346341266017444 0ustar dbannondbannonlib/ Debug/ Release/ source/__history/ source/backup/ source/contrib/ packages/kcontrols/*.cpp packages/kcontrols/*.hpp packages/kcontrols/*.res packages/kcontrols/kcontrolsbase.pas packages/kcontrols/kcontrolslaz.pas packages/kcontrols_copies/ demos/**/*.ico demos/**/*.rtf demos/**/*.ini demos/**/*.rc demos/**/*.ico demos/**/*.png demos/**/*.jpg demos/**/*.bmp demos/kdbgrid/kdbgriddemo*.res demos/kgrid/kgriddemo*.res demos/khexeditor/hexeditor*.res demos/khexeditor/*.hex demos/kicon/demo*.res demos/kmemo/kmemodemo*.res demos/kmemoeditor/kmemoeditor*.res help/**/*.css help/**/*.chm help/**/*.chw help/**/*.gif help/**/*.hhc help/**/*.hhk help/**/*.hhp help/**/*.htm help/**/*.log resource_src/*.jpg tools/**/*.ico *.~* *.*~ *.aps *.cfg *.compiled *.db *.dsk *.dcu *.ddp *.dll *.docx *.dof *.dylib *.drc *.identcache *.ipch *.local *.lrs *.lps *.map *.o *.obj *.or *.pdf *.ppu *.psd *.so *.suo *.stat *.zip tomboy-ng_0.39-1/kcontrols/README.md0000644000175000017500000000750014346341266016730 0ustar dbannondbannon# KControls component suite for Delphi and Lazarus Original authorship: Tomas Krysl ## REPOSITORY LOCATION: The repository was originally located at https://bitbucket.org/tomkrysl/kcontrols. Since January 2020 it is on Github, moved from Bitbucket because Atlassian discontinued Mercurial VCS in 2020. The original repository should be deleted on 1th June 2020. More info at https://bitbucket.org/blog/sunsetting-mercurial-support-in-bitbucket. Bitbucket continues with GIT support but IMO GitHub is better for GIT. ## LICENSE: This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html. ## SYSTEM REQUIREMENTS: - platforms: Win32, Win64, GTK, GTK2, QT, Carbon, Cocoa, WinCE(partially tested) - IDEs: - Delphi 7 and higher (tested on Delphi 7, DelphiXE+) - Lazarus 1.2.2 and higher - maybe will work with older Delphi with minor changes - some more problems might be experienced for older Lazarus versions - see other readme files for additional informations about individual components ## INSTALLATION: 1. Compile and install package. It might be needed to specify search path to Source directory in Delphi/RAD Studio. For Rad Studio XE2 and later add VCL and VCL.Imaging namespaces to Unit Scope Names. 2. When compiling an application or demo, it might be needed to specify the search path to KControls sources or JCL sources (if JCL is configured via kcontrols.inc). ## BUG REPORTING: In case you find a bug or have ideas to improve please create an issue or pull request here: https://github.com/kryslt/KControls/issues ## IMPORTANT INFO FOR CONTRIBUTORS: You may contribute to this project, in such case: 1. clone or fork the repository on https://github.com/kryslt/KControls/ 2. implement and test your changes, if possible in all these IDEs: - Delphi 7 and latest Delphi version under Windows 7 or higher - Lazarus on Windows 7 or higher - Lazarus on some version of Linux, preferrably Ubuntu or Kubuntu. - Lazarus on MAC 3. create a pull request on https://github.com/kryslt/KControls/ or include a patch into the issue. Please KEEP IN MIND THE DIFFERENCES between Delphi and Lazarus (mainly string encoding UTF16 in Delphi vs. UTF8 in Lazarus). When working with texts, always test with different Unicode characters. Testing of bidirectional text or aligning features is not required, because right to left mode is not supported by KControls. DON'T REMOVE ANY PROTECTED OR PUBLIC STUFF, the package is already heavily used by me and others! This main repository must stay compilable in both IDEs! I will not merge any changes that violate these rules! If you need specific features please use your clone or fork. If you plan to regularly contribute to this project and have enough experiences with this kind of programming, you can be granted write access to the repository. ## VERSION HISTORY: Version 1.7 (August 2015): - Added: - TKMemo major improvements - TKPageControl, TKSpeedButton, TKSplitter components - packages up to Delphi XE8 Version 1.6 (July 2014): - Added: - TKDBGrid improvements - packages for Delphi XE6 Version 1.5 (July 2014): - Added: - new components TKBitBtn, TKColorButton, TKMemo (early alpha state!) - TKGrid improvements Version 1.4 (February 2014): - Added: - new components TKNumberEdit, TKFileNameEdit, TKLog, TKBrowseFolderDialog, TKLinkLabel, TKGradientLabel, TKPercentProgressBar - packages up to Delphi XE5 Version 1.3 (April 2012): - Added: - packages for Delphi XE2 - Modified: - no separate install packages KGrid, KHexEditor, KIcon Version 1.2 (Oktober 2010): - Update - based on KGrid 1.7, KHexEditor 1.5, KIcon 2.2 Version 1.1 (Oktober 2010): - Update - based on KGrid 1.6, KHexEditor 1.4, KIcon 2.1 Version 1.0 (October 2009): - Initial release - based on KGrid 1.5, KHexEditor 1.4, KIcon 1.8 tomboy-ng_0.39-1/kcontrols/style.css0000644000175000017500000000253614346341266017327 0ustar dbannondbannontomboy-ng_0.39-1/kcontrols/source/0000755000175000017500000000000014551457755016760 5ustar dbannondbannontomboy-ng_0.39-1/kcontrols/source/kedits.res0000644000175000017500000000156414346341266020753 0ustar dbannondbannon (,OPENDIR0(rpnnnnnnno}))))))))))8X~))`7o))`|)W})h)`{rh7o)[)`quvuqkd[)X})KR)``a`]YRKK:u)`e)))))))))))~))u)֤)))))֤))֡xto)))֤}n{zyqtomboy-ng_0.39-1/kcontrols/source/kprintpreview.pas0000644000175000017500000002436014346341266022372 0ustar dbannondbannon{ @abstract(This file is part of the KControls component suite for Delphi and Lazarus.) @author(Tomas Krysl) Copyright (c) 2020 Tomas Krysl

License:
This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html. } unit kprintpreview; // lowercase name because of Lazarus/Linux {$include kcontrols.inc} interface uses {$IFDEF FPC} LCLType, LCLIntf, LResources, {$ELSE} Windows, Messages, ToolWin, ImgList, {$ENDIF} SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ComCtrls, ActnList, Buttons, StdCtrls, ExtCtrls, KControls; type IPrintPreviewAdapter = interface function GetControl: TWinControl; function CanPrint: Boolean; procedure OnShow; procedure NextPage; procedure PreviousPage; procedure FirstPage; procedure LastPage; procedure Print; function GetFirstPageNumber: Integer; function GetLastPageNumber: Integer; function GetCurrentPageNumber: Integer; procedure SetCurrentPageNumber(Page: Integer); function GetScaleMode: TKPreviewScaleMode; procedure SetScaleMode(ScaleMode: TKPreviewScaleMode); function GetScale: Integer; procedure SetScale(Value: Integer); procedure SetPreviewChangedEvent(Event: TNotifyEvent); property FirstPageNumber: Integer read GetFirstPageNumber; property LastPageNumber: Integer read GetLastPageNumber; property CurrentPageNumber: Integer read GetCurrentPageNumber write SetCurrentPageNumber; property Scale: Integer read GetScale write SetScale; property ScaleMode: TKPreviewScaleMode read GetScaleMode write SetScaleMode; end; { TKCustomPrintPreviewForm } TKCustomPrintPreviewForm = class(TForm) ILMain: TImageList; ALMain: TActionList; ACPageFirst: TAction; ACPageLast: TAction; ACPageNext: TAction; ACPagePrevious: TAction; ACClose: TAction; ToBMain: TToolBar; TBPageFirst: TToolButton; TBPagePrevious: TToolButton; ToolButton1: TToolButton; ToolButton3: TToolButton; TBPageNext: TToolButton; TBPageLast: TToolButton; PNPage: TPanel; EDPage: TEdit; UDPage: TUpDown; ToolButton6: TToolButton; PNScale: TPanel; CoBScale: TComboBox; TBClose: TToolButton; TBPrint: TToolButton; ToolButton4: TToolButton; ACPrint: TAction; procedure CoBScaleExit(Sender: TObject); procedure FormShow(Sender: TObject); procedure ACPageFirstExecute(Sender: TObject); procedure ACPageFirstUpdate(Sender: TObject); procedure ACPagePreviousExecute(Sender: TObject); procedure ACPageNextExecute(Sender: TObject); procedure ACPageNextUpdate(Sender: TObject); procedure ACPageLastExecute(Sender: TObject); procedure ACCloseExecute(Sender: TObject); procedure ACCloseUpdate(Sender: TObject); procedure EDPageExit(Sender: TObject); procedure UDPageClick(Sender: TObject; Button: TUDBtnType); procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure ACPrintExecute(Sender: TObject); procedure ACPrintUpdate(Sender: TObject); procedure FormCreate(Sender: TObject); procedure EDPageKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); private FAdapter: IPrintPreviewAdapter; procedure ScaleChanged; procedure CurrentPageChanged(Sender: TObject = nil); public constructor Create(AOwner: TComponent; AAdapter: IPrintPreviewAdapter); reintroduce; property Adapter: IPrintPreviewAdapter read FAdapter; end; { TKPrintPreviewForm } TKPrintPreviewForm = class(TKCustomPrintPreviewForm, IPrintPreviewAdapter) private FPreview: TKPrintPreview; // IPrintPreviewAdapter function GetControl: TWinControl; function CanPrint: Boolean; procedure OnShow; procedure NextPage; procedure PreviousPage; procedure FirstPage; procedure LastPage; procedure Print; function GetFirstPageNumber: Integer; function GetLastPageNumber: Integer; function GetCurrentPageNumber: Integer; procedure SetCurrentPageNumber(Page: Integer); function GetScaleMode: TKPreviewScaleMode; procedure SetScaleMode(ScaleMode: TKPreviewScaleMode); function GetScale: Integer; procedure SetScale(Value: Integer); procedure SetPreviewChangedEvent(Event: TNotifyEvent); public constructor Create(AOwner: TComponent); reintroduce; property Preview: TKPrintPreview read FPreview; end; implementation {$IFDEF FPC} {$R *.lfm} {$ELSE} {$R *.dfm} {$ENDIF} uses KFunctions; { TKCustomPrintPreviewForm } constructor TKCustomPrintPreviewForm.Create(AOwner: TComponent; AAdapter: IPrintPreviewAdapter); begin inherited CReate(AOwner); FAdapter := AAdapter; end; procedure TKCustomPrintPreviewForm.FormCreate(Sender: TObject); var PreviewControl: TWinControl; begin CoBScale.ItemIndex := 9; // page width PreviewControl := Adapter.GetControl; PreviewControl.Parent := Self; PreviewControl.Align := alClient; PreviewControl.TabStop := True; PreviewControl.TabOrder := 0; end; procedure TKCustomPrintPreviewForm.FormShow(Sender: TObject); begin FAdapter.SetPreviewChangedEvent(CurrentPageChanged); Adapter.OnShow; UDPage.Min := Adapter.FirstPageNumber; UDPage.Max := Adapter.LastPageNumber; end; procedure TKCustomPrintPreviewForm.CoBScaleExit(Sender: TObject); begin ScaleChanged; end; procedure TKCustomPrintPreviewForm.ACPageFirstExecute(Sender: TObject); begin Adapter.FirstPage; end; procedure TKCustomPrintPreviewForm.ACPageFirstUpdate(Sender: TObject); begin TAction(Sender).Enabled := Adapter.CurrentPageNumber > Adapter.FirstPageNumber; end; procedure TKCustomPrintPreviewForm.ACPagePreviousExecute(Sender: TObject); begin Adapter.PreviousPage; end; procedure TKCustomPrintPreviewForm.ACPageNextExecute(Sender: TObject); begin Adapter.NextPage; end; procedure TKCustomPrintPreviewForm.ACPageNextUpdate(Sender: TObject); begin TAction(Sender).Enabled := Adapter.CurrentPageNumber < Adapter.LastPageNumber; end; procedure TKCustomPrintPreviewForm.ACPageLastExecute(Sender: TObject); begin Adapter.LastPage; end; procedure TKCustomPrintPreviewForm.ACPrintExecute(Sender: TObject); begin Adapter.Print; end; procedure TKCustomPrintPreviewForm.ACPrintUpdate(Sender: TObject); begin TAction(Sender).Enabled := Adapter.CanPrint; end; procedure TKCustomPrintPreviewForm.ACCloseExecute(Sender: TObject); begin Close; end; procedure TKCustomPrintPreviewForm.ACCloseUpdate(Sender: TObject); begin TAction(Sender).Enabled := True; end; procedure TKCustomPrintPreviewForm.EDPageExit(Sender: TObject); begin Adapter.CurrentPageNumber := MinMax(StrToIntDef(EDPage.Text, Adapter.CurrentPageNumber), Adapter.FirstPageNumber, Adapter.LastPageNumber); CurrentPageChanged; end; procedure TKCustomPrintPreviewForm.EDPageKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin if Key = VK_RETURN then EDPageExit(nil); end; procedure TKCustomPrintPreviewForm.UDPageClick(Sender: TObject; Button: TUDBtnType); begin EDPageExit(nil); end; procedure TKCustomPrintPreviewForm.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin if Key = VK_ESCAPE then begin Close; Key := 0; end; end; procedure TKCustomPrintPreviewForm.ScaleChanged; var S: string; begin S := CoBScale.Text; if CoBScale.Items.IndexOf(S) < 0 then CoBScale.ItemIndex := -1; case CoBScale.ItemIndex of -1: begin while (S <> '') and not CharInSetEx(S[Length(S)], ['0'..'9']) do Delete(S, Length(S), 1); Adapter.Scale := StrToIntDef(S, 100); end; 0: Adapter.Scale := 25; 1: Adapter.Scale := 50; 2: Adapter.Scale := 75; 3: Adapter.Scale := 100; 4: Adapter.Scale := 125; 5: Adapter.Scale := 150; 6: Adapter.Scale := 200; 7: Adapter.Scale := 500; end; case CoBScale.ItemIndex of -1: begin Adapter.ScaleMode := smScale; CobScale.Text := Format('%d %%', [Adapter.Scale]); end; 0..7: Adapter.ScaleMode := smScale; 8: Adapter.ScaleMode := smWholePage; 9: Adapter.ScaleMode := smPageWidth; end; end; procedure TKCustomPrintPreviewForm.CurrentPageChanged(Sender: TObject); begin EDPage.Text := IntToStr(Adapter.CurrentPageNumber); end; { TKPrintPreviewForm } constructor TKPrintPreviewForm.Create(AOwner: TComponent); begin inherited Create(AOwner, Self); FPreview := TKPrintPreview.Create(Self); FPreview.DoubleBuffered := True; end; procedure TKPrintPreviewForm.FirstPage; begin Preview.FirstPage; end; function TKPrintPreviewForm.GetControl: TWinControl; begin Result := Preview; end; function TKPrintPreviewForm.CanPrint: Boolean; begin Result := Assigned(Preview.Control) and Preview.Control.CanPrint; end; procedure TKPrintPreviewForm.OnShow; begin end; function TKPrintPreviewForm.GetCurrentPageNumber: Integer; begin Result := Preview.Page; end; function TKPrintPreviewForm.GetFirstPageNumber: Integer; begin Result := Preview.StartPage; end; function TKPrintPreviewForm.GetLastPageNumber: Integer; begin Result := Preview.EndPage; end; function TKPrintPreviewForm.GetScale: Integer; begin REsult := Preview.Scale; end; function TKPrintPreviewForm.GetScaleMode: TKPreviewScaleMode; begin Result := Preview.ScaleMode; end; procedure TKPrintPreviewForm.LastPage; begin Preview.LastPage; end; procedure TKPrintPreviewForm.NextPage; begin Preview.NextPage; end; procedure TKPrintPreviewForm.PreviousPage; begin Preview.PreviousPage; end; procedure TKPrintPreviewForm.Print; begin Preview.Control.PrintOut end; procedure TKPrintPreviewForm.SetCurrentPageNumber(Page: Integer); begin Preview.Page := Page; end; procedure TKPrintPreviewForm.SetPreviewChangedEvent(Event: TNotifyEvent); begin FPreview.OnChanged := Event; end; procedure TKPrintPreviewForm.SetScale(Value: Integer); begin Preview.Scale := Value; end; procedure TKPrintPreviewForm.SetScaleMode(ScaleMode: TKPreviewScaleMode); begin Preview.ScaleMode := ScaleMode; end; end. tomboy-ng_0.39-1/kcontrols/source/kcontrols.inc0000644000175000017500000001740014346341266021462 0ustar dbannondbannon{ @abstract(This file is part of the KControls component suite for Delphi and Lazarus.) @author(Tomas Krysl) Copyright (c) 2020 Tomas Krysl

License:
This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html. } {$IFNDEF KCONTROLS_INC} {$DEFINE KCONTROLS_INC} { Default compiler directives for entire KControls Development Suite } {$IFDEF FPC} {$MODE DELPHI} {$B-,H+,J+,Q-,R-,T-,X+} {$ELSE} {$B-,H+,J+,Q-,R-,T-,X+} {$ENDIF} { Specifies if native operating system theme support should be used (Themes.pas is needed) } {$DEFINE USE_THEMES} { COMPILERx, DELPHIx and BCBx directives from VERx } {$IFDEF VER320} {$DEFINE COMPILER25} {$IFDEF BCB} {$DEFINE BCB10C} {$ELSE} {$DEFINE DELPHI10C} {$ENDIF} {$ENDIF} {$IFDEF VER310} {$DEFINE COMPILER24} {$IFDEF BCB} {$DEFINE BCB10B} {$ELSE} {$DEFINE DELPHI10B} {$ENDIF} {$ENDIF} {$IFDEF VER300} {$DEFINE COMPILER23} {$IFDEF BCB} {$DEFINE BCB10S} {$ELSE} {$DEFINE DELPHI10S} {$ENDIF} {$ENDIF} {$IFDEF VER290} {$DEFINE COMPILER22} {$IFDEF BCB} {$DEFINE BCBXE8} {$ELSE} {$DEFINE DELPHIXE8} {$ENDIF} {$ENDIF} {$IFDEF VER280} {$DEFINE COMPILER21} {$IFDEF BCB} {$DEFINE BCBXE7} {$ELSE} {$DEFINE DELPHIXE7} {$ENDIF} {$ENDIF} {$IFDEF VER270} {$DEFINE COMPILER20} {$IFDEF BCB} {$DEFINE BCBXE6} {$ELSE} {$DEFINE DELPHIXE6} {$ENDIF} {$ENDIF} {$IFDEF VER260} {$DEFINE COMPILER19} {$IFDEF BCB} {$DEFINE BCBXE5} {$ELSE} {$DEFINE DELPHIXE5} {$ENDIF} {$ENDIF} {$IFDEF VER250} {$DEFINE COMPILER18} {$IFDEF BCB} {$DEFINE BCBXE4} {$ELSE} {$DEFINE DELPHIXE4} {$ENDIF} {$ENDIF} {$IFDEF VER240} {$DEFINE COMPILER17} {$IFDEF BCB} {$DEFINE BCBXE3} {$ELSE} {$DEFINE DELPHIXE3} {$ENDIF} {$ENDIF} {$IFDEF VER230} {$DEFINE COMPILER16} {$IFDEF BCB} {$DEFINE BCBXE2} {$ELSE} {$DEFINE DELPHIXE2} {$ENDIF} {$ENDIF} {$IFDEF VER220} {$DEFINE COMPILER15} {$IFDEF BCB} {$DEFINE BCBXE} {$ELSE} {$DEFINE DELPHIXE} {$ENDIF} {$ENDIF} {$IFDEF VER210} {$DEFINE COMPILER14} {$IFDEF BCB} {$DEFINE BCB2010} {$ELSE} {$DEFINE DELPHI2010} {$ENDIF} {$ENDIF} {$IFDEF VER200} {$DEFINE COMPILER12} {$IFDEF BCB} {$DEFINE BCB2009} {$ELSE} {$DEFINE DELPHI2009} {$ENDIF} {$ENDIF} {$IFDEF VER180} {$IFDEF VER185} {$DEFINE COMPILER11} {$IFDEF BCB} {$DEFINE BCB2007} {$ELSE} {$DEFINE DELPHI2007} {$ENDIF} {$ELSE} {$DEFINE COMPILER10} {$IFDEF BCB} {$DEFINE BCB2006} {$ELSE} {$DEFINE DELPHI2006} {$ENDIF} {$ENDIF} {$ENDIF} {$IFDEF VER170} {$DEFINE COMPILER9} {$DEFINE DELPHI2005} {$ENDIF} {$IFDEF VER160} {$DEFINE COMPILER8} {$DEFINE DELPHI8} {$ENDIF} {$IFDEF VER150} {$DEFINE COMPILER7} {$DEFINE DELPHI7} {$ENDIF} {$IFDEF VER140} {$DEFINE COMPILER6} {$IFDEF BCB} {$DEFINE BCB6} {$ELSE} {$DEFINE DELPHI6} {$ENDIF} {$ENDIF} {$IFDEF VER130} {$DEFINE COMPILER5} {$IFDEF BCB} {$DEFINE BCB5} {$ELSE} {$DEFINE DELPHI5} {$ENDIF} {$ENDIF} {$IFDEF VER125} {$DEFINE COMPILER4} {$DEFINE BCB} {$DEFINE BCB4} {$ENDIF} {$IFDEF VER120} {$DEFINE COMPILER4} {$DEFINE DELPHI4} {$ENDIF} {$IFDEF VER110} {$DEFINE COMPILER3} {$DEFINE BCB} {$DEFINE BCB3} {$ENDIF} {$IFDEF VER100} {$DEFINE COMPILER3} {$DEFINE DELPHI3} {$ENDIF} {$IFDEF VER93} {$DEFINE COMPILER2} {$DEFINE BCB} {$DEFINE BCB1} {$ENDIF} {$IFDEF VER90} {$DEFINE COMPILER2} {$DEFINE DELPHI2} {$ENDIF} { What is used: DELPHI or BCB ? (BCB is defined by C++Builder 5 and later) } {$IFNDEF BCB} {$DEFINE DELPHI} {$ENDIF} { COMPILERx_UP directives from COMPILERx } {$IFDEF COMPILER25} {$DEFINE COMPILER25_UP} {$ENDIF} {$IFDEF COMPILER24} {$DEFINE COMPILER24_UP} {$ENDIF} {$IFDEF COMPILER23} {$DEFINE COMPILER23_UP} {$ENDIF} {$IFDEF COMPILER22} {$DEFINE COMPILER22_UP} {$ENDIF} {$IFDEF COMPILER21} {$DEFINE COMPILER21_UP} {$ENDIF} {$IFDEF COMPILER20} {$DEFINE COMPILER20_UP} {$ENDIF} {$IFDEF COMPILER19} {$DEFINE COMPILER19_UP} {$ENDIF} {$IFDEF COMPILER18} {$DEFINE COMPILER18_UP} {$ENDIF} {$IFDEF COMPILER17} {$DEFINE COMPILER17_UP} {$ENDIF} {$IFDEF COMPILER16} {$DEFINE COMPILER16_UP} {$ENDIF} {$IFDEF COMPILER15} {$DEFINE COMPILER15_UP} {$ENDIF} {$IFDEF COMPILER14} {$DEFINE COMPILER14_UP} {$ENDIF} {$IFDEF COMPILER12} {$DEFINE COMPILER12_UP} {$ENDIF} {$IFDEF COMPILER11} {$DEFINE COMPILER11_UP} {$ENDIF} {$IFDEF COMPILER10} {$DEFINE COMPILER10_UP} {$ENDIF} {$IFDEF COMPILER9} {$DEFINE COMPILER9_UP} {$ENDIF} {$IFDEF COMPILER8} {$DEFINE COMPILER8_UP} {$ENDIF} {$IFDEF COMPILER7} {$DEFINE COMPILER7_UP} {$ENDIF} {$IFDEF COMPILER6} {$DEFINE COMPILER6_UP} {$ENDIF} {$IFDEF COMPILER5} {$DEFINE COMPILER5_UP} {$ENDIF} {$IFDEF COMPILER4} {$DEFINE COMPILER4_UP} {$ENDIF} {$IFDEF COMPILER3} {$DEFINE COMPILER3_UP} {$ENDIF} {$IFDEF COMPILER2} {$DEFINE COMPILER2_UP} {$ENDIF} {$IFDEF COMPILER25_UP} {$DEFINE COMPILER24_UP} {$ENDIF} {$IFDEF COMPILER24_UP} {$DEFINE COMPILER23_UP} {$ENDIF} {$IFDEF COMPILER23_UP} {$DEFINE COMPILER22_UP} {$ENDIF} {$IFDEF COMPILER22_UP} {$DEFINE COMPILER21_UP} {$ENDIF} {$IFDEF COMPILER21_UP} {$DEFINE COMPILER20_UP} {$ENDIF} {$IFDEF COMPILER20_UP} {$DEFINE COMPILER19_UP} {$ENDIF} {$IFDEF COMPILER19_UP} {$DEFINE COMPILER18_UP} {$ENDIF} {$IFDEF COMPILER18_UP} {$DEFINE COMPILER17_UP} {$ENDIF} {$IFDEF COMPILER17_UP} {$DEFINE COMPILER16_UP} {$ENDIF} {$IFDEF COMPILER16_UP} {$DEFINE COMPILER15_UP} {$ENDIF} {$IFDEF COMPILER15_UP} {$DEFINE COMPILER14_UP} {$ENDIF} {$IFDEF COMPILER14_UP} {$DEFINE COMPILER12_UP} {$ENDIF} {$IFDEF COMPILER12_UP} {$DEFINE COMPILER11_UP} {$ENDIF} {$IFDEF COMPILER11_UP} {$DEFINE COMPILER10_UP} {$ENDIF} {$IFDEF COMPILER10_UP} {$DEFINE COMPILER9_UP} {$ENDIF} {$IFDEF COMPILER9_UP} {$DEFINE COMPILER8_UP} {$ENDIF} {$IFDEF COMPILER8_UP} {$DEFINE COMPILER7_UP} {$ENDIF} {$IFDEF COMPILER7_UP} {$DEFINE COMPILER6_UP} {$ENDIF} {$IFDEF COMPILER6_UP} {$DEFINE COMPILER5_UP} {$ENDIF} {$IFDEF COMPILER5_UP} {$DEFINE COMPILER4_UP} {$ENDIF} {$IFDEF COMPILER4_UP} {$DEFINE COMPILER3_UP} {$ENDIF} {$IFDEF COMPILER3_UP} {$DEFINE COMPILER2_UP} {$ENDIF} {$IFDEF COMPILER2_UP} {$DEFINE COMPILER1_UP} {$ENDIF} { Unicode compiler directive for string type } // Delphi 2009+ uses UTF16, Lazarus 0.9.25+ uses UTF8 {$IF DEFINED(COMPILER12_UP) OR DEFINED(FPC)} {$DEFINE STRING_IS_UNICODE} {$IFEND} { Prefers usage of TCanvas methods instead of WinAPI mainly to avoid problems in Lazarus. } {$DEFINE USE_CANVAS_METHODS} { Register new image formats into TPicture. } {.$DEFINE REGISTER_PICTURE_FORMATS} { Allows to use WideWinProcs unit } {$IFDEF MSWINDOWS} {.$DEFINE USE_WIDEWINPROCS} {$ENDIF} {$DEFINE LAZARUS_HAS_DC_MAPPING} {$IF DEFINED(USE_WINAPI) OR DEFINED(LAZARUS_HAS_DC_MAPPING)} {$DEFINE USE_DC_MAPPING} {$IFEND} { Conditional defines for unit KGrids: } // we want TKGridObjectCell to be a descendant of TKGridAttrTextCell {$DEFINE TKGRIDOBJECTCELL_IS_TKGRIDATTRTEXTCELL} // we want TKGridObjectCell to be a descendant of TKGridTextCell {.$DEFINE TKGRIDOBJECTCELL_IS_TKGRIDTEXTCELL} // use JCLUnicode (only for TKGridAxisItem.Assign(Source: TWideStrings);) {.$DEFINE TKGRID_USE_JCL} { Conditional defines for unit KDBGrids: } // we want to use TKDBGrid {$DEFINE TKDBGRID_USE} // we want TKDBGridCell to be a descendant of TKGridAttrTextCell {.$DEFINE TKDBGRIDCELL_IS_TKGRIDATTRTEXTCELL} // PngImage can be used {$IF DEFINED(FPC) OR DEFINED(COMPILER12_UP)} {$DEFINE USE_PNG_SUPPORT} {$IFEND} {$ENDIF ~KCONTROLS_INC} tomboy-ng_0.39-1/kcontrols/source/keditcommon.pas0000644000175000017500000006166514346341266022003 0ustar dbannondbannon{ @abstract(This file is part of the KControls component suite for Delphi and Lazarus.) @author(Tomas Krysl) Copyright (c) 2020 Tomas Krysl

License:
This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html. } unit keditcommon; // lowercase name because of Lazarus/Linux {$include kcontrols.inc} {$WEAKPACKAGEUNIT ON} interface uses {$IFDEF FPC} LCLType, LCLIntf, LCLProc, LMessages, LResources, {$IFDEF MSWINDOWS}Windows,{$ENDIF} {$ELSE} Windows, Messages, {$ENDIF} SysUtils, Classes, ClipBrd, Graphics, Controls, ComCtrls, Forms, StdCtrls, KFunctions; const cCharMappingSize = 256; type { Declares possible values for the edit control commands. } TKEditCommand = ( { No command } ecNone, { Move caret left one char } ecLeft, { Move caret right one char } ecRight, { Move caret up one line } ecUp, { Move caret down one line } ecDown, { Move caret to beginning of line } ecLineStart, { Move caret to end of line } ecLineEnd, { Move caret left one word } ecWordLeft, { Move caret right one word } ecWordRight, { Move caret up one page } ecPageUp, { Move caret down one page } ecPageDown, { Move caret left one page } ecPageLeft, { Move caret right one page } ecPageRight, { Move caret to top of page } ecPageTop, { Move caret to bottom of page } ecPageBottom, { Move caret to absolute beginning } ecEditorTop, { Move caret to absolute end } ecEditorBottom, { Move caret to specific coordinates, Data = ^TPoint } ecGotoXY, { Move caret left one char } ecSelLeft, { Move caret right one char, affecting selection } ecSelRight, { Move caret up one line, affecting selection } ecSelUp, { Move caret down one line, affecting selection } ecSelDown, { Move caret to beginning of line, affecting selection } ecSelLineStart, { Move caret to end of line, affecting selection } ecSelLineEnd, { Move caret left one word, affecting selection } ecSelWordLeft, { Move caret right one word, affecting selection } ecSelWordRight, { Move caret up one page, affecting selection } ecSelPageUp, { Move caret down one page, affecting selection } ecSelPageDown, { Move caret left one page, affecting selection } ecSelPageLeft, { Move caret right one page, affecting selection } ecSelPageRight, { Move caret to top of page, affecting selection } ecSelPageTop, { Move caret to bottom of page, affecting selection } ecSelPageBottom, { Move caret to absolute beginning, affecting selection } ecSelEditorTop, { Move caret to absolute end, affecting selection } ecSelEditorBottom, { Move caret to specific coordinates, affecting selection, Data = ^TPoint } ecSelGotoXY, { Scroll up one line leaving caret position unchanged } ecScrollUp, { Scroll down one line leaving caret position unchanged } ecScrollDown, { Scroll left one char leaving caret position unchanged } ecScrollLeft, { Scroll right one char leaving caret position unchanged } ecScrollRight, { Scroll to center the caret position within client area } ecScrollCenter, { Undo previous action } ecUndo, { Redo last undone action } ecRedo, { Copy selection to clipboard } ecCopy, { Cut selection to clipboard } ecCut, { Paste clipboard to current position } ecPaste, { Insert character at current position, Data = ^Char } ecInsertChar, { Insert digits (digit string) at current position, Data = ^string (must contain digits only), TKCustomHexEditor only } ecInsertDigits, { Insert string (multiple characters) at current position, Data = ^string } ecInsertString, { Insert new line } ecInsertNewLine, { Delete last character (i.e. backspace key) } ecDeleteLastChar, { Delete character at caret (i.e. delete key) } ecDeleteChar, { Delete from caret to beginning of line } ecDeleteBOL, { Delete from caret to end of line } ecDeleteEOL, { Delete current line } ecDeleteLine, { Select everything } ecSelectAll, { Delete everything } ecClearAll, { Delete selection (no digit selection), TKCustomHexEditor only } ecClearIndexSelection, { Delete selection (digit selection as well) } ecClearSelection, { Search for text/digits } ecSearch, { Replace text/digits } ecReplace, { Set insert mode } ecInsertMode, { Set overwrite mode } ecOverwriteMode, { Toggle insert/overwrite mode } ecToggleMode, { Adjust editor when getting input focus } ecGotFocus, { Adjust editor when losing input focus } ecLostFocus ); { Declares possible values for control's DisabledDrawStyle property. } TKEditDisabledDrawStyle = ( { The lines will be painted with brighter colors when editor is disabled. } eddBright, { The lines will be painted with gray text and white background when editor is disabled. } eddGrayed, { The lines will be painted normally when editor is disabled. } eddNormal ); { @abstract(Declares the keystroke information structure for the Key member of the @link(TKEditCommandAssignment) structure)
    Members:
  • Key - virtual key code
  • Shift - shift state that belongs to that key code
} TKEditKey = record Key: Word; Shift: TShiftState; end; { @abstract(Declares the @link(TKEditKeyMapping) array item)
    Members:
  • Command - command that is about to be executed
  • Key - key combination necessary to execute that command
} TKEditCommandAssignment = record Key: TKEditKey; Command: TKEditCommand; end; TKEditCommandMap = array of TKEditCommandAssignment; { @abstract(Declares OnDropFiles event handler)
    Parameters:
  • Sender - identifies the event caller
  • X, Y - mouse cursor coordinates (relative to the caller's window)
  • Files - list of file names that were dropped on the caller's window)
} TKEditDropFilesEvent = procedure(Sender: TObject; X, Y: integer; Files: TStrings) of object; { Declares key mapping class for the KeyMapping property } TKEditKeyMapping = class(TObject) private function GetAssignment(AIndex: Integer): TKEditCommandAssignment; function GetKey(AIndex: TKEditCommand): TKEditKey; procedure SetKey(AIndex: TKEditCommand; const AValue: TKEditKey); protected FMap: TKEditCommandMap; procedure CreateMap; virtual; public constructor Create; procedure Assign(Source: TKEditKeyMapping); virtual; procedure AddKey(Command: TKEditCommand; Key: Word; Shift: TShiftState); class function EmptyMap: TKEditCommandAssignment; function FindCommand(AKey: Word; AShift: TShiftState): TKEditCommand; property Assignment[Index: Integer]: TKEditCommandAssignment read GetAssignment; property Key[AIndex: TKEditCommand]: TKEditKey read GetKey write SetKey; property Map: TKEditCommandMap read FMap; end; { Declares character mapping array for the edit control's CharMapping property } TKEditCharMapping = array of AnsiChar; { Pointer to @link(TKEditCharMapping) } PKEditCharMapping = ^TKEditCharMapping; { Declares options - possible values for the edit control's Options property } TKEditOption = ( { The editor will receive dropped files } eoDropFiles, { The blinking caret should be disabled } eoDisableCaret, { All undo/redo operations of the same kind will be grouped together } eoGroupUndo, { The editor allows undo/redo operations after the edit control's Modified property has been set to False } eoUndoAfterSave, { TKMemo only: Will draw each character separately. } eoDrawSingleChars, { TKMemo only: Use ScrollWindowEx to scroll the control. } eoScrollWindow, { TKMemo only: show formatting markers. } eoShowFormatting, { TKMemo only: acquire TAB characters. } eoWantTab, { TKMemo only: Will wrap text at each character. } eoWrapSingleChars ); { Options can be arbitrary combined } TKEditOptions = set of TKEditOption; { Declares possible values for the Action parameter in the @link(TKEditReplaceTextEvent) event } TKEditReplaceAction = ( { Quit replace sequence } eraCancel, { Replace this occurence } eraYes, { Don't replace this occurence } eraNo, { Replace all following occurences without prompting } eraAll ); { @abstract(Declares OnReplaceText event handler)
    Parameters:
  • Sender - identifies the event caller
  • TextToFind - current search string
  • TextToReplace - current replace string
  • Action - specifies how the replace function should continue
} TKEditReplaceTextEvent = procedure(Sender: TObject; const TextToFind, TextToReplace: string; var Action: TKEditReplaceAction) of object; { Declares possible values for the ErrorReason member of the @link(TKEditSearchData) structure } TKEditSearchError = ( { No error occurred } eseOk, { There is a character in the search string that cannot be interpreted as hexadecimal digits} eseNoDigitsFind, { There is a character in the replace string that cannot be interpreted as hexadecimal digits} eseNoDigitsReplace, { No other search string found } eseNoMatch ); { Declares search options - possible values for the Options member of the @link(TKEditSearchData) structure } TKEditSearchOption = ( { Replace all occurences } esoAll, { Search backwards } esoBackwards, { Search entire scope instead from current caret position } esoEntireScope, { Include to identify search - this element will be automatically cleared to provide the @link(TKEditSearchData) structure for additional search } esoFirstSearch, { Match case when a binary search should be executed } esoMatchCase, { Prompt user before a string is about to be replaced. This assumes @link(OnReplaceText) is assigned } esoPrompt, { Search the current selection only } esoSelectedOnly, { Treat the supplied search and/or replace strings as hexadecimal sequence. When the search string contains a character that cannot be interpreted as hexadecimal digit, the execution stops and @link(eseNoDigitsFind) error will be returned. Similarly, @link(eseNoDigitsReplace) errors will be returned on invalid replace string } esoTreatAsDigits, { Internal option - don't modify } esoWereDigits ); { Search options can be arbitrary combined } TKEditSearchOptions = set of TKEditSearchOption; { @abstract(Declares the search/replace description structure for the @link(ecSearch) and @link(ecReplace) commands)
    Members:
  • ErrorReason - upon @link(ExecuteCommand)(ecSearch) or ExecuteCommand(ecReplace), inspect this member to inform user about search/replace result
  • Options - defines search/replace options
  • SelStart, SelEnd - internal parameters, don't modify
  • TextToFind - search string
  • TextToReplace - replace string
} TKEditSearchData = record ErrorReason: TKEditSearchError; Options: TKEditSearchOptions; SelStart, SelEnd: Int64; TextToFind, TextToReplace: string; end; { Pointer to @link(TKEditSearchData) } PKEditSearchData = ^TKEditSearchData; const { Default value for the @link(TKCustomHexEditor.DisabledDrawStyle) property } cEditDisabledDrawStyleDef = eddBright; { Returns default key mapping structure } function CreateDefaultKeyMapping: TKEditKeyMapping; { Returns default char mapping structure } function DefaultCharMapping: TKEditCharMapping; { Returns default search data structure } function DefaultSearchData: TKEditSearchData; { Returns True if focused window is some text editing window, such as TEdit. } function EditIsFocused(AMustAllowWrite: Boolean): Boolean; { Returns True if some text editing window is focused and contains a selectable text. } function EditFocusedTextCanCopy: Boolean; { Returns True if some non-readonly text editing window is focused and contains a selectable text. } function EditFocusedTextCanCut: Boolean; { Returns True if some non-readonly text editing window is focused. } function EditFocusedTextCanDelete: Boolean; { Returns True if some non-readonly text editing window is focused and clipboard is not empty. } function EditFocusedTextCanPaste: Boolean; { Returns True if the focused text editing window can perform an undo operation. } function EditFocusedTextCanUndo: Boolean; { Performs an undo operation on the focused text editing window. } procedure EditUndoFocused; { Performs a delete operation on the focused text editing window. } procedure EditDeleteFocused; { Performs a clipboard cut operation on the focused text editing window. } procedure EditCutFocused; { Performs a clipboard copy operation on the focused text editing window. } procedure EditCopyFocused; { Performs a clipboard paste operation on the focused text editing window. } procedure EditPasteFocused; { Performs a select all operation on the focused text editing window. } procedure EditSelectAllFocused; function PixelsPerInchX(AHandle: HWND): Integer; function PixelsPerInchY(AHandle: HWND): Integer; function TwipsPerPixelX(AHandle: HWND): Double; function TwipsPerPixelY(AHandle: HWND): Double; function PixelsToPoints(AValue: Integer; ADPI: Integer): Double; function PointsToPixels(AValue: Double; ADPI: Integer): Integer; function TwipsToPoints(AValue: Integer; ADPI: Integer): Double; function PointsToTwips(AValue: Double; ADPI: Integer): Integer; { Converts binary data into text using given character mapping.
    Parameters:
  • Buffer - binary data - intended for @link(TKCustomHexEditor.Buffer)
  • SelStart, SelEnd - specifies which part of the buffer is about to be converted. SelStart must be lower or equal to SelEnd. These parameters are integers since no digit selections are necessary.
  • CharMapping - required character mapping scheme
} function BinaryToText(Buffer: PBytes; SelStart, SelEnd: Int64; CharMapping: PKEditCharMapping): AnsiString; function ReplaceNonprintableCharacters(const AText: AnsiString; AMapping: TKEditCharMapping = nil): AnsiString; implementation uses KControls, KMemo; function PixelsPerInchX(AHandle: HWND): Integer; var DC: HDC; begin DC := GetDC(AHandle); try Result := GetDeviceCaps(DC, LOGPIXELSX); finally ReleaseDC(AHandle, DC); end; end; function PixelsPerInchY(AHandle: HWND): Integer; var DC: HDC; begin DC := GetDC(AHandle); try Result := GetDeviceCaps(DC, LOGPIXELSY); finally ReleaseDC(AHandle, DC); end; end; function TwipsPerPixelX(AHandle: HWND): Double; begin Result := 1440 / PixelsPerInchX(AHandle); end; function TwipsPerPixelY(AHandle: HWND): Double; begin Result := 1440 / PixelsPerInchY(AHandle); end; function PixelsToPoints(AValue, ADPI: Integer): Double; begin Result := AValue * 72 / ADPI; end; function PointsToPixels(AValue: Double; ADPI: Integer): Integer; begin Result := Round(AValue * ADPI / 72); end; function TwipsToPoints(AValue: Integer; ADPI: Integer): Double; begin Result := AValue * 1440 / ADPI; end; function PointsToTwips(AValue: Double; ADPI: Integer): Integer; begin Result := Round(AValue * ADPI / 1440); end; function BinaryToText(Buffer: PBytes; SelStart, SelEnd: Int64; CharMapping: PKEditCharMapping): AnsiString; var I: Integer; begin if SelEnd > SelStart then begin SetLength(Result, SelEnd - SelStart); System.Move(Buffer[SelStart], Result[1], SelEnd - SelStart); if CharMapping <> nil then for I := 1 to Length(Result) do Result[I] := CharMapping^[Byte(Result[I])]; end else Result := ''; end; function ReplaceNonprintableCharacters(const AText: AnsiString; AMapping: TKEditCharMapping = nil): AnsiString; var I: Integer; begin if AMapping = nil then AMapping := DefaultCharMapping; SetLength(Result, Length(AText)); for I := 1 to Length(AText) do Result[I] := AMapping[Ord(AText[I])]; end; function CreateDefaultKeyMapping: TKEditKeyMapping; begin Result := TKEditKeyMapping.Create; end; function DefaultCharMapping: TKEditCharMapping; var I: Integer; begin SetLength(Result, cCharMappingSize); for I := 0 to cCharMappingSize - 1 do if (I < $20) or (I >= $80) then Result[I] := '.' else Result[I] := AnsiChar(I); end; function DefaultSearchData: TKEditSearchData; begin with Result do begin ErrorReason := eseOk; Options := [esoAll, esoFirstSearch, esoPrompt, esoTreatAsDigits]; SelStart := 0; SelEnd := 0; TextToFind := ''; TextToReplace := ''; end; end; {$IFDEF MSWINDOWS} function EditFocusedHandle(AMustAllowWrite: Boolean): THandle; var Len: Integer; Wnd: HWND; S: string; C: TWinControl; begin Result := 0; Wnd := GetFocus; C := FindControl(Wnd); if (C <> nil) and (C is TCustomEdit) and (not AMustAllowWrite or not TEdit(C).ReadOnly) or (C is TCustomMemo) and (not AMustAllowWrite or not TMemo(C).ReadOnly) or (C is TComboBox) and (TComboBox(C).Style in [csSimple, csDropDown]) {$IFnDEF FPC} or (C is TRichEdit) and (not AMustAllowWrite or not TRichEdit(C).ReadOnly) {$ENDIF} or (C is TKCustomMemo) and (not AMustAllowWrite or not TKCustomMemo(C).ReadOnly) then Result := Wnd else begin SetLength(S, 100); Len := GetClassName(Wnd, PChar(S), 100); if Len > 0 then begin SetLength(S, Len); S := UpperCase(S); if (S = 'EDIT') then Result := Wnd; end; end; end; {$ENDIF} function EditIsFocused(AMustAllowWrite: Boolean): Boolean; {$IFDEF MSWINDOWS} begin Result := EditFocusedHandle(AMustAllowWrite) <> 0; end; {$ELSE} begin // can this be implemented somehow? Result := False; end; {$ENDIF} function EditFocusedTextHasSelection(AMustAllowWrite: Boolean): Boolean; {$IFDEF MSWINDOWS} var A, B: Integer; Wnd: THandle; begin Wnd := EditFocusedHandle(AMustAllowWrite); if Wnd <> 0 then begin SendMessage(Wnd, EM_GETSEL, WParam(@A), LParam(@B)); Result := A <> B; end else Result := False; end; {$ELSE} begin // can this be implemented somehow? Result := False; end; {$ENDIF} function EditFocusedTextCanCopy: Boolean; begin Result := EditFocusedTextHasSelection(False); end; function EditFocusedTextCanCut: Boolean; begin Result := EditFocusedTextHasSelection(True); end; function EditFocusedTextCanDelete: Boolean; begin Result := EditIsFocused(True); end; function EditFocusedTextCanPaste: Boolean; begin Result := EditIsFocused(True) and ClipBoard.HasFormat(CF_TEXT); end; function EditFocusedTextCanUndo: Boolean; begin {$IFDEF MSWINDOWS} Result := LongBool(SendMessage(GetFocus, EM_CANUNDO, 0, 0)); {$ELSE} // can this be implemented somehow? Result := False; {$ENDIF} end; procedure EditUndoFocused; begin {$IFDEF MSWINDOWS} SendMessage(GetFocus, WM_UNDO, 0, 0); {$ENDIF} end; procedure EditDeleteFocused; begin SendMessage(GetFocus, LM_CLEAR, 0, 0); end; procedure EditCutFocused; begin SendMessage(GetFocus, LM_CUT, 0, 0); end; procedure EditCopyFocused; begin SendMessage(GetFocus, LM_COPY, 0, 0); end; procedure EditPasteFocused; begin SendMessage(GetFocus, LM_PASTE, 0, 0); end; procedure EditSelectAllFocused; begin {$IFDEF MSWINDOWS} SendMessage(GetFocus, EM_SETSEL, 0, -1); {$ENDIF} end; { TKEditKeyMapping } constructor TKEditKeyMapping.Create; begin FMap := nil; CreateMap; end; procedure TKEditKeyMapping.Assign(Source: TKEditKeyMapping); begin FMap := Copy(Source.Map); end; procedure TKEditKeyMapping.CreateMap; begin AddKey(ecLeft, VK_LEFT, []); AddKey(ecRight, VK_RIGHT, []); AddKey(ecInsertNewLine, VK_RETURN, []); AddKey(ecUp, VK_UP, []); AddKey(ecDown, VK_DOWN, []); AddKey(ecLineStart, VK_HOME, []); AddKey(ecLineEnd, VK_END, []); AddKey(ecPageUp, VK_PRIOR, []); AddKey(ecPageDown, VK_NEXT, []); AddKey(ecPageLeft, VK_LEFT, [ssCtrl, ssAlt]); AddKey(ecPageRight, VK_RIGHT, [ssCtrl, ssAlt]); AddKey(ecPageTop, VK_PRIOR, [ssCtrl]); AddKey(ecPageBottom, VK_NEXT, [ssCtrl]); AddKey(ecEditorTop, VK_HOME, [ssCtrl]); AddKey(ecEditorBottom, VK_END, [ssCtrl]); AddKey(ecSelLeft, VK_LEFT, [ssShift]); AddKey(ecSelRight, VK_RIGHT, [ssShift]); AddKey(ecSelUp, VK_UP, [ssShift]); AddKey(ecSelDown, VK_DOWN, [ssShift]); AddKey(ecSelLineStart, VK_HOME, [ssShift]); AddKey(ecSelLineEnd, VK_END, [ssShift]); AddKey(ecSelPageUp, VK_PRIOR, [ssShift]); AddKey(ecSelPageDown, VK_NEXT, [ssShift]); AddKey(ecSelPageLeft, VK_LEFT, [ssShift, ssCtrl, ssAlt]); AddKey(ecSelPageRight, VK_RIGHT, [ssShift, ssCtrl, ssAlt]); AddKey(ecSelPageTop, VK_PRIOR, [ssShift, ssCtrl]); AddKey(ecSelPageBottom, VK_NEXT, [ssShift, ssCtrl]); AddKey(ecSelEditorTop, VK_HOME, [ssShift, ssCtrl]); AddKey(ecSelEditorBottom, VK_END, [ssShift, ssCtrl]); AddKey(ecSelWordLeft, VK_LEFT, [ssShift, ssCtrl]); AddKey(ecSelWordRight, VK_RIGHT, [ssShift, ssCtrl]); AddKey(ecScrollUp, VK_UP, [ssCtrl]); AddKey(ecScrollDown, VK_DOWN, [ssCtrl]); AddKey(ecWordLeft, VK_LEFT, [ssCtrl]); AddKey(ecWordRight, VK_RIGHT, [ssCtrl]); AddKey(ecScrollLeft, VK_LEFT, [ssShift, ssAlt]); AddKey(ecScrollRight, VK_RIGHT, [ssShift, ssAlt]); AddKey(ecScrollCenter, VK_RETURN, [ssCtrl]); AddKey(ecUndo, ord('Z'), [ssCtrl]); AddKey(ecUndo, VK_BACK, [ssAlt]); AddKey(ecRedo, ord('Z'), [ssShift, ssCtrl]); AddKey(ecRedo, VK_BACK, [ssShift, ssAlt]); AddKey(ecCopy, ord('C'), [ssCtrl]); AddKey(ecCopy, VK_INSERT, [ssCtrl]); AddKey(ecCut, ord('X'), [ssCtrl]); AddKey(ecCut, VK_DELETE, [ssShift]); AddKey(ecPaste, ord('V'), [ssCtrl]); AddKey(ecPaste, VK_INSERT, [ssShift]); AddKey(ecDeleteLastChar, VK_BACK, []); AddKey(ecDeleteLastChar, VK_BACK, [ssShift]); AddKey(ecDeleteChar, VK_DELETE, []); AddKey(ecDeleteBOL, ord('X'), [ssCtrl,ssShift]); AddKey(ecDeleteEOL, ord('Y'), [ssCtrl,ssShift]); AddKey(ecDeleteLine, ord('Y'), [ssCtrl]); AddKey(ecSelectAll, ord('A'), [ssCtrl]); AddKey(ecToggleMode, VK_INSERT, []); {$IFDEF DARWIN} // MAC specific, what I knew or guessed and worked for me AddKey(ecLineStart, VK_LEFT, [ssMeta]); AddKey(ecLineEnd, VK_RIGHT, [ssMeta]); AddKey(ecSelLineStart, VK_LEFT, [ssMeta, ssShift]); AddKey(ecSelLineEnd, VK_RIGHT, [ssMeta, ssShift]); AddKey(ecSelPageTop, VK_PRIOR, [ssMeta, ssShift]); AddKey(ecSelPageBottom, VK_NEXT, [ssMeta, ssShift]); AddKey(ecCopy, ord('C'), [ssMeta]); AddKey(ecCut, ord('X'), [ssMeta]); AddKey(ecPaste, ord('V'), [ssMeta]); {$ENDIF} end; class function TKEditKeyMapping.EmptyMap: TKEditCommandAssignment; begin Result.Command := ecNone; Result.Key.Key := 0; Result.Key.Shift := []; end; procedure TKEditKeyMapping.AddKey(Command: TKEditCommand; Key: Word; Shift: TShiftState); var I: Integer; begin I := Length(FMap); SetLength(FMap, I + 1); FMap[I].Command := Command; FMap[I].Key.Key := Key; FMap[I].Key.Shift := Shift; end; function TKEditKeyMapping.FindCommand(AKey: Word; AShift: TShiftState): TKEditCommand; var I: Integer; Key: TKEditKey; begin Result := ecNone; for I := 0 to Length(FMap) - 1 do begin Key := FMap[I].Key; if (Key.Key = AKey) and (Key.Shift = AShift) then begin Result := FMap[I].Command; Exit; end; end; end; function TKEditKeyMapping.GetKey(AIndex: TKEditCommand): TKEditKey; var I: Integer; begin Result.Key := 0; Result.Shift := []; for I := 0 to Length(FMap) - 1 do if FMap[I].Command = AIndex then begin Result := FMap[I].Key; Exit; end; end; function TKEditKeyMapping.GetAssignment(AIndex: Integer): TKEditCommandAssignment; begin if (AIndex >= 0) and (AIndex < Length(FMap)) then Result := FMap[AIndex] else Result := EmptyMap; end; procedure TKEditKeyMapping.SetKey(AIndex: TKEditCommand; const AValue: TKEditKey); var I: Integer; begin for I := 0 to Length(FMap) - 1 do if FMap[I].Command = AIndex then begin FMap[I].Key := AValue; Exit; end; end; end. tomboy-ng_0.39-1/kcontrols/source/kprintpreview.lfm0000644000175000017500000021064314346341266022366 0ustar dbannondbannonobject KPrintPreviewForm: TKPrintPreviewForm Left = 491 Height = 660 Top = 190 Width = 800 Caption = 'Print Preview' ClientHeight = 660 ClientWidth = 800 Font.Height = -11 Font.Name = 'Tahoma' Icon.Data = { 7E04000000000100010010100000010020006804000016000000280000001000 0000200000000100200000000000000400006400000064000000000000000000 000000000025161310C60F0C0AB80C0C0C8F1514149815141498151414981514 1498151414981514149815141498151414980C0C0C8F00000029000000000000 000015120FC295887BFF8F8378FFB9B0A8FFF1F0EEFFF1F0EEFFF1F0EEFFF1F0 EEFFF1F0EEFFF1F0EEFFF1F0EEFFF1F0EEFFEAE8E6FF51504FEA0000000C0000 00000C0A08AE867B70FFD2CCC6FFB7ADA3FFC1BCB6FFE3E3E3FFE0E0E0FFDFDF DFFFFEFEFEFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFA5A3A1FF000000350000 00000000000913110FBBA59C93FFE1DDD9FFB6ACA2FFBAB4AFFFA69E97FFA297 8CFFA1968BFFA9A29BFFD1D0CEFFF1F1F1FFFEFEFEFFA8A7A5FF000000360000 000000000000000000368B8580FFBAB0A6FFD4CEC7FF9A8D7EFFAA9E89FFC8C0 B0FFCCC3B3FFBCAE95FF978B7CFFE2DEDBFFFDFDFDFFA9A8A7FF000000360000 00000000000000000036AAA9A8FFE0DCD8FFA29586FFA9986CFFC6BA91FFD0C7 A9FFD1C9AAFFC5B990FFAA986CFFA4998CFFF7F6F5FFAAA9A8FF000000360000 00000000000000000036ABAAA9FFD6D1CCFFA0906EFFAD9C60FFB9AC78FFBFB4 85FFBBB082FFBAAE79FFAB9A5EFFA99874FFD9D4D0FFABAAA9FF000000360000 00000000000000000036ACABA9FFD1CBC4FFA18D5AFFB7A45CFFB8A866FFB8A8 69FFB9A969FFBBA963FFB6A154FFA7925DFFD4CEC8FFABA9A8FF000000360000 00000000000000000036ACABAAFFDAD5D0FFAB9A6EFFC7B778FFCABB80FFCBBD 85FFC9BA7FFFC4B371FFB4A157FFA89462FFDBD5D1FFA7A5A3FF000000360000 00000000000000000036ADACABFFEBE9E6FFB4A892FFC5B990FFD7CDA8FFD9D0 AAFFD8CFAAFFD8CEA8FFC2B58CFFBAAF9AFFE4E0DCFF9C9894FF000000360000 00000000000000000036ADACABFFF1EFEDFFCFCBC8FFB9AC91FFD3C8A7FFF2EE E1FFF2EEE0FFD2C6A4FFBAAD93FFC9C4BFFFD5CEC7FF817971FF000000360000 00000000000000000036ADADACFFEDEBE9FFB9B7B5FFC3C1BEFFB8B1A8FFA59B 86FFA89D87FFCCC5BBFFDFD9D4FFE5E1DDFFE4E0DCFF514E4BEC0000001B0000 00000000000000000036AEADACFFEAE7E4FF979694FFB6B4B1FFACAAA7FFA8A6 A4FFA2A09EFFDAD5CFFFE8E5E2FFE6E3E0FF656564EC00000031000000000000 00000000000000000035ADACABFFE6E3DFFFE6E3DFFFE6E3DFFFE6E3DFFFE4E1 DDFFDED9D4FFD3CCC4FFEBE9E7FF646464EB0000002E00000000000000000000 0000000000000000000C5B5B5BEAEFEEECFFF0EEECFFF0EEEBFFEEEBE9FFE7E3 DFFFD4CDC6FFBDB3A8FF646464EB0000002F0000000000000000000000000000 00000000000000000000000000290E0E0E8F1717179817171798171717981615 1598131211980C0B0A980000002E000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000 } KeyPreview = True OnCreate = FormCreate OnKeyDown = FormKeyDown OnShow = FormShow Position = poScreenCenter LCLVersion = '1.4.4.0' object ToBMain: TToolBar Left = 0 Top = 0 Width = 800 AutoSize = True ButtonHeight = 30 ButtonWidth = 31 Caption = 'TBMain' DisabledImages = ILMainDis Images = ILMain TabOrder = 0 Wrapable = False object TBPageFirst: TToolButton Left = 1 Top = 2 Action = ACPageFirst Grouped = True ParentShowHint = False ShowHint = True end object TBPagePrevious: TToolButton Left = 32 Top = 2 Action = ACPagePrevious Grouped = True ParentShowHint = False ShowHint = True end object TBPageNext: TToolButton Left = 63 Top = 2 Action = ACPageNext Grouped = True ParentShowHint = False ShowHint = True end object TBPageLast: TToolButton Left = 94 Top = 2 Action = ACPageLast Grouped = True ParentShowHint = False ShowHint = True end object ToolButton3: TToolButton Left = 125 Height = 30 Top = 2 Width = 10 Caption = 'ToolButton3' ImageIndex = 2 Style = tbsSeparator end object ToolButton6: TToolButton Left = 200 Height = 30 Top = 2 Width = 10 Caption = 'ToolButton6' ImageIndex = 3 Style = tbsSeparator end object TBPrint: TToolButton Left = 340 Top = 2 Action = ACPrint ParentShowHint = False ShowHint = True end object ToolButton4: TToolButton Left = 371 Height = 30 Top = 2 Width = 10 Caption = 'ToolButton4' ImageIndex = 5 Style = tbsSeparator end object TBClose: TToolButton Left = 381 Top = 2 Action = ACClose ParentShowHint = False ShowHint = True end object PNPage: TPanel Left = 135 Height = 30 Top = 2 Width = 65 BevelOuter = bvNone ClientHeight = 30 ClientWidth = 65 TabOrder = 0 object EDPage: TEdit Left = 4 Height = 21 Top = 4 Width = 42 OnExit = EDPageExit TabOrder = 0 Text = '1' end object UDPage: TUpDown Left = 46 Height = 21 Top = 4 Width = 15 Associate = EDPage Min = 1 OnClick = UDPageClick Position = 1 TabOrder = 1 Wrap = False end end object PNScale: TPanel Left = 210 Height = 30 Top = 2 Width = 120 BevelOuter = bvNone ClientHeight = 30 ClientWidth = 120 TabOrder = 1 object CoBScale: TComboBox Left = 2 Height = 21 Top = 4 Width = 115 DropDownCount = 16 ItemHeight = 13 Items.Strings = ( '25 %' '50 %' '75 %' '100 %' '125 %' '150 %' '200 %' '500 %' 'Whole Page' 'Page Width' ) OnExit = CoBScaleExit OnSelect = CoBScaleExit TabOrder = 0 end end object ToolButton1: TToolButton Left = 330 Height = 30 Top = 2 Width = 10 Caption = 'ToolButton1' Style = tbsSeparator end end object ILMain: TImageList Height = 24 Width = 24 left = 16 top = 54 Bitmap = { 4C69060000001800000018000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FF6BAE94FF6BAE94FF6BAE94FFADB7B800ADB7B800ADB7B800ADB7B800ADB7 B800ADB7B800ADB7B800ADB7B800ADB7B8006BAE94FF6BAE94FFADB7B800FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FFFCFEFEFFFCFEFEFF6BAE94FFADB7B800ADB7B800ADB7B800ADB7B800ADB7 B800ADB7B800ADB7B8006BAE94FF6BAE94FFA7CFC0FFA7CFC0FF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FFF7FCFBFFF7FCFBFF6BAE94FFADB7B800ADB7B800ADB7B800ADB7B800ADB7 B8006BAE94FF6BAE94FFA4CEBEFFF5FBFAFFF5FBFAFFF7FCFBFF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FFF1F9F7FFF1F9F7FF6BAE94FFADB7B800ADB7B800ADB7B8006BAE94FF6BAE 94FFA2CDBDFFEEF8F6FFECF7F5FFEAF7F4FFECF7F5FFEFF9F7FF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FFEAF7F4FFEAF7F4FF6BAE94FFADB7B8006BAE94FF6BAE94FF9FCCBCFFE6F5 F2FFE3F4F0FFE1F3EFFFE0F3EEFFDFF2EDFFE1F3EFFFE7F6F2FF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FFE3F5F0FFE3F5F0FF6BAE94FF6BAE94FF9CCBBAFFDEF3EDFFDAF2EBFFD7F1 E9FFD5F0E8FFD4EFE7FFD3EFE7FFD3EFE7FFD7F1E9FFDFF3EEFF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FFDCF2EDFFDCF2EDFF6BAE94FFD8F1EAFFD1EEE7FFCDEDE5FFCBECE3FFC9EB E2FFC8EBE2FFC8EBE2FFC8EBE2FFC8EBE2FFCDEDE5FFD7F1EAFF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FFD6F1EAFFD6F1EAFF6BAE94FFC6EBE2FFC0E9DFFFBEE8DEFFBDE8DDFFBDE8 DDFFBDE8DDFFBDE8DDFFBDE8DDFFBDE8DDFFC3EAE0FFCFEEE6FF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FFA0ECD9FFA0ECD9FF6BAE94FF7CE5CBFF6FE3C5FF69E1C3FF68E1C2FF67E1 C2FF67E1C2FF67E1C2FF67E1C2FF67E1C2FF75E4C8FF91E9D3FF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FFA0ECD9FFA0ECD9FF6BAE94FF93EAD3FF80E6CCFF75E4C8FF6EE2C5FF69E1 C3FF68E1C2FF67E1C2FF67E1C2FF67E1C2FF75E4C8FF91E9D3FF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FFA0ECD9FFA0ECD9FF6BAE94FF6BAE94FF81C8B0FF8EE9D2FF80E6CCFF75E4 C8FF6EE2C5FF69E1C3FF68E1C2FF67E1C2FF75E4C8FF91E9D3FF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FFA0ECD9FFA0ECD9FF6BAE94FFADB7B8806BAE94FF6BAE94FF81C8B0FF8EE9 D2FF80E6CCFF75E4C8FF6EE2C5FF69E1C3FF76E4C8FF91E9D3FF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FFA0ECD9FFA0ECD9FF6BAE94FFADB7B800ADB7B880ADB7B8806BAE94FF6BAE 94FF81C8B0FF8EE9D2FF80E6CCFF76E4C8FF7EE6CBFF97EAD5FF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FFAAEEDDFFAAEEDDFF6BAE94FFADB7B800ADB7B800ADB7B800ADB7B880ADB7 B8806BAE94FF6BAE94FF81C8B0FF91E9D3FF93EAD4FFA8EEDCFF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FFBFF2E5FFBFF2E5FF6BAE94FFADB7B800ADB7B800ADB7B800ADB7B800ADB7 B800ADB7B880ADB7B8806BAE94FF6BAE94FF8ACAB4FF90CAB6FF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FF6BAE94FF6BAE94FF6BAE94FFADB7B800ADB7B800ADB7B800ADB7B800ADB7 B800ADB7B800ADB7B800ADB7B880ADB7B8806BAE94FF6BAE94FFADB7B880FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 B880ADB7B880ADB7B880ADB7B880ADB7B800ADB7B800ADB7B800ADB7B800ADB7 B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B880ADB7B880ADB7B800FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7 B800ADB7B800ADB7B800ADB7B8006BAE94FF6BAE94FF6BAE94FFADB7B800FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7 B800ADB7B8006BAE94FF6BAE94FFA7CFBFFFFCFEFDFFA7CFC0FF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B8006BAE 94FF6BAE94FFA4CEBEFFF5FBFAFFF4FBF9FFF4FBFAFFF7FCFBFF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B8006BAE94FF6BAE94FFA2CD BDFFEEF8F6FFECF7F5FFEAF7F4FFE9F6F4FFEBF7F4FFEFF9F7FF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 B800ADB7B800ADB7B800ADB7B8006BAE94FF6BAE94FF9FCCBCFFE6F5F2FFE3F4 F0FFE1F3EFFFE0F3EEFFDFF2EDFFDEF2EDFFE1F3EFFFE7F6F2FF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 B800ADB7B8006BAE94FF6BAE94FF9CCBBAFFDEF3EDFFDAF2EBFFD7F1E9FFD5F0 E8FFD4EFE7FFD3EFE7FFD3EFE7FFD3EFE7FFD7F1E9FFDFF3EEFF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 B8006BAE94FF9CCBBAFFD8F1EAFFD1EEE7FFCDEDE5FFCBECE3FFC9EBE2FFC8EB E2FFC8EBE2FFC8EBE2FFC8EBE2FFC8EBE2FFCDEDE5FFD7F1EAFF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FF9CCBBAFFD1EFE8FFC6EBE2FFC0E9DFFFBEE8DEFFBDE8DDFFBDE8DDFFBDE8 DDFFBDE8DDFFBDE8DDFFBDE8DDFFBDE8DDFFC3EAE0FFCFEEE6FF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FF8CCAB5FF96EAD5FF7CE5CBFF6FE3C5FF69E1C3FF68E1C2FF67E1C2FF67E1 C2FF67E1C2FF67E1C2FF67E1C2FF67E1C2FF75E4C8FF91E9D3FF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 B8806BAE94FF87C9B2FF93EAD3FF80E6CCFF75E4C8FF6EE2C5FF69E1C3FF68E1 C2FF67E1C2FF67E1C2FF67E1C2FF67E1C2FF75E4C8FF91E9D3FF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 B800ADB7B8806BAE94FF6BAE94FF81C8B0FF8EE9D2FF80E6CCFF75E4C8FF6EE2 C5FF69E1C3FF68E1C2FF67E1C2FF67E1C2FF75E4C8FF91E9D3FF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 B800ADB7B800ADB7B880ADB7B8806BAE94FF6BAE94FF81C8B0FF8EE9D2FF80E6 CCFF75E4C8FF6EE2C5FF69E1C3FF68E1C2FF75E4C8FF91E9D3FF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 B800ADB7B800ADB7B800ADB7B800ADB7B880ADB7B8806BAE94FF6BAE94FF81C8 B0FF8EE9D2FF80E6CCFF75E4C8FF6FE3C5FF79E5C9FF95EAD4FF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B880ADB7B8806BAE 94FF6BAE94FF81C8B0FF8FE9D2FF84E7CEFF8BE8D1FFA4EDDBFF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7 B880ADB7B8806BAE94FF6BAE94FF84C8B2FFAAEEDDFF8ECAB5FF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7 B800ADB7B800ADB7B880ADB7B8806BAE94FF6BAE94FF6BAE94FFADB7B880FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7 B800ADB7B800ADB7B800ADB7B800ADB7B880ADB7B880ADB7B880ADB7B800FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 B8006BAE94FF6BAE94FF6BAE94FFADB7B800ADB7B800ADB7B800ADB7B800ADB7 B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FFA7CFC0FFFCFEFDFFA7CFBFFF6BAE94FF6BAE94FFADB7B800ADB7B800ADB7 B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FFF7FCFBFFF4FBFAFFF4FBF9FFF5FBFAFFA4CEBEFF6BAE94FF6BAE94FFADB7 B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FFEFF9F7FFEBF7F4FFE9F6F4FFEAF7F4FFECF7F5FFEEF8F6FFA2CDBDFF6BAE 94FF6BAE94FFADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FFE7F6F2FFE1F3EFFFDEF2EDFFDFF2EDFFE0F3EEFFE1F3EFFFE3F4F0FFE6F5 F2FF9FCCBCFF6BAE94FF6BAE94FFADB7B800ADB7B800ADB7B800ADB7B800FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FFDFF3EEFFD7F1E9FFD3EFE7FFD3EFE7FFD3EFE7FFD4EFE7FFD5F0E8FFD7F1 E9FFDAF2EBFFDEF3EDFF9CCBBAFF6BAE94FF6BAE94FFADB7B800ADB7B800FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FFD7F1EAFFCDEDE5FFC8EBE2FFC8EBE2FFC8EBE2FFC8EBE2FFC8EBE2FFC9EB E2FFCBECE3FFCDEDE5FFD1EEE7FFD8F1EAFF9CCBBAFF6BAE94FFADB7B800FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FFCFEEE6FFC3EAE0FFBDE8DDFFBDE8DDFFBDE8DDFFBDE8DDFFBDE8DDFFBDE8 DDFFBDE8DDFFBEE8DEFFC0E9DFFFC6EBE2FFD1EFE8FF9CCBBAFF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FF91E9D3FF75E4C8FF67E1C2FF67E1C2FF67E1C2FF67E1C2FF67E1C2FF67E1 C2FF68E1C2FF69E1C3FF6FE3C5FF7CE5CBFF96EAD5FF8CCAB5FF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FF91E9D3FF75E4C8FF67E1C2FF67E1C2FF67E1C2FF67E1C2FF68E1C2FF69E1 C3FF6EE2C5FF75E4C8FF80E6CCFF93EAD3FF87C9B2FF6BAE94FFADB7B880FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FF91E9D3FF75E4C8FF67E1C2FF67E1C2FF68E1C2FF69E1C3FF6EE2C5FF75E4 C8FF80E6CCFF8EE9D2FF81C8B0FF6BAE94FF6BAE94FFADB7B880ADB7B800FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FF91E9D3FF75E4C8FF68E1C2FF69E1C3FF6EE2C5FF75E4C8FF80E6CCFF8EE9 D2FF81C8B0FF6BAE94FF6BAE94FFADB7B880ADB7B880ADB7B800ADB7B800FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FF95EAD4FF79E5C9FF6FE3C5FF75E4C8FF80E6CCFF8EE9D2FF81C8B0FF6BAE 94FF6BAE94FFADB7B880ADB7B880ADB7B800ADB7B800ADB7B800ADB7B800FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FFA4EDDBFF8BE8D1FF84E7CEFF8FE9D2FF81C8B0FF6BAE94FF6BAE94FFADB7 B880ADB7B880ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FF8ECAB5FFAAEEDDFF84C8B2FF6BAE94FF6BAE94FFADB7B880ADB7B880ADB7 B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 B8806BAE94FF6BAE94FF6BAE94FFADB7B880ADB7B880ADB7B800ADB7B800ADB7 B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 B800ADB7B880ADB7B880ADB7B880ADB7B800ADB7B800ADB7B800ADB7B800ADB7 B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 B8006BAE94FF6BAE94FFADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7 B800ADB7B800ADB7B800ADB7B8006BAE94FF6BAE94FF6BAE94FF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FFA7CFC0FFA7CFC0FF6BAE94FF6BAE94FFADB7B800ADB7B800ADB7B800ADB7 B800ADB7B800ADB7B800ADB7B8006BAE94FFFCFEFEFFFCFEFEFF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FFF7FCFBFFF5FBFAFFF5FBFAFFA4CEBEFF6BAE94FF6BAE94FFADB7B800ADB7 B800ADB7B800ADB7B800ADB7B8006BAE94FFF7FCFBFFF7FCFBFF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FFEFF9F7FFECF7F5FFEAF7F4FFECF7F5FFEEF8F6FFA2CDBDFF6BAE94FF6BAE 94FFADB7B800ADB7B800ADB7B8006BAE94FFF1F9F7FFF1F9F7FF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FFE7F6F2FFE1F3EFFFDFF2EDFFE0F3EEFFE1F3EFFFE3F4F0FFE6F5F2FF9FCC BCFF6BAE94FF6BAE94FFADB7B8006BAE94FFEAF7F4FFEAF7F4FF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FFDFF3EEFFD7F1E9FFD3EFE7FFD3EFE7FFD4EFE7FFD5F0E8FFD7F1E9FFDAF2 EBFFDEF3EDFF9CCBBAFF6BAE94FF6BAE94FFE3F5F0FFE3F5F0FF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FFD7F1EAFFCDEDE5FFC8EBE2FFC8EBE2FFC8EBE2FFC8EBE2FFC9EBE2FFCBEC E3FFCDEDE5FFD1EEE7FFD8F1EAFF6BAE94FFDCF2EDFFDCF2EDFF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FFCFEEE6FFC3EAE0FFBDE8DDFFBDE8DDFFBDE8DDFFBDE8DDFFBDE8DDFFBDE8 DDFFBEE8DEFFC0E9DFFFC6EBE2FF6BAE94FFD6F1EAFFD6F1EAFF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FF91E9D3FF75E4C8FF67E1C2FF67E1C2FF67E1C2FF67E1C2FF67E1C2FF68E1 C2FF69E1C3FF6FE3C5FF7CE5CBFF6BAE94FFA0ECD9FFA0ECD9FF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FF91E9D3FF75E4C8FF67E1C2FF67E1C2FF67E1C2FF68E1C2FF69E1C3FF6EE2 C5FF75E4C8FF80E6CCFF93EAD3FF6BAE94FFA0ECD9FFA0ECD9FF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FF91E9D3FF75E4C8FF67E1C2FF68E1C2FF69E1C3FF6EE2C5FF75E4C8FF80E6 CCFF8EE9D2FF81C8B0FF6BAE94FF6BAE94FFA0ECD9FFA0ECD9FF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FF91E9D3FF76E4C8FF69E1C3FF6EE2C5FF75E4C8FF80E6CCFF8EE9D2FF81C8 B0FF6BAE94FF6BAE94FFADB7B8806BAE94FFA0ECD9FFA0ECD9FF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FF97EAD5FF7EE6CBFF76E4C8FF80E6CCFF8EE9D2FF81C8B0FF6BAE94FF6BAE 94FFADB7B880ADB7B880ADB7B8006BAE94FFA0ECD9FFA0ECD9FF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FFA8EEDCFF93EAD4FF91E9D3FF81C8B0FF6BAE94FF6BAE94FFADB7B880ADB7 B880ADB7B800ADB7B800ADB7B8006BAE94FFAAEEDDFFAAEEDDFF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE 94FF90CAB6FF8ACAB4FF6BAE94FF6BAE94FFADB7B880ADB7B880ADB7B800ADB7 B800ADB7B800ADB7B800ADB7B8006BAE94FFBFF2E5FFBFF2E5FF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 B8806BAE94FF6BAE94FFADB7B880ADB7B880ADB7B800ADB7B800ADB7B800ADB7 B800ADB7B800ADB7B800ADB7B8006BAE94FF6BAE94FF6BAE94FF6BAE94FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 B800ADB7B880ADB7B880ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7 B800ADB7B800ADB7B800ADB7B800ADB7B880ADB7B880ADB7B880ADB7B880FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00EFC7A500EFC7A500EFC7A500EFC7A500EFC7 A500EFC7A510EFC8A6EBF1CCABFBF1CBABFBF1CBAAFBF1CCAAFBF1CBABFBF1CB ABFBF1CBABFBF1CBAAFBF1CBAAFBF1CCABFBEFC8A7EBEFC7A610EFC7A600EFC7 A600EFC7A600EFC7A600EFC7A600F4C9A400F4CAA400F0C8A500EEC7A500EEC7 A500EDC5A310F2CFAEEFFDE5C8FFFBE3C7FFFCE3C6FFFBE3C6FFFBE3C7FFFBE3 C7FFFBE3C7FFFCE3C6FFFCE3C6FFFCE4C8FFF3CFB0EFEFC7A510F0C9A800EFC9 A800F1CAA700F6CBA700F5CBA700C6B9AE00C4B8AF00E8C5A700F5CAA500F0C9 A600EFC7A410F2CEAEEFFBE1C3FFFADFC1FFFADFC1FFFBDFC1FFFBDFC1FFFADF C2FFFBDFC1FFFADFC1FFFADFC1FFFBE0C2FFF4D1B0EFF0CBA910F1CCAA00F7CE A900E9C9AC00C7BCB300C9BDB200AFB1B300AFB1B300BCBCBB00C8BBB000F3CB A600F1CAA610F3D0ADEFFADFBFFFFADEBEFFFADDBDFFFADDBDFFFADEBEFFFADE BEFFFADDBDFFFADEBDFFFADEBEFFFADEBFFFF5D2B1EFF4CEAC10F5CFAC00C8BC B200BEBDBD00B3B5B700B3B5B700B2B2B200B2B2B200BCBCBC00AFB2B500C8BB AE00F2CBA810F5D1ADEFFADDBBFFFADCBAFFFADCBAFFFADDBAFFF9DCBAFFFADD BAFFFADCBBFFF9DBBAFFFADCBAFFFADDBAFFF8D4B1EFF8D2AE10C9BCB100AFB1 B400BEBEBE00B6B6B600B6B6B600B2B2B200B2B2B200BCBCBC00B4B4B400AAAF B200EBC8AE0FFBD4AEEFF9DAB7FFFADAB6FFF9D9B6FFFADAB7FFF9DBB7FFF9DB B7FFF9DAB7FFF9DAB7FFFADAB7FFFBDAB6FFF6D5B1EFC8BDAE0DACAFB200B4B4 B400BEBEBE00B6B6B600B6B6B600B2B2B200B2B2B200BBBCBB00B4B3B41BB5B0 B3108CBAA010EAD2ABEDFCD9B4FFF8D9B4FFF9D9B4FFF8D9B3FFF9D9B4FFF9D9 B4FFF8D9B3FFF9D9B3FFF9D9B4FFFBDAB4FFF1D3B0F0ADB1AE23B4B1B310B4B3 B30DBDBEBD00B6B6B600B6B6B600B3B3B300B2B2B207CCC2C59D9CCDBDF333C0 95F155BA96EFEBC7A0FEFFCDA5FFFACCA4FFFACCA4FFFACCA4FFFACCA4FFFACC A4FFFACCA4FFFACCA4FFFACCA4FFFECDA5FFEFC9A1FE5BB996F22FBA8FF1A3CB BEEBCEC5C8A5B6B6B610B7B7B700BEBEBE00BBBBBB5AF6EDF0FEBBECDCFF31D2 A1FF47D5A6FFA9B58AFFB8B58CFFB5B68CFFB5B68CFFB5B68CFFB5B68CFFB5B6 8CFFB5B68CFFB5B68DFFB5B68CFFB8B58CFFA8B78CFF32CA99FF1AC28DFFC9EF E1FFFBF1F4FFC0C0C065C3C3C300C1C1C100BFBEBE67FBF4F6FFADE7D4FF3BCF A1FF6AEFC8FF50D7ADFF50D5ACFF50D6ACFF50D6ACFF50D5ACFF50D5ACFF50D5 ACFF50D6ACFF50D6ADFF50D6ACFF51D5ACFF4DD7ADFF61ECC3FF3CCB9CFFC4EA DCFFFFF6FAFFC5C5C571C8C8C800C1C1C100BEBEBE6DFBF4F6FFB1E6D4FF3ACB 9DFF74F4CFFF6EF1CCFF6EF2CCFF6EF1CCFF6EF1CCFF6EF2CCFF6EF2CCFF6EF2 CCFF6EF1CCFF6EF1CCFF6EF1CCFF6EF2CCFF6FF1CCFF76F4D0FF3CC899FFC5E7 DAFFFFF6FAFFC4C4C476C7C7C700BCBCBC00B9B9B970F9F2F5FFBCE7D7FF33C2 91FF38CB9CFF24C692FF26C895FF26C895FF26C895FF26C895FF26C895FF26C8 95FF26C895FF26C895FF26C895FF26C895FF23C592FF39CD9FFF38BF90FFC7E7 D9FFFCF4F7FFBDBDBD76C0C0C000B6B6B600B3B3B371EFE8EBFFC0E5D7FF2BB4 83FF2AB281FF1BAB76FF1DAD79FF1DAD79FF1DAD79FF1DAD79FF1DAD79FF1DAD 79FF1DAD79FF1DAD79FF1DAD79FF1DAD79FF1BAB76FF2AB281FF2CAF7FFFC9E6 DAFFEEE7EBFFB5B5B575B8B8B800B3B3B300B0B0B074E5DEE1FFC0E2D3FF2BB2 7FFF47C89CFF40C092FF41C092FF41C092FF41C092FF41C092FF41C093FF41C0 93FF41C093FF41C093FF41C093FF41C093FF40BF92FF47C99CFF2CAE7DFFC5E2 D4FFE2DBDEFFB0B0B076B3B3B300ADADAD00AAAAAA7FD6D2D4FFE7EEEBFF6DBF 9DFF30A475FF3AA97BFF3AA97AFF3AA87AFF3AA87AFF3AA77AFF3AA879FF3AA8 79FF3AA779FF3BA77AFF3BA77AFF3BA77AFF3BA77AFF30A272FF7DC4A6FFEDEF EEFFD1CECFFFAAAAAA7FADADAD00B7B7B700AAAAAA80CDCDCDFFE1E0E0FFEBEA EBFFE3E8E6FFEAF0EEFFE4ECEBFFE4ECEBFFE4ECEBFFE4ECEAFFE4ECEAFFE4EC EAFFE4ECEAFFE4EBEAFFE4EBEAFFE3EBE9FFE4ECEAFFEFF0EFFFCEE0D9FFC8D4 CFFFCBC9CAFFAAAAAA80B7B7B70070707000B8B8B880CBCBCBFFD8D8D8FFD6D6 D6FFCDCDCEFF969190FFB7A9A3FFB6A8A2FFB6A8A2FFB6A8A2FFB5A8A1FFB5A8 A2FFB5A8A2FFB5A7A1FFB5A7A2FFB5A8A2FFAC9F9AFF9E989AFF9CC1B1FFAEC6 BCFFCBC7C9FFB8B8B88070707000000000006E6E6E82D4D4D4FFD4D4D4FFD5D5 D5FFBEC0C2FF554B43FFBA9472FFB69373FFB69375FFB69577FFB6977BFFB698 7CFFB6987EFFB79A80FFB79A85FFBA9F89FFA38B77FF585756FFD8D4D7FFD2D0 D1FFD0D0D0FF6E6E6E8200000000000000073F3F3F46B4B4B4E0D3D3D3FFD7D7 D7FFBBBEC0FF6D6257FFEFBF91FFEABC91FFEABD94FFEABE96FFEAC19AFFEAC3 9FFFEAC5A2FFEAC6A5FFEAC8AAFFEDCEB0FFD5B99FFF6A6866FFD5D6D7FFD2D2 D2FFB8B8B8E9444444520000000500000019000000253E3E3E51777777B37575 75B684878AB99A8E82D1FFD4A4FFFFD0A3FFFFD1A4FFFFD1A7FFFFD4A9FFFFD5 AEFFFFD8B1FFFFD9B3FFFFDAB6FFFFDFBCFFF7D6B8FB787674C2747575B47979 79B4434343570000002400000019000000040000000500000000000000000000 000010121200675D5243FFF0C4FFFFE6BCFFFFE6BCFFFFE6BDFFFFE7BEFFFFE8 BFFFFFEAC3FFFFEAC3FFFFEBC5FFFFEFCAFFFFE3C1FE2725230C000000000000 0000000000000000000500000004000000000000000000000000000000000000 00000000000F0503022C2B2620542B241E5A2B241E592B241E592B241E592B25 1E592B251F592B251F592B251F592B26205A27221D4F00000022000000090000 0000000000000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 B800ADB7B8004646C1FF4646C1FFADB7B800ADB7B800ADB7B800ADB7B800ADB7 B800ADB7B800ADB7B800ADB7B8004646C1FF4646C1FFADB7B800ADB7B800FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 B8004646C1FF9191DBFF9191DBFF4646C1FFADB7B800ADB7B800ADB7B800ADB7 B800ADB7B800ADB7B8004646C1FF9191DBFF9191DBFF4646C1FFADB7B800FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF004646 C1FF8F8FDBFFF3F3FFFFF2F2FFFF8E8EDBFF4646C1FFADB7B800ADB7B800ADB7 B800ADB7B8004646C1FF8E8EDBFFF2F2FFFFF3F3FFFF8F8FDBFF4646C1FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF004646 C1FF8C8CDBFFE9E9FFFFE6E6FFFFE7E7FFFF8A8ADBFF4646C1FFADB7B800ADB7 B8004646C1FF8A8ADBFFE7E7FFFFE6E6FFFFE9E9FFFF8C8CDBFF4646C1FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 B8804646C1FF8787DBFFDCDCFFFFD9D9FFFFDBDBFFFF8585DBFF4646C1FF4646 C1FF8585DBFFDBDBFFFFD9D9FFFFDCDCFFFF8787DBFF4646C1FFADB7B880FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 B800ADB7B8804646C1FF8383DBFFCFCFFFFFCBCBFFFFCBCBFFFFCCCCFFFFCCCC FFFFCBCBFFFFCBCBFFFFCFCFFFFF8383DBFF4646C1FFADB7B880ADB7B800FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 B800ADB7B800ADB7B8804646C1FF7C7CDBFFBFBFFFFFB9B9FFFFB8B8FFFFB8B8 FFFFB9B9FFFFBFBFFFFF7C7CDBFF4646C1FFADB7B880ADB7B800ADB7B800FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 B800ADB7B800ADB7B800ADB7B8804646C1FFB5B5FFFFABABFFFFA8A8FFFFA8A8 FFFFABABFFFFB5B5FFFF4646C1FFADB7B880ADB7B800ADB7B800ADB7B800FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 B800ADB7B800ADB7B800ADB7B8004646C1FF7272FFFF5F5FFFFF5858FFFF5858 FFFF5F5FFFFF7272FFFF4646C1FFADB7B800ADB7B800ADB7B800ADB7B800FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 B800ADB7B800ADB7B8004646C1FF6161DBFF6E6EFFFF6262FFFF5F5FFFFF5F5F FFFF6262FFFF6E6EFFFF6161DBFF4646C1FFADB7B800ADB7B800ADB7B800FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 B800ADB7B8004646C1FF6767DBFF7B7BFFFF7070FFFF6E6EFFFF7272FFFF7272 FFFF6E6EFFFF7070FFFF7B7BFFFF6767DBFF4646C1FFADB7B800ADB7B800FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 B8004646C1FF6A6ADBFF8080FFFF7575FFFF7B7BFFFF6161DBFF4646C1FF4646 C1FF6161DBFF7B7BFFFF7575FFFF8080FFFF6A6ADBFF4646C1FFADB7B800FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF004646 C1FF7474DBFF8E8EFFFF7A7AFFFF8080FFFF6767DBFF4646C1FFADB7B880ADB7 B8804646C1FF6767DBFF8080FFFF7A7AFFFF8E8EFFFF7474DBFF4646C1FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF004646 C1FF7575DBFF9898FFFF8E8EFFFF6A6ADBFF4646C1FFADB7B880ADB7B800ADB7 B800ADB7B8804646C1FF6A6ADBFF8E8EFFFF9898FFFF7575DBFF4646C1FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 B8804646C1FF7575DBFF7474DBFF4646C1FFADB7B880ADB7B800ADB7B800ADB7 B800ADB7B800ADB7B8804646C1FF7474DBFF7575DBFF4646C1FFADB7B880FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 B800ADB7B8804646C1FF4646C1FFADB7B880ADB7B800ADB7B800ADB7B800ADB7 B800ADB7B800ADB7B800ADB7B8804646C1FF4646C1FFADB7B880ADB7B800FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 B800ADB7B800ADB7B880ADB7B880ADB7B800ADB7B800ADB7B800ADB7B800ADB7 B800ADB7B800ADB7B800ADB7B800ADB7B880ADB7B880ADB7B800ADB7B800FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00 } end object ALMain: TActionList Images = ILMain left = 56 top = 54 object ACPageFirst: TAction Hint = 'First page' ImageIndex = 0 OnExecute = ACPageFirstExecute OnUpdate = ACPageFirstUpdate end object ACPagePrevious: TAction Caption = 'Previous page' Hint = 'Previous page' ImageIndex = 1 OnExecute = ACPagePreviousExecute OnUpdate = ACPageFirstUpdate end object ACPageNext: TAction Caption = 'Next page' Hint = 'Next page' ImageIndex = 2 OnExecute = ACPageNextExecute OnUpdate = ACPageNextUpdate end object ACPageLast: TAction Caption = 'Last page' Hint = 'Last page' ImageIndex = 3 OnExecute = ACPageLastExecute OnUpdate = ACPageNextUpdate end object ACPrint: TAction Caption = 'Print' Hint = 'Print' ImageIndex = 4 OnExecute = ACPrintExecute OnUpdate = ACPrintUpdate end object ACClose: TAction Caption = 'Close' Hint = 'Close preview' ImageIndex = 5 OnExecute = ACCloseExecute OnUpdate = ACCloseUpdate end end object ILMainDis: TImageList Height = 24 Width = 24 left = 96 top = 54 Bitmap = { 4C69060000001800000018000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFF8C8C8CFF8C8C8CFF8C8C8CFFB2B2B200B2B2B200B2B2B200B2B2B200B2B2 B200B2B2B200B2B2B200B2B2B200B2B2B2008C8C8CFF8C8C8CFFB2B2B200FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFFDFDFDFFFDFDFDFF8C8C8CFFB2B2B200B2B2B200B2B2B200B2B2B200B2B2 B200B2B2B200B2B2B2008C8C8CFF8C8C8CFFBBBBBBFFBBBBBBFF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFF9F9F9FFF9F9F9FF8C8C8CFFB2B2B200B2B2B200B2B2B200B2B2B200B2B2 B2008C8C8CFF8C8C8CFFB9B9B9FFF8F8F8FFF8F8F8FFF9F9F9FF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFF5F5F5FFF5F5F5FF8C8C8CFFB2B2B200B2B2B200B2B2B2008C8C8CFF8C8C 8CFFB7B7B7FFF3F3F3FFF1F1F1FFF0F0F0FFF1F1F1FFF4F4F4FF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFF0F0F0FFF0F0F0FF8C8C8CFFB2B2B2008C8C8CFF8C8C8CFFB5B5B5FFEDED EDFFEBEBEBFFEAEAEAFFE9E9E9FFE8E8E8FFEAEAEAFFEEEEEEFF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFECECECFFECECECFF8C8C8CFF8C8C8CFFB3B3B3FFE8E8E8FFE6E6E6FFE4E4 E4FFE2E2E2FFE1E1E1FFE1E1E1FFE1E1E1FFE4E4E4FFE9E9E9FF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFE7E7E7FFE7E7E7FF8C8C8CFFE4E4E4FFDFDFDFFFDDDDDDFFDBDBDBFFDADA DAFFD9D9D9FFD9D9D9FFD9D9D9FFD9D9D9FFDDDDDDFFE4E4E4FF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFE3E3E3FFE3E3E3FF8C8C8CFFD8D8D8FFD4D4D4FFD3D3D3FFD2D2D2FFD2D2 D2FFD2D2D2FFD2D2D2FFD2D2D2FFD2D2D2FFD6D6D6FFDEDEDEFF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFC6C6C6FFC6C6C6FF8C8C8CFFB0B0B0FFA9A9A9FFA5A5A5FFA4A4A4FFA4A4 A4FFA4A4A4FFA4A4A4FFA4A4A4FFA4A4A4FFACACACFFBDBDBDFF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFC6C6C6FFC6C6C6FF8C8C8CFFBEBEBEFFB3B3B3FFACACACFFA8A8A8FFA5A5 A5FFA4A4A4FFA4A4A4FFA4A4A4FFA4A4A4FFACACACFFBDBDBDFF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFC6C6C6FFC6C6C6FF8C8C8CFF8C8C8CFFA4A4A4FFBBBBBBFFB3B3B3FFACAC ACFFA8A8A8FFA5A5A5FFA4A4A4FFA4A4A4FFACACACFFBDBDBDFF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFC6C6C6FFC6C6C6FF8C8C8CFFB2B2B2808C8C8CFF8C8C8CFFA4A4A4FFBBBB BBFFB3B3B3FFACACACFFA8A8A8FFA5A5A5FFADADADFFBDBDBDFF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFC6C6C6FFC6C6C6FF8C8C8CFFB2B2B200B2B2B280B2B2B2808C8C8CFF8C8C 8CFFA4A4A4FFBBBBBBFFB3B3B3FFADADADFFB2B2B2FFC0C0C0FF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFCCCCCCFFCCCCCCFF8C8C8CFFB2B2B200B2B2B200B2B2B200B2B2B280B2B2 B2808C8C8CFF8C8C8CFFA4A4A4FFBDBDBDFFBEBEBEFFCBCBCBFF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFD8D8D8FFD8D8D8FF8C8C8CFFB2B2B200B2B2B200B2B2B200B2B2B200B2B2 B200B2B2B280B2B2B2808C8C8CFF8C8C8CFFAAAAAAFFADADADFF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFF8C8C8CFF8C8C8CFF8C8C8CFFB2B2B200B2B2B200B2B2B200B2B2B200B2B2 B200B2B2B200B2B2B200B2B2B280B2B2B2808C8C8CFF8C8C8CFFB2B2B280FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 B280B2B2B280B2B2B280B2B2B280B2B2B200B2B2B200B2B2B200B2B2B200B2B2 B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B280B2B2B280B2B2B200FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2 B200B2B2B200B2B2B200B2B2B2008C8C8CFF8C8C8CFF8C8C8CFFB2B2B200FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2 B200B2B2B2008C8C8CFF8C8C8CFFBBBBBBFFFDFDFDFFBBBBBBFF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B2008C8C 8CFF8C8C8CFFB9B9B9FFF8F8F8FFF7F7F7FFF7F7F7FFF9F9F9FF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B2008C8C8CFF8C8C8CFFB7B7 B7FFF3F3F3FFF1F1F1FFF0F0F0FFEFEFEFFFF1F1F1FFF4F4F4FF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 B200B2B2B200B2B2B200B2B2B2008C8C8CFF8C8C8CFFB5B5B5FFEDEDEDFFEBEB EBFFEAEAEAFFE9E9E9FFE8E8E8FFE8E8E8FFEAEAEAFFEEEEEEFF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 B200B2B2B2008C8C8CFF8C8C8CFFB3B3B3FFE8E8E8FFE6E6E6FFE4E4E4FFE2E2 E2FFE1E1E1FFE1E1E1FFE1E1E1FFE1E1E1FFE4E4E4FFE9E9E9FF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 B2008C8C8CFFB3B3B3FFE4E4E4FFDFDFDFFFDDDDDDFFDBDBDBFFDADADAFFD9D9 D9FFD9D9D9FFD9D9D9FFD9D9D9FFD9D9D9FFDDDDDDFFE4E4E4FF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFB3B3B3FFE0E0E0FFD8D8D8FFD4D4D4FFD3D3D3FFD2D2D2FFD2D2D2FFD2D2 D2FFD2D2D2FFD2D2D2FFD2D2D2FFD2D2D2FFD6D6D6FFDEDEDEFF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFABABABFFC0C0C0FFB0B0B0FFA9A9A9FFA5A5A5FFA4A4A4FFA4A4A4FFA4A4 A4FFA4A4A4FFA4A4A4FFA4A4A4FFA4A4A4FFACACACFFBDBDBDFF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 B2808C8C8CFFA8A8A8FFBEBEBEFFB3B3B3FFACACACFFA8A8A8FFA5A5A5FFA4A4 A4FFA4A4A4FFA4A4A4FFA4A4A4FFA4A4A4FFACACACFFBDBDBDFF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 B200B2B2B2808C8C8CFF8C8C8CFFA4A4A4FFBBBBBBFFB3B3B3FFACACACFFA8A8 A8FFA5A5A5FFA4A4A4FFA4A4A4FFA4A4A4FFACACACFFBDBDBDFF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 B200B2B2B200B2B2B280B2B2B2808C8C8CFF8C8C8CFFA4A4A4FFBBBBBBFFB3B3 B3FFACACACFFA8A8A8FFA5A5A5FFA4A4A4FFACACACFFBDBDBDFF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 B200B2B2B200B2B2B200B2B2B200B2B2B280B2B2B2808C8C8CFF8C8C8CFFA4A4 A4FFBBBBBBFFB3B3B3FFACACACFFA9A9A9FFAFAFAFFFBFBFBFFF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B280B2B2B2808C8C 8CFF8C8C8CFFA4A4A4FFBCBCBCFFB5B5B5FFB9B9B9FFC8C8C8FF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2 B280B2B2B2808C8C8CFF8C8C8CFFA6A6A6FFCCCCCCFFACACACFF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2 B200B2B2B200B2B2B280B2B2B2808C8C8CFF8C8C8CFF8C8C8CFFB2B2B280FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2 B200B2B2B200B2B2B200B2B2B200B2B2B280B2B2B280B2B2B280B2B2B200FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 B2008C8C8CFF8C8C8CFF8C8C8CFFB2B2B200B2B2B200B2B2B200B2B2B200B2B2 B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFBBBBBBFFFDFDFDFFBBBBBBFF8C8C8CFF8C8C8CFFB2B2B200B2B2B200B2B2 B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFF9F9F9FFF7F7F7FFF7F7F7FFF8F8F8FFB9B9B9FF8C8C8CFF8C8C8CFFB2B2 B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFF4F4F4FFF1F1F1FFEFEFEFFFF0F0F0FFF1F1F1FFF3F3F3FFB7B7B7FF8C8C 8CFF8C8C8CFFB2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFEEEEEEFFEAEAEAFFE8E8E8FFE8E8E8FFE9E9E9FFEAEAEAFFEBEBEBFFEDED EDFFB5B5B5FF8C8C8CFF8C8C8CFFB2B2B200B2B2B200B2B2B200B2B2B200FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFE9E9E9FFE4E4E4FFE1E1E1FFE1E1E1FFE1E1E1FFE1E1E1FFE2E2E2FFE4E4 E4FFE6E6E6FFE8E8E8FFB3B3B3FF8C8C8CFF8C8C8CFFB2B2B200B2B2B200FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFE4E4E4FFDDDDDDFFD9D9D9FFD9D9D9FFD9D9D9FFD9D9D9FFD9D9D9FFDADA DAFFDBDBDBFFDDDDDDFFDFDFDFFFE4E4E4FFB3B3B3FF8C8C8CFFB2B2B200FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFDEDEDEFFD6D6D6FFD2D2D2FFD2D2D2FFD2D2D2FFD2D2D2FFD2D2D2FFD2D2 D2FFD2D2D2FFD3D3D3FFD4D4D4FFD8D8D8FFE0E0E0FFB3B3B3FF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFBDBDBDFFACACACFFA4A4A4FFA4A4A4FFA4A4A4FFA4A4A4FFA4A4A4FFA4A4 A4FFA4A4A4FFA5A5A5FFA9A9A9FFB0B0B0FFC0C0C0FFABABABFF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFBDBDBDFFACACACFFA4A4A4FFA4A4A4FFA4A4A4FFA4A4A4FFA4A4A4FFA5A5 A5FFA8A8A8FFACACACFFB3B3B3FFBEBEBEFFA8A8A8FF8C8C8CFFB2B2B280FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFBDBDBDFFACACACFFA4A4A4FFA4A4A4FFA4A4A4FFA5A5A5FFA8A8A8FFACAC ACFFB3B3B3FFBBBBBBFFA4A4A4FF8C8C8CFF8C8C8CFFB2B2B280B2B2B200FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFBDBDBDFFACACACFFA4A4A4FFA5A5A5FFA8A8A8FFACACACFFB3B3B3FFBBBB BBFFA4A4A4FF8C8C8CFF8C8C8CFFB2B2B280B2B2B280B2B2B200B2B2B200FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFBFBFBFFFAFAFAFFFA9A9A9FFACACACFFB3B3B3FFBBBBBBFFA4A4A4FF8C8C 8CFF8C8C8CFFB2B2B280B2B2B280B2B2B200B2B2B200B2B2B200B2B2B200FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFC8C8C8FFB9B9B9FFB5B5B5FFBCBCBCFFA4A4A4FF8C8C8CFF8C8C8CFFB2B2 B280B2B2B280B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFACACACFFCCCCCCFFA6A6A6FF8C8C8CFF8C8C8CFFB2B2B280B2B2B280B2B2 B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 B2808C8C8CFF8C8C8CFF8C8C8CFFB2B2B280B2B2B280B2B2B200B2B2B200B2B2 B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 B200B2B2B280B2B2B280B2B2B280B2B2B200B2B2B200B2B2B200B2B2B200B2B2 B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 B2008C8C8CFF8C8C8CFFB2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2 B200B2B2B200B2B2B200B2B2B2008C8C8CFF8C8C8CFF8C8C8CFF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFBBBBBBFFBBBBBBFF8C8C8CFF8C8C8CFFB2B2B200B2B2B200B2B2B200B2B2 B200B2B2B200B2B2B200B2B2B2008C8C8CFFFDFDFDFFFDFDFDFF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFF9F9F9FFF8F8F8FFF8F8F8FFB9B9B9FF8C8C8CFF8C8C8CFFB2B2B200B2B2 B200B2B2B200B2B2B200B2B2B2008C8C8CFFF9F9F9FFF9F9F9FF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFF4F4F4FFF1F1F1FFF0F0F0FFF1F1F1FFF3F3F3FFB7B7B7FF8C8C8CFF8C8C 8CFFB2B2B200B2B2B200B2B2B2008C8C8CFFF5F5F5FFF5F5F5FF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFEEEEEEFFEAEAEAFFE8E8E8FFE9E9E9FFEAEAEAFFEBEBEBFFEDEDEDFFB5B5 B5FF8C8C8CFF8C8C8CFFB2B2B2008C8C8CFFF0F0F0FFF0F0F0FF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFE9E9E9FFE4E4E4FFE1E1E1FFE1E1E1FFE1E1E1FFE2E2E2FFE4E4E4FFE6E6 E6FFE8E8E8FFB3B3B3FF8C8C8CFF8C8C8CFFECECECFFECECECFF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFE4E4E4FFDDDDDDFFD9D9D9FFD9D9D9FFD9D9D9FFD9D9D9FFDADADAFFDBDB DBFFDDDDDDFFDFDFDFFFE4E4E4FF8C8C8CFFE7E7E7FFE7E7E7FF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFDEDEDEFFD6D6D6FFD2D2D2FFD2D2D2FFD2D2D2FFD2D2D2FFD2D2D2FFD2D2 D2FFD3D3D3FFD4D4D4FFD8D8D8FF8C8C8CFFE3E3E3FFE3E3E3FF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFBDBDBDFFACACACFFA4A4A4FFA4A4A4FFA4A4A4FFA4A4A4FFA4A4A4FFA4A4 A4FFA5A5A5FFA9A9A9FFB0B0B0FF8C8C8CFFC6C6C6FFC6C6C6FF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFBDBDBDFFACACACFFA4A4A4FFA4A4A4FFA4A4A4FFA4A4A4FFA5A5A5FFA8A8 A8FFACACACFFB3B3B3FFBEBEBEFF8C8C8CFFC6C6C6FFC6C6C6FF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFBDBDBDFFACACACFFA4A4A4FFA4A4A4FFA5A5A5FFA8A8A8FFACACACFFB3B3 B3FFBBBBBBFFA4A4A4FF8C8C8CFF8C8C8CFFC6C6C6FFC6C6C6FF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFBDBDBDFFADADADFFA5A5A5FFA8A8A8FFACACACFFB3B3B3FFBBBBBBFFA4A4 A4FF8C8C8CFF8C8C8CFFB2B2B2808C8C8CFFC6C6C6FFC6C6C6FF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFC0C0C0FFB2B2B2FFADADADFFB3B3B3FFBBBBBBFFA4A4A4FF8C8C8CFF8C8C 8CFFB2B2B280B2B2B280B2B2B2008C8C8CFFC6C6C6FFC6C6C6FF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFCBCBCBFFBEBEBEFFBDBDBDFFA4A4A4FF8C8C8CFF8C8C8CFFB2B2B280B2B2 B280B2B2B200B2B2B200B2B2B2008C8C8CFFCCCCCCFFCCCCCCFF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C 8CFFADADADFFAAAAAAFF8C8C8CFF8C8C8CFFB2B2B280B2B2B280B2B2B200B2B2 B200B2B2B200B2B2B200B2B2B2008C8C8CFFD8D8D8FFD8D8D8FF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 B2808C8C8CFF8C8C8CFFB2B2B280B2B2B280B2B2B200B2B2B200B2B2B200B2B2 B200B2B2B200B2B2B200B2B2B2008C8C8CFF8C8C8CFF8C8C8CFF8C8C8CFFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 B200B2B2B280B2B2B280B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2 B200B2B2B200B2B2B200B2B2B200B2B2B280B2B2B280B2B2B280B2B2B280FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00CACACA00CACACA00CACACA00CACACA00CACA CA00CACACA10CACACAEBCECECEFBCECECEFBCDCDCDFBCDCDCDFBCECECEFBCECE CEFBCECECEFBCDCDCDFBCDCDCDFBCECECEFBCBCBCBEBCACACA10CACACA00CACA CA00CACACA00CACACA00CACACA00CCCCCC00CCCCCC00CACACA00C9C9C900C9C9 C900C8C8C810D0D0D0EFE2E2E2FFE1E1E1FFE1E1E1FFE0E0E0FFE1E1E1FFE1E1 E1FFE1E1E1FFE1E1E1FFE1E1E1FFE2E2E2FFD1D1D1EFCACACA10CCCCCC00CBCB CB00CCCCCC00CECECE00CECECE00BABABA00B9B9B900C7C7C700CDCDCD00CBCB CB00C9C9C910D0D0D0EFDFDFDFFFDDDDDDFFDDDDDDFFDEDEDEFFDEDEDEFFDEDE DEFFDEDEDEFFDDDDDDFFDDDDDDFFDEDEDEFFD2D2D2EFCCCCCC10CDCDCD00D0D0 D000CACACA00BDBDBD00BDBDBD00B1B1B100B1B1B100BBBBBB00BCBCBC00CCCC CC00CBCBCB10D0D0D0EFDCDCDCFFDCDCDCFFDBDBDBFFDBDBDBFFDCDCDCFFDCDC DCFFDBDBDBFFDBDBDBFFDCDCDCFFDCDCDCFFD3D3D3EFD0D0D010D0D0D000BDBD BD00BDBDBD00B5B5B500B5B5B500B2B2B200B2B2B200BCBCBC00B2B2B200BBBB BB00CDCDCD10D1D1D1EFDADADAFFDADADAFFDADADAFFDADADAFFD9D9D9FFDADA DAFFDADADAFFD9D9D9FFDADADAFFDADADAFFD4D4D4EFD3D3D310BDBDBD00B1B1 B100BEBEBE00B6B6B600B6B6B600B2B2B200B2B2B200BCBCBC00B4B4B400AEAE AE00CCCCCC0FD4D4D4EFD8D8D8FFD8D8D8FFD7D7D7FFD8D8D8FFD8D8D8FFD8D8 D8FFD8D8D8FFD8D8D8FFD8D8D8FFD8D8D8FFD3D3D3EFBBBBBB0DAFAFAF00B4B4 B400BEBEBE00B6B6B600B6B6B600B2B2B200B2B2B200BBBBBB00B3B3B31BB2B2 B210A3A3A310CACACAEDD8D8D8FFD6D6D6FFD6D6D6FFD5D5D5FFD6D6D6FFD6D6 D6FFD5D5D5FFD6D6D6FFD6D6D6FFD7D7D7FFD0D0D0F0AFAFAF23B2B2B210B3B3 B30DBDBDBD00B6B6B600B6B6B600B3B3B300B2B2B207C7C7C79DB4B4B4F37979 79F1878787EFC5C5C5FED2D2D2FFCFCFCFFFCFCFCFFFCFCFCFFFCFCFCFFFCFCF CFFFCFCFCFFFCFCFCFFFCFCFCFFFD1D1D1FFC8C8C8FE8A8A8AF2747474F1B7B7 B7EBC9C9C9A5B6B6B610B7B7B700BEBEBE00BBBBBB5AF1F1F1FED3D3D3FF8181 81FF8E8E8EFF9F9F9FFFA2A2A2FFA1A1A1FFA1A1A1FFA1A1A1FFA1A1A1FFA1A1 A1FFA1A1A1FFA1A1A1FFA1A1A1FFA2A2A2FFA1A1A1FF7E7E7EFF6E6E6EFFDCDC DCFFF6F6F6FFC0C0C065C3C3C300C1C1C100BEBEBE67F7F7F7FFCACACAFF8585 85FFACACACFF939393FF929292FF939393FF939393FF929292FF929292FF9292 92FF939393FF939393FF939393FF939393FF929292FFA6A6A6FF838383FFD7D7 D7FFFAFAFAFFC5C5C571C8C8C800C1C1C100BEBEBE6DF7F7F7FFCBCBCBFF8282 82FFB4B4B4FFAFAFAFFFB0B0B0FFAFAFAFFFAFAFAFFFB0B0B0FFB0B0B0FFB0B0 B0FFAFAFAFFFAFAFAFFFAFAFAFFFB0B0B0FFB0B0B0FFB5B5B5FF828282FFD6D6 D6FFFAFAFAFFC4C4C476C7C7C700BCBCBC00B9B9B970F5F5F5FFD1D1D1FF7A7A 7AFF818181FF757575FF777777FF777777FF777777FF777777FF777777FF7777 77FF777777FF777777FF777777FF777777FF747474FF838383FF7B7B7BFFD7D7 D7FFF8F8F8FFBDBDBD76C0C0C000B6B6B600B3B3B371EBEBEBFFD2D2D2FF6F6F 6FFF6E6E6EFF636363FF656565FF656565FF656565FF656565FF656565FF6565 65FF656565FF656565FF656565FF656565FF636363FF6E6E6EFF6D6D6DFFD7D7 D7FFEAEAEAFFB5B5B575B8B8B800B3B3B300B0B0B074E1E1E1FFD1D1D1FF6E6E 6EFF878787FF808080FF808080FF808080FF808080FF808080FF808080FF8080 80FF808080FF808080FF808080FF808080FF7F7F7FFF888888FF6D6D6DFFD3D3 D3FFDEDEDEFFB0B0B076B3B3B300ADADAD00AAAAAA7FD4D4D4FFEAEAEAFF9696 96FF6A6A6AFF717171FF717171FF717171FF717171FF707070FF717171FF7171 71FF707070FF717171FF717171FF717171FF717171FF696969FFA0A0A0FFEEEE EEFFCFCFCFFFAAAAAA7FADADAD00B7B7B700AAAAAA80CDCDCDFFE0E0E0FFEAEA EAFFE5E5E5FFEDEDEDFFE8E8E8FFE8E8E8FFE8E8E8FFE8E8E8FFE8E8E8FFE8E8 E8FFE8E8E8FFE7E7E7FFE7E7E7FFE7E7E7FFE8E8E8FFEFEFEFFFD7D7D7FFCECE CEFFCACACAFFAAAAAA80B7B7B70070707000B8B8B880CBCBCBFFD8D8D8FFD6D6 D6FFCDCDCDFF939393FFADADADFFACACACFFACACACFFACACACFFABABABFFABAB ABFFABABABFFABABABFFABABABFFABABABFFA3A3A3FF9B9B9BFFAEAEAEFFBABA BAFFC9C9C9FFB8B8B88070707000000000006E6E6E82D4D4D4FFD4D4D4FFD5D5 D5FFC0C0C0FF4C4C4CFF969696FF949494FF959595FF969696FF989898FF9999 99FF9A9A9AFF9B9B9BFF9E9E9EFFA1A1A1FF8D8D8DFF575757FFD6D6D6FFD1D1 D1FFD0D0D0FF6E6E6E8200000000000000073F3F3F46B4B4B4E0D3D3D3FFD7D7 D7FFBDBDBDFF626262FFC0C0C0FFBDBDBDFFBFBFBFFFC0C0C0FFC2C2C2FFC4C4 C4FFC6C6C6FFC7C7C7FFCACACAFFCECECEFFBABABAFF686868FFD6D6D6FFD2D2 D2FFB8B8B8E9444444520000000500000019000000253E3E3E51777777B37575 75B6878787B98E8E8ED1D1D1D1FFD1D1D1FFD1D1D1FFD3D3D3FFD4D4D4FFD6D6 D6FFD8D8D8FFD9D9D9FFDADADAFFDDDDDDFFD7D7D7FB767676C2747474B47979 79B4434343570000002400000019000000040000000500000000000000000000 0000111111005C5C5C43E1E1E1FFDDDDDDFFDDDDDDFFDEDEDEFFDEDEDEFFDFDF DFFFE1E1E1FFE1E1E1FFE2E2E2FFE4E4E4FFE0E0E0FE2525250C000000000000 0000000000000000000500000004000000000000000000000000000000000000 00000000000F0303032C252525542424245A2424245924242459242424592424 24592525255925252559252525592525255A2222224F00000022000000090000 0000000000000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 B200B2B2B200838383FF838383FFB2B2B200B2B2B200B2B2B200B2B2B200B2B2 B200B2B2B200B2B2B200B2B2B200838383FF838383FFB2B2B200B2B2B200FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 B200838383FFB6B6B6FFB6B6B6FF838383FFB2B2B200B2B2B200B2B2B200B2B2 B200B2B2B200B2B2B200838383FFB6B6B6FFB6B6B6FF838383FFB2B2B200FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008383 83FFB5B5B5FFF9F9F9FFF8F8F8FFB4B4B4FF838383FFB2B2B200B2B2B200B2B2 B200B2B2B200838383FFB4B4B4FFF8F8F8FFF9F9F9FFB5B5B5FF838383FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008383 83FFB3B3B3FFF4F4F4FFF2F2F2FFF3F3F3FFB2B2B2FF838383FFB2B2B200B2B2 B200838383FFB2B2B2FFF3F3F3FFF2F2F2FFF4F4F4FFB3B3B3FF838383FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 B280838383FFB1B1B1FFEDEDEDFFECECECFFEDEDEDFFB0B0B0FF838383FF8383 83FFB0B0B0FFEDEDEDFFECECECFFEDEDEDFFB1B1B1FF838383FFB2B2B280FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 B200B2B2B280838383FFAFAFAFFFE7E7E7FFE5E5E5FFE5E5E5FFE5E5E5FFE5E5 E5FFE5E5E5FFE5E5E5FFE7E7E7FFAFAFAFFF838383FFB2B2B280B2B2B200FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 B200B2B2B200B2B2B280838383FFABABABFFDFDFDFFFDCDCDCFFDBDBDBFFDBDB DBFFDCDCDCFFDFDFDFFFABABABFF838383FFB2B2B280B2B2B200B2B2B200FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 B200B2B2B200B2B2B200B2B2B280838383FFDADADAFFD5D5D5FFD3D3D3FFD3D3 D3FFD5D5D5FFDADADAFF838383FFB2B2B280B2B2B200B2B2B200B2B2B200FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 B200B2B2B200B2B2B200B2B2B200838383FFB8B8B8FFAFAFAFFFABABABFFABAB ABFFAFAFAFFFB8B8B8FF838383FFB2B2B200B2B2B200B2B2B200B2B2B200FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 B200B2B2B200B2B2B200838383FF9E9E9EFFB6B6B6FFB0B0B0FFAFAFAFFFAFAF AFFFB0B0B0FFB6B6B6FF9E9E9EFF838383FFB2B2B200B2B2B200B2B2B200FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 B200B2B2B200838383FFA1A1A1FFBDBDBDFFB7B7B7FFB6B6B6FFB8B8B8FFB8B8 B8FFB6B6B6FFB7B7B7FFBDBDBDFFA1A1A1FF838383FFB2B2B200B2B2B200FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 B200838383FFA2A2A2FFBFBFBFFFBABABAFFBDBDBDFF9E9E9EFF838383FF8383 83FF9E9E9EFFBDBDBDFFBABABAFFBFBFBFFFA2A2A2FF838383FFB2B2B200FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008383 83FFA7A7A7FFC6C6C6FFBCBCBCFFBFBFBFFFA1A1A1FF838383FFB2B2B280B2B2 B280838383FFA1A1A1FFBFBFBFFFBCBCBCFFC6C6C6FFA7A7A7FF838383FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008383 83FFA8A8A8FFCBCBCBFFC6C6C6FFA2A2A2FF838383FFB2B2B280B2B2B200B2B2 B200B2B2B280838383FFA2A2A2FFC6C6C6FFCBCBCBFFA8A8A8FF838383FFFFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 B280838383FFA8A8A8FFA7A7A7FF838383FFB2B2B280B2B2B200B2B2B200B2B2 B200B2B2B200B2B2B280838383FFA7A7A7FFA8A8A8FF838383FFB2B2B280FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 B200B2B2B280838383FF838383FFB2B2B280B2B2B200B2B2B200B2B2B200B2B2 B200B2B2B200B2B2B200B2B2B280838383FF838383FFB2B2B280B2B2B200FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 B200B2B2B200B2B2B280B2B2B280B2B2B200B2B2B200B2B2B200B2B2B200B2B2 B200B2B2B200B2B2B200B2B2B200B2B2B280B2B2B280B2B2B200B2B2B200FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00 } end end tomboy-ng_0.39-1/kcontrols/source/kfunctions.pas0000644000175000017500000023771514346341266021656 0ustar dbannondbannon{ @abstract(This file is part of the KControls component suite for Delphi and Lazarus.) @author(Tomas Krysl) Copyright (c) 2020 Tomas Krysl

License:
This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html. } unit kfunctions; // lowercase name because of Lazarus/Linux {$include kcontrols.inc} {$WEAKPACKAGEUNIT ON} interface uses {$IFDEF FPC} {$IFDEF MSWINDOWS} Windows, {$ELSE} {$IF DEFINED(UNIX) and (FPC_FULLVERSION>=20701)} UnixCP, {$IFEND} {$ENDIF} LazUTF8, {$ELSE} Windows, Messages, {$ENDIF} Classes, Contnrs, SysUtils; const { Carriage return character. } cCR = #13; { Line feed character. } cLF = #10; { TAB character. } cTAB = #9; { SPACE character. } cSPACE = #32; { String terminator. } cNULL = #0; { Set of word break characters. } cWordBreaks = [cNULL, cTAB, cSPACE]; { Set of line break characters. } cLineBreaks = [cCR, cLF]; { Text ellipsis string. } cEllipsis = '...'; { Alphabetic letters. } cLetters = ['a'..'z', 'A'..'Z']; { Number. } cNumbers = ['0'..'9']; {$IFnDEF FPC} lcl_fullversion = 0; {$ENDIF} {$IFDEF MSWINDOWS} { @exclude } SHFolderDll = 'SHFolder.dll'; {$ENDIF} {$IFDEF UNIX} cEOL = cLF; cFirstEOL = cLF; {$ELSE} cEOL = cCR + cLF; cFirstEOL = cCR; {$ENDIF} {$IFDEF MSWINDOWS} cDirectoryDelimiter = '\'; {$ELSE} cDirectoryDelimiter = '/'; {$ENDIF} cUTF16FirstSurrogateBegin = $D800; cUTF16FirstSurrogateEnd = $DBFF; cUTF16SecondSurrogateBegin = $DC00; cUTF16SecondSurrogateEnd = $DFFF; cHexFmtText = '%.2x'; cHexBase = 16; cHexDigitCount = 2; type //PInteger = ^Integer; defined by System.pas { Static array for Integer. } TIntegers = array[0..MaxInt div SizeOf(Integer) - 1] of Integer; { Pointer for TIntegers. } PIntegers = ^TIntegers; { Dynamic array for Integer. } TDynIntegers = array of Integer; //PCardinal = ^Cardinal; defined by System.pas { Static array for Cardinal. } TCardinals = array[0..MaxInt div SizeOf(Cardinal) - 1] of Cardinal; { Pointer for TCardinals. } PCardinals = ^TCardinals; { Dynamic array for Cardinal. } TDynCardinals = array of Cardinal; //PShortInt = ^ShortInt; defined by System.pas { Static array for ShortInt. } TShortInts = array[0..MaxInt div SizeOf(ShortInt) - 1] of ShortInt; { Pointer for TShortInts. } PShortInts = ^TShortInts; { Dynamic array for ShortInt. } TDynShortInts = array of ShortInt; //PSmallInt = ^SmallInt; defined by System.pas { Static array for SmallInt. } TSmallInts = array[0..MaxInt div SizeOf(SmallInt) - 1] of SmallInt; { Pointer for TSmallInts. } PSmallInts = ^TSmallInts; { Dynamic array for SmallInt. } TDynSmallInts = array of SmallInt; //PLongInt = ^LongInt; defined by System.pas { Static array for LongInt. } TLongInts = array[0..MaxInt div SizeOf(LongInt) - 1] of LongInt; { Pointer for TLongInts. } PLongInts = ^TLongInts; { Dynamic array for LongInt. } TDynLongInts = array of LongInt; //PInt64 = ^Int64; defined by System.pas { Static array for Int64. } TInt64s = array[0..MaxInt div SizeOf(Int64) - 1] of Int64; { Pointer for TInt64s. } PInt64s = ^TInt64s; { Dynamic array for Int64. } TDynInt64s = array of Int64; //PByte = ^Byte; defined by System.pas { Static array for Byte. } TBytes = array[0..MaxInt div SizeOf(Byte) - 1] of Byte; { Pointer for TBytes. } PBytes = ^TBytes; { Dynamic array for Byte. } TDynBytes = array of Byte; //PWord = ^Word; defined by System.pas { Static array for Word. } TWords = array[0..MaxInt div SizeOf(Word) - 1] of Word; { Pointer for TWords. } PWords = ^TWords; { Dynamic array for Word. } TDynWords = array of Word; //PLongWord = ^LongWord; defined by System.pas { Static array for LongWord. } TLongWords = array[0..MaxInt div SizeOf(LongWord) - 1] of LongWord; { Pointer for TLongWords. } PLongWords = ^TLongWords; { Dynamic array for LongWord. } TDynLongWords = array of LongWord; {$IF DEFINED(COMPILER10_UP) OR DEFINED(FPC)} {$IFDEF FPC} PUInt64 = ^UInt64; {$ELSE} //PUInt64 = ^UInt64; defined by System.pas {$ENDIF} { Static array for UInt64. } TUInt64s = array[0..MaxInt div SizeOf(UInt64) - 1] of UInt64; { Pointer for TUInt64s. } PUInt64s = ^TUInt64s; { Dynamic array for UInt64. } TDynUInt64s = array of UInt64; {$IFEND} //PSingle = ^Single; defined by System.pas { Static array for Single. } TSingles = array[0..MaxInt div SizeOf(Single) - 1] of Single; { Pointer for TSingles. } PSingles = ^TSingles; { Dynamic array for Single. } TDynSingles = array of Single; //PDouble = ^Double; defined by System.pas { Static array for Double. } TDoubles = array[0..MaxInt div SizeOf(Double) - 1] of Double; { Pointer for TDoubles. } PDoubles = ^TDoubles; { Dynamic array for Double. } TDynDoubles = array of Double; {$IFNDEF FPC} //PExtended = ^Extended; defined by System.pas { Static array for Extended. } TExtendeds = array[0..MaxInt div SizeOf(Extended) - 1] of Extended; { Pointer for TExtendeds. } PExtendeds = ^TExtendeds; { Dynamic array for Extended. } TDynExtendeds = array of Extended; {$ENDIF} //PChar is special type { Static array for Char. } TChars = array[0..MaxInt div SizeOf(Char) - 1] of Char; { Pointer for TChars. } PChars = ^TChars; { Dynamic array for Char. } TDynChars = array of Char; //PAnsiChar is special type { Static array for AnsiChar. } TAnsiChars = array[0..MaxInt div SizeOf(AnsiChar) - 1] of AnsiChar; { Pointer for TChars. } PAnsiChars = ^TAnsiChars; { Dynamic array for Char. } TDynAnsiChars = array of AnsiChar; PBoolean = ^Boolean; { Static array for Double. } TBooleans = array[0..MaxInt div SizeOf(Boolean) - 1] of Boolean; { Pointer for TBooleans. } PBooleans = ^TBooleans; { Dynamic array for Double. } TDynBooleans = array of Boolean; {$IFDEF FPC} { TKString is UTF8 string in Lazarus. } TKString = string; { TKChar is UTF8 character in Lazarus. } TKChar = string[7]; // UTF-8 character is at most 6 bytes plus a #0 { PKChar is pointer to UTF8 character in Lazarus. } PKChar = ^TKChar; { PKText is PChar (null terminated UTF8 string) in Lazarus. } PKText = PChar; {$ELSE} {$IFDEF STRING_IS_UNICODE} { TKString is UnicodeString (UTF16) in unicode aware Delphi. } TKString = string; { TKChar is Char in unicode aware Delphi. } TKChar = Char; { PKChar is pointer to Char in unicode aware Delphi. } PKChar = ^Char; { PKText is PChar in unicode aware Delphi. } PKText = PChar; {$ELSE} { TKString is WideString in old non-unicode Delphi versions. } TKString = WideString; { TKChar is WideChar in old non-unicode Delphi versions. } TKChar = WideChar; { PKChar is pointer to WideChar in old non-unicode Delphi versions. } PKChar = ^WideChar; { PKText is PWideChar in old non-unicode Delphi versions. } PKText = PWideChar; {$ENDIF} {$ENDIF} { Useful structure to handle general data and size as a single item } TDataSize = record Data: Pointer; Size: Int64; end; { Pointer for TDataSize } PDataSize = ^TDataSize; { Set type for @link(CharInSetEx). } TKSysCharSet = set of AnsiChar; { Defines a currency format settings for @link(FormatCurrency). } TKCurrencyFormat = record CurrencyFormat, CurrencyDecimals: Byte; CurrencyString: TKString; DecimalSep: Char; ThousandSep: Char; UseThousandSep: Boolean; end; { @abstract(Declares a structure that holds both column and row span of a cell)
    Members:
  • ColSpan - column span.
  • RowSpan - row span.
} TKCellSpan = record ColSpan: Integer; RowSpan: Integer; end; { @abstract(Declares a structure that holds point coordinates as 64-bit wide integers)
    Members:
  • X - X coord.
  • Y - Y coord.
} TKPoint64 = record X, Y: Int64; end; { Pointer } PKPoint64 = ^TKPoint64; { @abstract(Declares a structure that holds rectangle coordinates as 64-bit wide integers)
    Members:
  • Left - left coord.
  • Right - right coord.
  • Top - top coord.
  • Bottom - bottom coord.
} TKRect64 = record Left, Right, Top, Bottom: Int64; end; { Pointer } PKRect64 = ^TKRect64; { @abstract(Declares the digit position in a hex string)
    Members:
  • Index - byte index
  • Digit - digit index
} TKHexDigitPosition = record Index: Int64; Digit: Integer; end; TKLogType = ( lgNone, lgError, lgWarning, lgNote, lgHint, lgInfo, lgInputError, lgIOError, lgAll ); TKObjectList = class; TKObject = class(TObject) private FParent: TKObjectList; procedure SetParent(const Value: TKObjectList); protected FUpdateLock: Integer; procedure CallBeforeUpdate; virtual; procedure CallAfterUpdate; virtual; procedure ParentChanged; virtual; public constructor Create; virtual; procedure Assign(ASource: TKObject); virtual; function EqualProperties(AValue: TKObject): Boolean; virtual; procedure LockUpdate; virtual; procedure UnLockUpdate; virtual; function UpdateUnlocked: Boolean; virtual; property Parent: TKObjectList read FParent write SetParent; end; TKObjectClass = class of TKObject; TKObjectList = class(TObjectList) protected FUpdateLock: Integer; procedure CallBeforeUpdate; virtual; procedure CallAfterUpdate; virtual; public constructor Create; virtual; function Add(AObject: TObject): Integer; procedure Assign(ASource: TKObjectList); virtual; function EqualProperties(AValue: TKObjectList): Boolean; virtual; procedure Insert(Index: Integer; AObject: TObject); procedure LockUpdate; virtual; procedure UnLockUpdate; virtual; function UpdateUnlocked: Boolean; virtual; end; TKPersistent = class(TPersistent) private FChanged: Boolean; FUpdateLock: Integer; protected { Call in property setters to track changes to this class. } procedure Changed; { Override to perform requested actions when changing properties in this class. Update will be called either immediately when you call Changed or on next UnlockUpdate call if Changed has been called while updating was locked. } procedure Update; virtual; abstract; public { Creates the instance. } constructor Create; virtual; { Locks updating. Use this if you assign many properties at the same time. Every LockUpdate call must have a corresponding @link(TKPersistent.UnlockUpdate) call, please use a try-finally section. } procedure LockUpdate; { Unlocks page setup updating and updates the page settings. Each @link(TKPersistent.LockUpdate) call must be always followed by the UnlockUpdate call. } procedure UnlockUpdate(ACallUpdate: Boolean = True); { Returns True if updating is not locked, i.e. there is no open LockUpdate and UnlockUpdate pair. } function UpdateUnlocked: Boolean; property UpdateLock: Integer read FUpdateLock; end; { Replaces possible decimal separators in S with DecimalSeparator variable.} function AdjustDecimalSeparator(const S: string): string; { Converts an AnsiString into a TKString. If CodePage is not set the current system code page for ANSI-UTFx translations will be used. } function AnsiStringToString(const Text: AnsiString; CodePage: Cardinal = 0): TKString; {$IFNDEF FPC} function AnsiStringToWideChar(const Text: AnsiString; CodePage: Cardinal = 0): PWideChar; {$ENDIF} type { Callback for binary search data item comparison. } TBsCompareProc = function(Data: Pointer; Index: Integer; KeyPtr: Pointer): Integer; { Performs binary search on previously sorted data given by AData and ACount. KeyPtr is the pointer to the key which is passed to the ACompareProc. The items are compared by CompareProc callback. Returns the zero based index of the matched data or -1 if no match has been found. } function BinarySearch(AData: Pointer; ACount: Integer; KeyPtr: Pointer; ACompareProc: TBSCompareProc; ASortedDown: Boolean): Integer; { Compiler independent Delphi2009-like CharInSet function for ANSI characters. } function CharInSetEx(AChar: AnsiChar; const ASet: TKSysCharSet): Boolean; overload; { Compiler independent Delphi2009-like CharInSet function for Unicode characters. } function CharInSetEx(AChar: WideChar; const ASet: TKSysCharSet): Boolean; overload; { Compares two Integers. Returns 1 if I1 > I2, -1 if I1 < I2 and 0 if I1 = I2. } function CompareIntegers(I1, I2: Integer): Integer; { Compares two PWideChar strings. Returns 1 if W1 > W2, -1 if W1 < W2 and 0 if W1 = W2. The strings will be compared using the default user locale unless another locale has been specified in Locale. } function CompareWideChars(W1, W2: PWideChar{$IFDEF USE_WIDEWINPROCS}; Locale: Cardinal = LOCALE_USER_DEFAULT{$ENDIF}): Integer; {$IFDEF STRING_IS_UNICODE} { Compares two Unicode strings (Lazarus, Delphi 2009 and better). Returns 1 if S1 > S2, -1 if S1 < S2 and 0 if S1 = S2. The strings will be compared using the default user locale unless another locale has been specified in Locale. } function CompareChars(S1, S2: PChar{$IFDEF USE_WIDEWINPROCS}; Locale: Cardinal = LOCALE_USER_DEFAULT{$ENDIF}): Integer; {$ENDIF} { Compares two WideString strings. Returns 1 if W1 > W2, -1 if W1 < W2 and 0 if W1 = W2. The strings will be compared using the default user locale unless another locale has been specified in Locale. } function CompareWideStrings(W1, W2: WideString{$IFDEF USE_WIDEWINPROCS}; Locale: Cardinal = LOCALE_USER_DEFAULT{$ENDIF}): Integer; {$IFDEF STRING_IS_UNICODE} { Compares two Unicode strings (Lazarus, Delphi 2009 and better). Returns 1 if S1 > S2, -1 if S1 < S2 and 0 if S1 = S2. The strings will be compared using the default user locale unless another locale has been specified in Locale. } function CompareStrings(S1, S2: string{$IFDEF USE_WIDEWINPROCS}; Locale: Cardinal = LOCALE_USER_DEFAULT{$ENDIF}): Integer; {$ENDIF} { Converts tab characters in a string to space characters. } procedure ConvertTabsToSpaces(var AText: TKString; ASpacesForTab: Integer); { Creates given directory, even if more folders have to be created. } function CreateMultipleDir(const Dir: string): Boolean; { Converts hexadecimal digit to nibble. } function DigitToNibble(Digit: AnsiChar; var Nibble: Byte): Boolean; { Performs integer division. If there is a nonzero remainder, the result will be incremented. } function DivUp(Dividend, Divisor: Integer): Integer; { Performs 64-bit integer division. If there is a nonzero remainder, the result will be incremented. } function DivUp64(Dividend, Divisor: Int64): Int64; { Performs integer division. If there is a nonzero remainder, the result will be decremented. } function DivDown(Dividend, Divisor: Integer): Integer; { Performs 64-bit integer division. If there is a nonzero remainder, the result will be decremented. } function DivDown64(Dividend, Divisor: Int64): Int64; { Ensures the path given by APath has slash at the end. } procedure EnsureLastPathSlash(var APath: string); { Ensures the path given by APath has slash at the end. } function EnsureLastPathSlashFnc(const APath: string): string; { Raises a general exception with associated message Msg. } procedure Error(const Msg: string); { Swaps values of two SmallInt variables. } procedure Exchange(var Value1, Value2: SmallInt); overload; { Swaps values of two ShortInt variables. } procedure Exchange(var Value1, Value2: ShortInt); overload; { Swaps values of two Integer variables. } procedure Exchange(var Value1, Value2: Integer); overload; { Swaps values of two Int64 variables. } procedure Exchange(var Value1, Value2: Int64); overload; { Swaps values of two Byte variables. } procedure Exchange(var Value1, Value2: Byte); overload; { Swaps values of two Word variables. } procedure Exchange(var Value1, Value2: Word); overload; { Swaps values of two Cardinal variables. } procedure Exchange(var Value1, Value2: Cardinal); overload; {$IFDEF COMPILER10_UP } { Swaps values of two UInt64 variables. } procedure Exchange(var Value1, Value2: UInt64); overload; {$ENDIF} { Swaps values of two Single variables. } procedure Exchange(var Value1, Value2: Single); overload; { Swaps values of two Double variables. } procedure Exchange(var Value1, Value2: Double); overload; {$IFNDEF FPC} { Swaps values of two Extended variables. } procedure Exchange(var Value1, Value2: Extended); overload; {$ENDIF} { Swaps values of two Char variables. } procedure Exchange(var Value1, Value2: Char); overload; { Returns file name without path and extension. } function ExtractFileRawName(const APath: string): string; { Formats the given currency value with to specified parameters. Not thread safe. } function FormatCurrency(Value: Currency; const AFormat: TKCurrencyFormat): TKString; { Returns the module version for given module. Tested under WinX, Linux, OSX. } function GetAppVersion(const ALibName: string; out MajorVersion, MinorVersion, BuildNumber, RevisionNumber: Word): Boolean; { Returns the module version string for given module. Tested under WinX, Linux, OSX. } function GetAppVersionString(const ALibName, ACodePage, AString: string; out AValue: string): Boolean; { Returns number of a specific character in a string. } function GetCharCount(const AText: TKString; AChar: TKChar): Integer; { Returns the standard locale dependent format settings. } function GetFormatSettings: TFormatSettings; { Converts an integer into binary string with custom alignment (given by Digits). } function IntToAscii(Value: Int64; Digits: Integer): string; { Converts an integer into binary digit string with custom alignment (given by Digits) and suffix. } function IntToBinStr(Value: Int64; Digits: Integer; const Suffix: string): string; { Converts an integer value into BCD number. } function IntToBCD(Value: Cardinal): Cardinal; { Converts a signed integer into decimal digit string with custom alignment (given by Digits). } function IntToDecStr(Value: Int64; Digits: Integer = 0): string; { Converts a unsigned integer into decimal digit string with custom alignment (given by Digits). } function UIntToDecStr(Value: UInt64; Digits: Integer = 0): string; { Converts an integer into hexadecimal digit string with custom alignment (given by Digits), prefix and suffix. Digits represented by alphabetical characters can be either in lower or upper case. } function IntToHexStr(Value: Int64; Digits: Integer; const Prefix, Suffix: string; UseLowerCase: Boolean): string; { Converts an integer into octal digit string. } function IntToOctStr(Value: Int64): string; { Converts an integer into roman number. } function IntToRoman(Value: Integer; AUpperCase: Boolean): string; { Converts an integer into latin alphabetic numbering. } function IntToLatin(Value: Integer; AUpperCase: Boolean): string; { Calculates an integer power from an integer number. } function IntPowerInt(Value: Int64; Exponent: Integer): Int64; { Converts a binary string into integer with custom alignment (given by Digits). } function AsciiToInt(S: string; Digits: Integer): Int64; { Converts a BCD number into integer value. } function BCDToInt(Value: Cardinal): Cardinal; { Converts a binary digit string into integer with custom alignment (given by Digits) and sign of a value represented by the string (given by Signed). Code returns either zero for a successful conversion or the position of first bad character. } function BinStrToInt(S: string; Digits: Integer; Signed: Boolean; var Code: Integer): Int64; { Converts a decimal digit string into integer. Code returns either zero for a successful conversion or the position of first bad character. Equals to Val. } function DecStrToInt(S: string; var Code: Integer): Int64; { Converts a hexadecimal digit string into integer with custom alignment (given by Digits) and sign of a value represented by the string (given by Signed). Code returns either zero for a successful conversion or the position of first bad character. } function HexStrToInt(S: string; Digits: Integer; Signed: Boolean; var Code: Integer): Int64; { Converts an octal digit string into integer. Code returns either zero for a successful conversion or the position of first bad character. } function OctStrToInt(S: string; var Code: Integer): Int64; { Calls SysUtils.Format. } function KFormat(const Format: string; const Args: array of const; const AFormatSettings: TFormatSettings): string; overload; { Calls SysUtils.WideFormat. } function KFormat(const Format: WideString; const Args: array of const; const AFormatSettings: TFormatSettings): WideString; overload; { Makes a @link(TKCellSpan) record from AColumns and ARows. } function MakeCellSpan(AColumns, ARows: Integer): TKCellSpan; { Returns a clipped ShortInt value so that it lies between Min and Max } function MinMax(Value, Min, Max: ShortInt): ShortInt; overload; { Returns a clipped SmallInt value so that it lies between Min and Max } function MinMax(Value, Min, Max: SmallInt): SmallInt; overload; { Returns a clipped Integer value so that it lies between Min and Max } function MinMax(Value, Min, Max: Integer): Integer; overload; { Returns a clipped Int64 value so that it lies between Min and Max } function MinMax(Value, Min, Max: Int64): Int64; overload; { Returns a clipped Single value so that it lies between Min and Max } function MinMax(Value, Min, Max: Single): Single; overload; { Returns a clipped Double value so that it lies between Min and Max } function MinMax(Value, Min, Max: Double): Double; overload; {$IFNDEF FPC} { Returns a clipped Extended value so that it lies between Min and Max } function MinMax(Value, Min, Max: Extended): Extended; overload; {$ENDIF} { Fill the data & size structure. } function MakeDataSize(AData: Pointer; ASize: Integer): TDataSize; { Converts nibble to hexadecimal digit. } function NibbleToDigit(Nibble: Byte; UpperCase: Boolean): AnsiChar; type { Callback for quicksort data item comparison. } TQsCompareProc = function(Data: Pointer; Index1, Index2: Integer): Integer; { Callback for quicksort data item exchange. } TQsExchangeProc = procedure(Data: Pointer; Index1, Index2: Integer); { Sorts Count number of items by means of a non recursive quicksort algorithm. The items are compared by CompareProc callback and sorted by ExchangeProc callback. } procedure QuickSortNR(AData: Pointer; ACount: Integer; ACompareProc: TQsCompareProc; AExchangeProc: TQsExchangeProc; ASortedDown: Boolean); { Sorts Count number of items by means of a recursive quicksort algorithm. The items are compared by CompareProc callback and sorted by ExchangeProc callback. } procedure QuickSort(AData: Pointer; ACount: Integer; ACompareProc: TQsCompareProc; AExchangeProc: TQsExchangeProc; ASortedDown: Boolean); { Add AX and AY to APoint. } procedure OffsetPoint(var APoint: TPoint; AX, AY: Integer); overload; { Add AOffset to APoint. } procedure OffsetPoint(var APoint: TPoint; const AOffset: TPoint); overload; { Normalizes the given input rectangle. } function NormalizeRect(const ARect: TRect): TRect; { Create 64-bit point structure. } function Point64(AX, AY: Int64): TKPoint64; { Convert point structure to 64-bit point structure. } function PointToPoint64(const APoint: TPoint): TKPoint64; { Convert point structure to 64-bit point structure. } function Point64ToPoint(const APoint: TKPoint64): TPoint; { Examines if APoint lies within ARect. } function Pt64InRect(const ARect: TRect; const APoint: TKPoint64): Boolean; { Create 64-bit rectangle structure. } function Rect64(ALeft, ATop, ARight, ABottom: Int64): TKRect64; { Examines if some part of Rect lies within Bounds. } function RectInRect(Bounds, Rect: TRect): Boolean; { Examines if Rect lies fully within Bounds. } function RectInRectFully(Bounds, Rect: TRect): Boolean; { Add AX and AY to ARect. } procedure OffsetRect(var ARect: TRect; AX, AY: Integer); overload; { Add AOffset to ARect. } procedure OffsetRect(var ARect: TRect; const AOffset: TPoint); overload; { Ensures the path given by APath has no slash at the end. } procedure StripLastPathSlash(var APath: string); { Ensures the path given by APath has no slash at the end. } function StripLastPathSlashFnc(const APath: string): string; { Returns next character index for given string and character index. Takes MBCS (UTF16 in Delphi and UTF8 in Lazarus) into account. } function StrNextCharIndex(const AText: TKString; Index: Integer): Integer; { Returns previous character index for given string and character index. Takes MBCS (UTF16 in Delphi and UTF8 in Lazarus) into account. } function StrPreviousCharIndex(const AText: TKString; Index: Integer): Integer; { Converts byte index to code point index for given string and byte index. Takes MBCS (UTF16 in Delphi and UTF8 in Lazarus) into account. } function StrByteIndexToCPIndex(const AText: TKString; ByteIndex: Integer): Integer; { Converts code point index to byte index for given string and code point index. Takes MBCS (UTF16 in Delphi and UTF8 in Lazarus) into account. } function StrCPIndexToByteIndex(const AText: TKString; CPIndex: Integer): Integer; { Returns the index for given string where character at given index begins. Takes MBCS (UTF16 in Delphi and UTF8 in Lazarus) into account. } function StringCharBegin(const AText: TKString; Index: Integer): Integer; { Returns the number of characters in a string. Takes MBCS (UTF16 in Delphi and UTF8 in Lazarus) into account. } function StringLength(const AText: TKString): Integer; { Performs standard Copy operation. Takes MBCS (UTF16 in Delphi and UTF8 in Lazarus) into account. } function StringCopy(const ASource: TKString; At, Count: Integer): TKString; { Performs standard Delete operation. Takes MBCS (UTF16 in Delphi and UTF8 in Lazarus) into account. } procedure StringDelete(var ASource: TKString; At, Count: Integer); { Trims characters specified by ASet from the beginning and end of AText. New text length is returned by ALen. } procedure TrimWhiteSpaces(const AText: TKString; var AStart, ALen: Integer; const ASet: TKSysCharSet); overload; { Trims characters specified by ASet from the beginning and end of AText. } procedure TrimWhiteSpaces(var AText: TKString; const ASet: TKSysCharSet); overload; {$IFNDEF FPC} { Trims characters specified by ASet from the beginning and end of AText. } procedure TrimWhiteSpaces(var AText: AnsiString; const ASet: TKSysCharSet); overload; {$ENDIF} { Converts a TKString into AnsiString. If CodePage is not set the current system code page for ANSI-UTFx translations will be used. } function StringToAnsiString(const AText: TKString; CodePage: Cardinal = 0): AnsiString; function StringToUTF8(const AText: string): AnsiString; { Converts specified character of TKString into TKChar. } function StringToChar(const AText: TKString; AIndex: Integer): TKChar; {$IFDEF MSWINDOWS} function GetWindowsFolder(CSIDL: Cardinal; var APath: string): Boolean; function RunExecutable(const AFileName: string; AWaitForIt: Boolean): DWORD; {$ENDIF} function SystemCodePage: Integer; function NativeUTFToUnicode(const AText: TKString): WideChar; function UnicodeUpperCase(const AText: TKString): TKString; function UnicodeLowerCase(const AText: TKString): TKString; function UnicodeToNativeUTF(const AParam: WideChar): TKString; function UnicodeStringReplace(const AText, AOldPattern, ANewPattern: TKString; AFlags: TReplaceFlags): TKString; function UTF8ToString(const AText: AnsiString): string; { Creates a selection structure from given Index and Digit parameters } function MakeHexDigitPosition(Index: Int64; Digit: Integer): TKHexDigitPosition; { Converts a hexadecimal digit character ('0'..'F') to binary value } function DigitToBin(Value: AnsiChar): Integer; { Examines/converts hexadecimal digit string to binary value string. Returns True if the digit string is valid.
    Parameters:
  • S - hexadecimal digit string (e.g. 'AF01 DC05 3'). White spaces will be ignored. When Convert is True, the converted binary value string will be returned via this parameter (in this exammple '#A#F#0#1#D#C#0#5#3').
  • Convert - the digit string will be converted if True, otherwise it will be examined only.
} function DigitsToBinStr(var S: AnsiString; Convert: Boolean = True): Boolean; { Converts a binary value string into binary data. If the binary value string is not divisible by 2, it will be right padded with zero. Example: '#A#F#0#1#D#C#0#5#3' is converted into '#AF#01#DC#05#30'. } function BinStrToBinary(const S: AnsiString): AnsiString; { Converts binary value (0..15) to hexadecimal digit character ('0'..'F') } function BinToDigit(Value: Byte): AnsiChar; { Converts binary data into hexadecimal digit string.
    Parameters:
  • Buffer - binary data - intended for @link(TKCustomHexEditor.Buffer)
  • SelStart, SelEnd - specifies which part of the buffer is about to be converted. SelStart.Index must be lower or equal to SelEnd.Index - intended for @link(TKCustomHexEditor.GetRealSelStart) and @link(TKCustomHexEditor.GetRealSelEnd).
Example: '#AF#01#DC#05#30' is converted into 'AF01DC0530'. If AInsertSpaces is True then resulting string is 'AF 01 DC 05 30'. } function BinaryToDigits(Buffer: PBytes; SelStart, SelEnd: TKHexDigitPosition; AInsertSpaces: Boolean = False): AnsiString; overload; { Convertes binary data into hexadecimal digit string. Entire data used. } function BinaryToDigits(Buffer: PBytes; ASize: Int64; AInsertSpaces: Boolean = False): AnsiString; overload; { Convertes binary data into hexadecimal digit string. Uses AnsiString as source data. } function BinaryToDigits(const Source: AnsiString; AInsertSpaces: Boolean = False): AnsiString; overload; { Converts a binary value string into hexadecimal digit string. If the binary value string is not divisible by 2, it will be trimmed. Example: '#A#F#0#1#D#C#0#5#3' is converted into 'AF01DC05'. If AInsertSpaces is True then resulting string is 'AF 01 DC 05'. } function BinStrToDigits(const Source: AnsiString; AInsertSpaces: Boolean = False): AnsiString; { Insert spaces into hexadecimal digit string. Example: 'AF01DC05' becomes 'AF 01 DC 05'. } function InsertSpacesToDigits(const Source: AnsiString): AnsiString; { Replaces a hexadecimal digit in the given binary value. Returns the original value with a replaced digit.
    Parameters:
  • Value - original binary value
  • Digit - digit value (0..15)
  • Pos - digit position (order)
Example: Value = $A18D, Digit = $C, Pos = 3: Result = $AC8D } function ReplaceDigit(Value, Digit, Pos: Integer): Integer; implementation uses Math, TypInfo {$IFDEF FPC} , versionresource {$ENDIF} {$IFDEF USE_WIDEWINPROCS} , KWideWinProcs {$ENDIF} {$IFDEF FPC} , LConvEncoding {$ENDIF} ; { TKObject } constructor TKObject.Create; begin inherited; FParent := nil; FUpdateLock := 0; end; procedure TKObject.Assign(ASource: TKObject); begin end; procedure TKObject.CallAfterUpdate; begin end; procedure TKObject.CallBeforeUpdate; begin end; function TKObject.EqualProperties(AValue: TKObject): Boolean; begin Result := True; end; procedure TKObject.LockUpdate; begin if FUpdateLock <= 0 then CallBeforeUpdate; Inc(FUpdateLock); end; procedure TKObject.ParentChanged; begin end; procedure TKObject.SetParent(const Value: TKObjectList); begin if Value <> FParent then begin FParent := Value; ParentChanged; end; end; procedure TKObject.UnLockUpdate; begin if FUpdateLock > 0 then begin Dec(FUpdateLock); if FUpdateLock = 0 then CallAfterUpdate; end; end; function TKObject.UpdateUnlocked: Boolean; begin Result := FUpdateLock <= 0; end; { TKObjectList } constructor TKObjectList.Create; begin inherited; FUpdateLock := 0; end; function TKObjectList.Add(AObject: TObject): Integer; begin if AObject is TKObject then TKObject(AObject).Parent := Self; Result := inherited Add(AObject); end; procedure TKObjectList.Assign(ASource: TKObjectList); var I: Integer; Cls: TKObjectClass; SrcItem, DstItem: TKObject; begin if ASource <> nil then begin Clear; for I := 0 to ASource.Count - 1 do begin SrcItem := ASource.Items[I] as TKObject; Cls := TKObjectClass(SrcItem.ClassType); DstItem := Cls.Create; DstItem.Parent := Self; DstItem.Assign(SrcItem); Add(DstItem); end; end; end; procedure TKObjectList.CallBeforeUpdate; begin end; procedure TKObjectList.CallAfterUpdate; begin end; function TKObjectList.EqualProperties(AValue: TKObjectList): Boolean; var I: Integer; begin Result := False; if AValue <> nil then begin Result := AValue.Count = Count; if Result then begin for I := 0 to Count - 1 do if not TKObject(Items[I]).EqualProperties(TKObject(AValue[I])) then begin Result := False; Break; end; end; end; end; procedure TKObjectList.Insert(Index: Integer; AObject: TObject); begin if AObject is TKObject then TKObject(AObject).Parent := Self; inherited Insert(Index, AObject); end; procedure TKObjectList.LockUpdate; begin if FUpdateLock <= 0 then CallBeforeUpdate; Inc(FUpdateLock); end; procedure TKObjectList.UnLockUpdate; begin if FUpdateLock > 0 then begin Dec(FUpdateLock); if FUpdateLock = 0 then CallAfterUpdate; end; end; function TKObjectList.UpdateUnlocked: Boolean; begin Result := FUpdateLock <= 0; end; { TKPersistent } constructor TKPersistent.Create; begin inherited; FUpdateLock := 0; FChanged := False; end; procedure TKPersistent.Changed; begin if FUpdateLock = 0 then Update else FChanged := True; end; procedure TKPersistent.LockUpdate; begin Inc(FUpdateLock); FChanged := False; end; procedure TKPersistent.UnlockUpdate(ACallUpdate: Boolean); begin if FUpdateLock > 0 then begin Dec(FUpdateLock); if (FUpdateLock = 0) and FChanged and ACallUpdate then Update; end; end; function TKPersistent.UpdateUnlocked: Boolean; begin Result := FUpdateLock = 0; end; function AdjustDecimalSeparator(const S: string): string; var I: Integer; begin Result := S; for I := 1 to Length(Result) do if CharInSetEx(Result[I], [',', '.']) then Result[I] := GetFormatSettings.DecimalSeparator; end; function AnsiStringToString(const Text: AnsiString; CodePage: Cardinal): TKString; var {$IFDEF FPC} CP: string; {$ELSE} Len: Integer; {$ENDIF} begin {$IFDEF FPC} if CodePage = 0 then CP := 'ansi' else CP := Format('cp%d', [Codepage]); Result := LConvEncoding.ConvertEncoding(Text, CP, 'utf8'); {$ELSE} Len := MultiByteToWideChar(CodePage, 0, PAnsiChar(Text), -1, nil, 0); SetLength(Result, Len shr 1); MultiByteToWideChar(CodePage, 0, PAnsiChar(Text), -1, PWideChar(Result), Len); {$ENDIF} end; {$IFNDEF FPC} function AnsiStringToWideChar(const Text: AnsiString; CodePage: Cardinal): PWideChar; var Len: Integer; begin Len := MultiByteToWideChar(CodePage, 0, PAnsiChar(Text), -1, nil, 0); GetMem(Result, Len shl 1); MultiByteToWideChar(CodePage, 0, PAnsiChar(Text), -1, Result, Len); end; {$ENDIF} function BinarySearch(AData: Pointer; ACount: Integer; KeyPtr: Pointer; ACompareProc: TBsCompareProc; ASortedDown: Boolean): Integer; var Lo, Hi, Index, Ret: Integer; begin Result := -1; Lo := 0; Hi := ACount - 1; repeat Index := (Lo + Hi) div 2; Ret := ACompareProc(AData, Index, KeyPtr); if ASortedDown and (Ret < 0) or not ASortedDown and (Ret > 0) then Hi := Index - 1 else Lo := Index + 1 until (Lo > Hi) or (Ret = 0); if Ret = 0 then Result := Index; end; function CharInSetEx(AChar: AnsiChar; const ASet: TKSysCharSet): Boolean; begin Result := AChar in ASet; end; function CharInSetEx(AChar: WideChar; const ASet: TKSysCharSet): Boolean; begin Result := (Ord(AChar) < $100) and {$IFDEF COMPILER12_UP} CharInSet(AChar, ASet); {$ELSE} (AnsiChar(AChar) in ASet); {$ENDIF} end; function CompareIntegers(I1, I2: Integer): Integer; begin if I1 > I2 then Result := 1 else if I1 < I2 then Result := -1 else Result := 0; end; function CompareWideChars(W1, W2: PWideChar{$IFDEF USE_WIDEWINPROCS}; Locale: Cardinal{$ENDIF}): Integer; begin if (W1 = nil) or (W2 = nil) then begin if W1 <> nil then Result := 1 else if W2 <> nil then Result := -1 else Result := 0; end else begin {$IFDEF USE_WIDEWINPROCS} Result := WideWinProcs.CompareString(Locale, 0, W1, -1, W2, -1); Dec(Result, 2); {$ELSE} Result := WideCompareStr(WideString(W1), WideString(W2)); {$ENDIF} end; end; {$IFDEF STRING_IS_UNICODE} function CompareChars(S1, S2: PChar{$IFDEF USE_WIDEWINPROCS}; Locale: Cardinal{$ENDIF}): Integer; begin if (S1 = nil) or (S2 = nil) then begin if S1 <> nil then Result := 1 else if S2 <> nil then Result := -1 else Result := 0; end else begin {$IFDEF USE_WIDEWINPROCS} Result := WideWinProcs.CompareString(Locale, 0, PWideChar(S1), -1, PWideChar(S2), -1); Dec(Result, 2); {$ELSE} Result := CompareStr(string(S1), string(S2)); {$ENDIF} end; end; {$ENDIF} function CompareWideStrings(W1, W2: WideString{$IFDEF USE_WIDEWINPROCS}; Locale: Cardinal{$ENDIF}): Integer; begin {$IFDEF USE_WIDEWINPROCS} Result := WideWinProcs.CompareString(Locale, 0, PWideChar(W1), -1, PWideChar(W2), -1); Dec(Result, 2); {$ELSE} Result := WideCompareStr(W1, W2); {$ENDIF} end; {$IFDEF STRING_IS_UNICODE} function CompareStrings(S1, S2: string{$IFDEF USE_WIDEWINPROCS}; Locale: Cardinal{$ENDIF}): Integer; begin {$IFDEF USE_WIDEWINPROCS} Result := WideWinProcs.CompareString(Locale, 0, PWideChar(S1), -1, PWideChar(S2), -1); Dec(Result, 2); {$ELSE} Result := CompareStr(S1, S2); {$ENDIF} end; {$ENDIF} procedure ConvertTabsToSpaces(var AText: TKString; ASpacesForTab: Integer); var TabCount: Integer; S: TKString; I, J, K: Integer; begin if ASpacesForTab >= 0 then begin TabCount := GetCharCount(AText, cTAB); if TabCount > 0 then begin SetLength(S, Length(AText) + (ASpacesForTab - 1) * TabCount); J := 1; for I := 1 to Length(AText) do begin if AText[I] = cTAB then begin for K := 0 to ASpacesForTab - 1 do begin S[J] := cSPACE; Inc(J); end; end else begin S[J] := AText[I]; Inc(J); end; end; AText := S; end; end; end; function CreateMultipleDir(const Dir: string): Boolean; var I: Integer; T: string; begin for I := 1 to Length(Dir) do begin if CharInSetEx(Dir[I], ['/', '\']) then begin T := Copy(Dir, 1, I - 1); if not (DirectoryExists(T) or CreateDir(T)) then Break; end; end; if not DirectoryExists(Dir) then CreateDir(Dir); Result := DirectoryExists(Dir); end; function DigitToNibble(Digit: AnsiChar; var Nibble: Byte): Boolean; begin Result := True; if (Digit >= '0') and (Digit <= '9') then Nibble := Ord(Digit) - Ord('0') else if (Digit >= 'a') and (Digit <= 'f') then Nibble := Ord(Digit) - Ord('a') + 10 else if (Digit >= 'A') and (Digit <= 'F') then Nibble := Ord(Digit) - Ord('A') + 10 else Result := False; end; function DivUp(Dividend, Divisor: Integer): Integer; begin if Divisor = 0 then Result := 0 else if Dividend mod Divisor > 0 then Result := Dividend div Divisor + 1 else Result := Dividend div Divisor; end; function DivUp64(Dividend, Divisor: Int64): Int64; begin if Divisor = 0 then Result := 0 else if Dividend mod Divisor > 0 then Result := Dividend div Divisor + 1 else Result := Dividend div Divisor; end; function DivDown(Dividend, Divisor: Integer): Integer; begin if Divisor = 0 then Result := 0 else if Dividend mod Divisor < 0 then Result := Dividend div Divisor - 1 else Result := Dividend div Divisor; end; function DivDown64(Dividend, Divisor: Int64): Int64; begin if Divisor = 0 then Result := 0 else if Dividend mod Divisor < 0 then Result := Dividend div Divisor - 1 else Result := Dividend div Divisor; end; procedure EnsureLastPathSlash(var APath: string); begin if APath <> '' then if not CharInSetEx(APath[Length(APath)], ['\', '/']) then APath := APath + cDirectoryDelimiter; end; function EnsureLastPathSlashFnc(const APath: string): string; begin Result := APath; EnsureLastPathSlash(Result); end; procedure Exchange(var Value1, Value2: ShortInt); var Tmp: ShortInt; begin Tmp := Value1; Value1 := Value2; Value2 := Tmp; end; procedure Exchange(var Value1, Value2: SmallInt); var Tmp: SmallInt; begin Tmp := Value1; Value1 := Value2; Value2 := Tmp; end; procedure Exchange(var Value1, Value2: Integer); var Tmp: Integer; begin Tmp := Value1; Value1 := Value2; Value2 := Tmp; end; procedure Exchange(var Value1, Value2: Int64); var Tmp: Int64; begin Tmp := Value1; Value1 := Value2; Value2 := Tmp; end; procedure Exchange(var Value1, Value2: Byte); var Tmp: Byte; begin Tmp := Value1; Value1 := Value2; Value2 := Tmp; end; procedure Exchange(var Value1, Value2: Word); var Tmp: Word; begin Tmp := Value1; Value1 := Value2; Value2 := Tmp; end; procedure Exchange(var Value1, Value2: Cardinal); var Tmp: Cardinal; begin Tmp := Value1; Value1 := Value2; Value2 := Tmp; end; {$IFDEF COMPILER10_UP } procedure Exchange(var Value1, Value2: UINT64); var Tmp: UINT64; begin Tmp := Value1; Value1 := Value2; Value2 := Tmp; end; {$ENDIF} procedure Exchange(var Value1, Value2: Single); var Tmp: Single; begin Tmp := Value1; Value1 := Value2; Value2 := Tmp; end; procedure Exchange(var Value1, Value2: Double); var Tmp: Double; begin Tmp := Value1; Value1 := Value2; Value2 := Tmp; end; {$IFNDEF FPC} procedure Exchange(var Value1, Value2: Extended); var Tmp: Extended; begin Tmp := Value1; Value1 := Value2; Value2 := Tmp; end; {$ENDIF} procedure Exchange(var Value1, Value2: Char); var Tmp: Char; begin Tmp := Value1; Value1 := Value2; Value2 := Tmp; end; function ExtractFileRawName(const APath: string): string; var I: Integer; begin Result := ExtractFileName(APath); I := Length(Result); while I > 1 do begin if Result[I] = '.' then begin SetLength(Result, I - 1); Break; end; Dec(I); end; end; procedure Error(const Msg: string); begin raise Exception.Create(Msg); end; function FormatCurrency(Value: Currency; const AFormat: TKCurrencyFormat): TKString; var Fmt: string; FS: TFormatSettings; begin if AFormat.UseThousandSep then begin FS.ThousandSeparator := AFormat.ThousandSep; Fmt := '%.*n'; end else Fmt := '%.*f'; FS.DecimalSeparator := AFormat.DecimalSep; case AFormat.CurrencyFormat of 0: Result := KFormat('%s' + Fmt, [AFormat.CurrencyString, AFormat.CurrencyDecimals, Value], FS); 1: Result := KFormat(Fmt + '%s', [AFormat.CurrencyDecimals, Value, AFormat.CurrencyString], FS); 2: Result := KFormat('%s ' + Fmt, [AFormat.CurrencyString, AFormat.CurrencyDecimals, Value], FS); else Result := KFormat(Fmt + ' %s', [AFormat.CurrencyDecimals, Value, AFormat.CurrencyString], FS); end; end; function GetAppVersion(const ALibName: string; out MajorVersion, MinorVersion, BuildNumber, RevisionNumber: Word): Boolean; var {$IFDEF FPC} Info: TVersionResource; Stream: TResourceStream; ResID: Integer; Res: TFPResourceHandle; {$ELSE} dwHandle, dwLen: DWORD; BufLen: Cardinal; lpData: LPTSTR; pFileInfo: ^VS_FIXEDFILEINFO; {$ENDIF} begin Result := False; {$IFDEF FPC} Info := TVersionResource.Create; try ResID := 1; // Defensive code to prevent failure if no resource available... Res := FindResource(HInstance, PChar(PtrInt(ResID)), PChar(RT_VERSION)); If Res = 0 Then Exit; Stream := TResourceStream.CreateFromID(HInstance, ResID, {$IFDEF LCLWinCE}PWideChar{$ELSE}PChar{$ENDIF}(RT_VERSION)); Try Info.SetCustomRawDataStream(Stream); MajorVersion := Info.FixedInfo.FileVersion[0]; MinorVersion := Info.FixedInfo.FileVersion[1]; BuildNumber := Info.FixedInfo.FileVersion[2]; RevisionNumber := Info.FixedInfo.FileVersion[3]; Info.SetCustomRawDataStream(nil); Finally Stream.Free; End; Result := True; finally Info.Free; end; {$ELSE} dwLen := GetFileVersionInfoSize(PChar(ALibName), dwHandle); if dwLen <> 0 then begin GetMem(lpData, dwLen); try if GetFileVersionInfo(PChar(ALibName), dwHandle, dwLen, lpData) then begin if VerQueryValue(lpData, '\\', Pointer(pFileInfo), BufLen) then begin MajorVersion := HIWORD(pFileInfo.dwFileVersionMS); MinorVersion := LOWORD(pFileInfo.dwFileVersionMS); BuildNumber := HIWORD(pFileInfo.dwFileVersionLS); RevisionNumber := LOWORD(pFileInfo.dwFileVersionLS); Result := True; end; end; finally FreeMem(lpData); end; end; {$ENDIF} end; function GetAppVersionString(const ALibName, ACodePage, AString: string; out AValue: string): Boolean; {$IFnDEF FPC} type TTranslation = packed record wLanguage: Word; wCodePage: Word; end; {$ENDIF} var {$IFDEF FPC} Info: TVersionResource; Stream: TResourceStream; ResID: Integer; Res: TFPResourceHandle; {$ELSE} dwHandle, dwLen: DWORD; BufLen: Cardinal; lpData: LPTSTR; pValue: Pointer; Translation: ^TTranslation; CP: string; Tmp: WideString; {$ENDIF} begin Result := False; {$IFDEF FPC} Info := TVersionResource.Create; try ResID := 1; // Defensive code to prevent failure if no resource available... Res := FindResource(HInstance, PChar(PtrInt(ResID)), PChar(RT_VERSION)); If Res = 0 Then Exit; Stream := TResourceStream.CreateFromID(HInstance, ResID, {$IFDEF LCLWinCE}PWideChar{$ELSE}PChar{$ENDIF}(RT_VERSION)); Try Info.SetCustomRawDataStream(Stream); if Info.StringFileInfo.Count > 0 then begin AValue := Info.StringFileInfo.Items[0].Values[AString]; Result := True; end; Info.SetCustomRawDataStream(nil); Finally Stream.Free; End; finally Info.Free; end; {$ELSE} dwLen := GetFileVersionInfoSize(PChar(ALibName), dwHandle); if dwLen <> 0 then begin GetMem(lpData, dwLen); try if GetFileVersionInfo(PChar(ALibName), dwHandle, dwLen, lpData) then begin if ACodePage = '' then begin // retrieve first codepage available if VerQueryValue(lpData, '\VarFileInfo\Translation', Pointer(Translation), BufLen) and (BufLen >= 4) then CP := Format('%4.4x%4.4x', [Translation.wLanguage, Translation.wCodePage]) else CP := ''; // error! end else CP := ACodePage; if (CP <> '') and (VerQueryValue(lpData, PChar(Format('\StringFileInfo\%s\%s', [CP, AString])), pValue, BufLen)) then begin SetString(Tmp, PChar(pValue), BufLen); AValue := string(Tmp); Result := True; end; end; finally FreeMem(lpData); end; end; {$ENDIF} end; function GetCharCount(const AText: TKString; AChar: TKChar): Integer; var I: Integer; begin Result := 0; for I := 1 to Length(AText) do if AText[I] = AChar then Inc(Result); end; function GetFormatSettings: TFormatSettings; begin {$IFDEF FPC} Result := FormatSettings; {$ELSE} {$IFDEF COMPILER15_UP} Result := TFormatSettings.Create; {$ELSE} GetLocaleFormatSettings(GetThreadLocale, Result); {$ENDIF} {$ENDIF} end; function IntToAscii(Value: Int64; Digits: Integer): string; var I: Integer; begin Result := ''; I := 0; while I < Digits do begin Result := Result + Chr(Value and $FF); Value := Value shr 8; Inc(I); end; end; function IntToBCD(Value: Cardinal): Cardinal; var Exp: Cardinal; begin Result := 0; Exp := 1; while (Value > 0) and (Exp > 0) do begin Result := Result + Value mod 10 * Exp; Value := Value div 10; Exp := Exp * 16; end; end; function IntToBinStr(Value: Int64; Digits: Integer; const Suffix: string): string; var B: Byte; C: Char; begin Result := ''; if Digits <> 0 then Digits := MinMax(Digits, 1, 64); repeat B := Byte(Value and $1); Value := Value shr 1; C := Chr(Ord('0') + B); Result := C + Result; until (Value = 0) or ((Digits <> 0) and (Length(Result) = Digits)); while Length(Result) < Digits do Result := '0' + Result; Result := Result + Suffix; end; function IntToDecStr(Value: Int64; Digits: Integer): string; var B: Byte; C: Char; Signum: Boolean; begin Result := ''; Signum := Value < 0; {if Signum then asm nop end;} repeat B := Byte(Value mod 10); if Signum then B := 256 - B; Value := Value div 10; C := Chr(Ord('0') + B); Result := C + Result; until Value = 0; while Length(Result) < Digits do Result := '0' + Result; if Signum then Result := '-' + Result; end; function UIntToDecStr(Value: UInt64; Digits: Integer): string; var B: Byte; C: Char; begin Result := ''; repeat B := Byte(Value mod 10); Value := Value div 10; C := Chr(Ord('0') + B); Result := C + Result; until Value = 0; while Length(Result) < Digits do Result := '0' + Result; end; function IntToHexStr(Value: Int64; Digits: Integer; const Prefix, Suffix: string; UseLowerCase: Boolean): string; var B: Byte; begin Result := ''; if Digits <> 0 then Digits := MinMax(Digits, 1, 16); repeat B := Byte(Value and $F); Value := Value shr 4; Result := Char(NibbleToDigit(B, not UseLowerCase)) + Result; until (Value = 0) or ((Digits <> 0) and (Length(Result) = Digits)); while Length(Result) < Digits do Result := '0' + Result; Result := Prefix + Result + Suffix; end; function IntToOctStr(Value: Int64): string; var B: Byte; C: Char; Signum: Boolean; begin if Value < 0 then begin Signum := True; Value := -Value; end else Signum := False; Result := ''; repeat B := Byte(Value mod 8); Value := Value div 8; C := Chr(Ord('0') + B); Result := C + Result; until Value = 0; Result := '0' + Result; if Signum then Result := '-' + Result; end; function IntToRoman(Value: Integer; AUpperCase: Boolean): string; begin Result := ''; while Value >= 1000 do begin Result := Result + 'M'; Value := Value - 1000; end; { while } if Value >= 900 then begin Result := Result + 'CM'; Value := Value - 900; end; { if } while Value >= 500 do begin Result := Result + 'D'; Value := Value - 500; end; { while } if Value >= 400 then begin Result := Result + 'CD'; Value := Value - 400; end; { if } while Value >= 100 do begin Result := Result + 'C'; Value := Value - 100; end; { while } if Value >= 90 then begin Result := Result + 'XC'; Value := Value - 90; end; { if } while Value >= 50 do begin Result := Result + 'L'; Value := Value - 50; end; { while } if Value >= 40 then begin Result := Result + 'XL'; Value := Value - 40; end; { while } while Value >= 10 do begin Result := Result + 'X'; Value := Value - 10; end; { while } if Value >= 9 then begin Result := Result + 'IX'; Value := Value - 9; end; { if } while Value >= 5 do begin Result := Result + 'V'; Value := Value - 5; end; { while } if Value >= 4 then begin Result := Result + 'IV'; Value := Value - 4; end; { if } while Value > 0 do begin Result := Result + 'I'; Dec(Value); end; { while } if not AUpperCase then Result := LowerCase(Result); end; function IntToLatin(Value: Integer; AUpperCase: Boolean): string; var OrdA: Integer; begin Result := ''; if AUpperCase then OrdA := Ord('A') else OrdA := Ord('a'); while Value > 0 do begin Result := Chr(Value mod 26 + OrdA - 1) + Result; Value := Value div 26; end; end; function IntPowerInt(Value: Int64; Exponent: Integer): Int64; begin Result := Value; while Exponent > 1 do begin Result := Result * Value; Dec(Exponent); end; end; function AsciiToInt(S: string; Digits: Integer): Int64; var I: Integer; begin Result := 0; I := Min(Length(S), Digits); while I > 0 do begin Result := Result shl 8; Result := Ord(S[I]) + Result; Dec(I); end; end; function BCDToInt(Value: Cardinal): Cardinal; var Exp: Cardinal; begin Result := 0; Exp := 1; while Value > 0 do begin Result := Result + Min(Value and 15, 9) * Exp; Value := Value shr 4; Exp := Exp * 10; end; end; function BinStrToInt(S: string; Digits: Integer; Signed: Boolean; var Code: Integer): Int64; var I, L, Len: Integer; N: Byte; C: Char; M: Int64; begin Result := 0; Code := 0; L := 0; Len := Length(S); if (Digits = 0) or (Digits > 64) then Digits := 64; if (Len >= 1) and CharInSetEx(S[Len], ['b', 'B']) then begin Delete(S, Len, 1); Dec(Len); end; I := 1; while I <= Len do begin C := S[I]; N := 255; if (C >= '0') and (C <= '1') then N := Ord(C) - Ord('0'); if N > 1 then begin Code := I; Break; end else if (N > 0) or (Result <> 0) then begin if L >= Digits then begin Code := I; Break; end; Result := Result shl 1; Inc(Result, N); Inc(L); end; Inc(I); end; if Signed and (Digits < 64) then begin M := Int64(1) shl Digits; if Result >= M shr 1 - 1 then Dec(Result, M); end; end; function DecStrToInt(S: string; var Code: Integer): Int64; var I, Len: Integer; N: Byte; C: Char; Minus: Boolean; begin Result := 0; Code := 0; Len := Length(S); Minus := S[1] = '-'; if Minus then I := 2 else I := 1; while I <= Len do begin C := S[I]; N := 255; if (C >= '0') and (C <= '9') then N := Ord(C) - Ord('0'); if N > 9 then begin Code := I; Break; end else if (N > 0) or (Result <> 0) then begin Result := Result * 10; Inc(Result, N); end; Inc(I); end; if Minus then Result := -Result; end; function HexStrToInt(S: string; Digits: Integer; Signed: Boolean; var Code: Integer): Int64; var I, L, Len: Integer; N: Byte; C: AnsiChar; M: Int64; begin Result := 0; Code := 0; L := 0; Len := Length(S); if (Digits = 0) or (Digits > 16) then Digits := 16; if (Len >= 2) and (AnsiChar(S[1]) = '0') and CharInSetEx(S[2], ['x', 'X']) then I := 3 else if (Len >= 1) and CharInSetEx(S[1], ['x', 'X', '$']) then I := 2 else I := 1; while I <= Len do begin C := AnsiChar(S[I]); N := 255; DigitToNibble(C, N); if N > 15 then begin if CharInSetEx(C, ['h', 'H']) then begin if Len > I then Code := I + 1; end else Code := I; Break; end else if (N > 0) or (Result <> 0) then begin if L >= Digits then begin Code := I; Break; end; Result := Result shl 4; Inc(Result, N); Inc(L); end; Inc(I); end; if Signed and (Digits < 16) then begin M := Int64(1) shl (Digits shl 2); if Result >= M shr 1 - 1 then Dec(Result, M); end; end; function OctStrToInt(S: string; var Code: Integer): Int64; var I, Len: Integer; N: Byte; C: Char; Minus: Boolean; begin Result := 0; Code := 0; Len := Length(S); Minus := S[1] = '-'; if Minus then I := 2 else I := 1; while I <= Len do begin C := S[I]; N := 255; if (C >= '0') and (C <= '7') then N := Ord(C) - Ord('0'); if N > 7 then begin Code := I; Break; end else if (N > 0) or (Result <> 0) then begin Result := Result * 8; Inc(Result, N); end; Inc(I); end; if Minus then Result := -Result; end; function KFormat(const Format: string; const Args: array of const; const AFormatSettings: TFormatSettings): string; begin Result := SysUtils.Format(Format, Args, AFormatSettings); end; function KFormat(const Format: WideString; const Args: array of const; const AFormatSettings: TFormatSettings): WideString; begin Result := SysUtils.WideFormat(Format, Args, AFormatSettings); end; function MakeCellSpan(AColumns, ARows: Integer): TKCellSpan; begin Result.ColSpan := AColumns; Result.RowSpan := ARows; end; function MinMax(Value, Min, Max: ShortInt): ShortInt; begin if Max < Min then Exchange(Min, Max); if Value <= Max then if Value >= Min then Result := Value else Result := Min else Result := Max; end; function MinMax(Value, Min, Max: SmallInt): SmallInt; begin if Max < Min then Exchange(Min, Max); if Value <= Max then if Value >= Min then Result := Value else Result := Min else Result := Max; end; function MinMax(Value, Min, Max: Integer): Integer; begin if Max < Min then Exchange(Min, Max); if Value <= Max then if Value >= Min then Result := Value else Result := Min else Result := Max; end; function MinMax(Value, Min, Max: Int64): Int64; begin if Max < Min then Exchange(Min, Max); if Value <= Max then if Value >= Min then Result := Value else Result := Min else Result := Max; end; function MinMax(Value, Min, Max: Single): Single; begin if Max < Min then Exchange(Min, Max); if Value <= Max then if Value >= Min then Result := Value else Result := Min else Result := Max; end; function MinMax(Value, Min, Max: Double): Double; begin if Max < Min then Exchange(Min, Max); if Value <= Max then if Value >= Min then Result := Value else Result := Min else Result := Max; end; {$IFNDEF FPC} function MinMax(Value, Min, Max: Extended): Extended; begin if Max < Min then Exchange(Min, Max); if Value <= Max then if Value >= Min then Result := Value else Result := Min else Result := Max; end; {$ENDIF} function MakeDataSize(AData: Pointer; ASize: Integer): TDataSize; begin Result.Data := AData; Result.Size := ASize; end; function NibbleToDigit(Nibble: Byte; UpperCase: Boolean): AnsiChar; begin if Nibble < 10 then Result := AnsiChar(Ord('0') + Nibble) else if UpperCase then Result := AnsiChar(Ord('A') + Nibble - 10) else Result := AnsiChar(Ord('a') + Nibble - 10); end; procedure QuickSortNR(AData: Pointer; ACount: Integer; ACompareProc: TQsCompareProc; AExchangeProc: TQsExchangeProc; ASortedDown: Boolean); type TStackItem = record LIndex, RIndex: Integer; end; const cStackGrow = 100; var Key, Left, Right, L, R, LBack, RBack, StackLen, StackPtr: Integer; Stack: array of TStackItem; begin { this is the non recursive quick sort algorithm to avoid stack overflows. Right parts of divided arrays are stored into a stack-like array in dynamic memory for later use. } Left := 0; Right := ACount - 1; SetLength(Stack, cStackGrow); StackPtr := 0; with Stack[StackPtr] do begin LIndex := Left; RIndex := Right end; repeat with Stack[StackPtr] do begin Left := LIndex; Right := RIndex end; Dec(StackPtr); repeat L := Left; R := Right; Key := (L + R) div 2; LBack := Left - 1; RBack := Right; repeat if ASortedDown then begin while (L < Right) and (ACompareProc(AData, L, Key) < 0) do Inc(L); while (R > Left) and (ACompareProc(AData, R, Key) > 0) do Dec(R); end else begin while (L < Right) and (ACompareProc(AData, L, Key) > 0) do Inc(L); while (R > Left) and (ACompareProc(AData, R, Key) < 0) do Dec(R); end; if L <= R then begin if L < R then if (L = Key) or (R = Key) then begin // preserve Key, exchange later LBack := L; RBack := R; end else AExchangeProc(AData, L, R); Dec(R); Inc(L); end; until L >= R; // exchange anything with former Key if LBack >= Left then AExchangeProc(AData, LBack, RBack); if L < Right then begin Inc(StackPtr); StackLen := Length(Stack); if StackPtr >= StackLen then SetLength(Stack, StackLen + cStackGrow); with Stack[StackPtr] do begin LIndex := L; RIndex := Right end; end; Right := R; until Left >= Right; until StackPtr < 0; end; procedure QuickSort(AData: Pointer; ACount: Integer; ACompareProc: TQsCompareProc; AExchangeProc: TQsExchangeProc; ASortedDown: Boolean); procedure Sort(const Left, Right: Integer); var Key, L, R, LBack, RBack: Integer; begin Key := (Left + Right) div 2; L := Left; R := Right; LBack := Left - 1; RBack := Right; repeat if ASortedDown then begin while (L < Right) and (ACompareProc(AData, L, Key) < 0) do Inc(L); while (R > Left) and (ACompareProc(AData, R, Key) > 0) do Dec(R); end else begin while (L < Right) and (ACompareProc(AData, L, Key) > 0) do Inc(L); while (R > Left) and (ACompareProc(AData, R, Key) < 0) do Dec(R); end; if L <= R then begin if L < R then if (L = Key) or (R = Key) then begin // preserve Key, exchange later LBack := L; RBack := R; end else AExchangeProc(AData, L, R); Inc(L); Dec(R); end; until L >= R; // exchange anything with former Key if LBack >= Left then AExchangeProc(AData, LBack, RBack); if Left < R then Sort(Left, R); if L < Right then Sort(L, Right); end; begin if ACount > 1 then Sort(0, ACount - 1); end; procedure OffsetPoint(var APoint: TPoint; AX, AY: Integer); begin Inc(APoint.X, AX); Inc(APoint.Y, AY); end; procedure OffsetPoint(var APoint: TPoint; const AOffset: TPoint); begin Inc(APoint.X, AOffset.X); Inc(APoint.Y, AOffset.Y); end; function NormalizeRect(const ARect: TRect): TRect; begin Result := ARect; if Result.Left > Result.Right then Exchange(Result.Left, Result.Right); if Result.Top > Result.Bottom then Exchange(Result.Top, Result.Bottom); end; function Point64(AX, AY: Int64): TKPoint64; begin Result.X:= AX; Result.Y:= AY; end; function PointToPoint64(const APoint: TPoint): TKPoint64; begin Result.X:= APoint.x; Result.Y:= APoint.y; end; function Point64ToPoint(const APoint: TKPoint64): TPoint; begin Result.X:= Integer(APoint.X); Result.Y:= Integer(APoint.Y); end; function Pt64InRect(const ARect: TRect; const APoint: TKPoint64): Boolean; begin Result := (APoint.X >= ARect.Left) and (APoint.X < ARect.Right) and (APoint.Y >= ARect.Top) and (APoint.Y < ARect.Bottom); end; function Rect64(ALeft, ATop, ARight, ABottom: Int64): TKRect64; begin Result.Left:= ALeft; Result.Top:= ATop; Result.Right:= ARight; Result.Bottom:= ABottom; end; function RectInRect(Bounds, Rect: TRect): Boolean; begin Result := (Rect.Left < Bounds.Right) and (Rect.Right >= Bounds.Left) and (Rect.Top < Bounds.Bottom) and (Rect.Bottom >= Bounds.Top); end; function RectInRectFully(Bounds, Rect: TRect): Boolean; begin Result := (Rect.Left >= Bounds.Left) and (Rect.Right <= Bounds.Right) and (Rect.Top >= Bounds.Top) and (Rect.Bottom <= Bounds.Bottom); end; procedure OffsetRect(var ARect: TRect; AX, AY: Integer); begin Inc(ARect.Left, AX); Inc(ARect.Top, AY); Inc(ARect.Right, AX); Inc(ARect.Bottom, AY); end; procedure OffsetRect(var ARect: TRect; const AOffset: TPoint); begin Inc(ARect.Left, AOffset.X); Inc(ARect.Top, AOffset.Y); Inc(ARect.Right, AOffset.X); Inc(ARect.Bottom, AOffset.Y); end; procedure StripLastPathSlash(var APath: string); begin if APath <> '' then if CharInSetEx(APath[Length(APath)], ['\', '/']) then Delete(APath, Length(APath), 1); end; function StripLastPathSlashFnc(const APath: string): string; begin Result := APath; StripLastPathSlash(Result); end; function StrNextCharIndex(const AText: TKString; Index: Integer): Integer; begin {$IFDEF FPC} Result := Index + LazUTF8.UTF8CodepointSize(@AText[Index]); {$ELSE} if (Word(AText[Index]) >= cUTF16FirstSurrogateBegin) and (Word(AText[Index]) <= cUTF16FirstSurrogateEnd) then Result := Index + 2 else Result := Index + 1; {$ENDIF} end; function StrPreviousCharIndex(const AText: TKString; Index: Integer): Integer; begin {$IFDEF FPC} Result := Index - LazUTF8.UTF8CodepointSize(@AText[StringCharBegin(AText, Index - 1)]); {$ELSE} if (Word(AText[Index - 1]) >= cUTF16SecondSurrogateBegin) and (Word(AText[Index - 1]) <= cUTF16SecondSurrogateEnd) then Result := Index - 2 else Result := Index - 1; {$ENDIF} end; function StrByteIndexToCPIndex(const AText: TKString; ByteIndex: Integer): Integer; var I: Integer; begin Result := 0; I := 1; while I < ByteIndex do begin {$IFDEF FPC} Inc(I, LazUTF8.UTF8CodepointSize(@AText[I])); {$ELSE} if (Word(AText[I]) >= cUTF16FirstSurrogateBegin) or (Word(AText[I]) > cUTF16FirstSurrogateEnd) then Inc(I, 2) else Inc(I); {$ENDIF} Inc(Result); end; end; function StrCPIndexToByteIndex(const AText: TKString; CPIndex: Integer): Integer; var I: Integer; begin Result := 0; for I := 1 to CPIndex do begin {$IFDEF FPC} Inc(Result, LazUTF8.UTF8CodepointSize(@AText[Result])); {$ELSE} if (Word(AText[Result]) >= cUTF16FirstSurrogateBegin) and (Word(AText[Result]) <= cUTF16FirstSurrogateEnd) then Inc(Result, 2) else Inc(Result); {$ENDIF} if Result > Length(AText) then Break; end; end; function StringCharBegin(const AText: TKString; Index: Integer): Integer; begin {$IFDEF FPC} Result := LazUTF8.UTF8CodepointToByteIndex(PChar(AText), Length(AText), Index) {$ELSE} if (Word(AText[Index - 1]) >= cUTF16SecondSurrogateBegin) and (Word(AText[Index - 1]) <= cUTF16SecondSurrogateEnd) then Result := Index - 1 else Result := Index {$ENDIF} end; function StringLength(const AText: TKString): Integer; var I: Integer; begin {$IFDEF FPC} Result := LazUTF8.UTF8Length(AText) {$ELSE} Result := 0; for I := 1 to Length(AText) do if (Word(AText[I]) < cUTF16SecondSurrogateBegin) or (Word(AText[I]) > cUTF16SecondSurrogateEnd) then Inc(Result); {$ENDIF} end; function StringCopy(const ASource: TKString; At, Count: Integer): TKString; {$IFnDEF FPC} var ByteFrom, ByteTo: Integer; {$ENDIF} begin {$IFDEF FPC} Result := UTF8Copy(ASource, At, Count); {$ELSE} ByteFrom := StrCPIndexToByteIndex(ASource, At); ByteTo := StrCPIndexToByteIndex(ASource, At + Count); Result := Copy(ASource, ByteFrom, ByteTo - ByteFrom); {$ENDIF} end; procedure StringDelete(var ASource: TKString; At, Count: Integer); {$IFnDEF FPC} var ByteFrom, ByteTo: Integer; {$ENDIF} begin {$IFDEF FPC} LazUTF8.UTF8Delete(ASource, At, Count); {$ELSE} ByteFrom := StrCPIndexToByteIndex(ASource, At); ByteTo := StrCPIndexToByteIndex(ASource, At + Count); Delete(ASource, ByteFrom, ByteTo - ByteFrom); {$ENDIF} end; procedure TrimWhiteSpaces(const AText: TKString; var AStart, ALen: Integer; const ASet: TKSysCharSet); begin while (ALen > 0) and CharInSetEx(AText[AStart], ASet) do begin Inc(AStart); Dec(ALen); end; while (ALen > 0) and CharInSetEx(AText[AStart + ALen - 1], ASet) do Dec(ALen); end; procedure TrimWhiteSpaces(var AText: TKString; const ASet: TKSysCharSet); begin while (Length(AText) > 0) and CharInSetEx(AText[1], ASet) do Delete(AText, 1, 1); while (Length(AText) > 0) and CharInSetEx(AText[Length(AText)], ASet) do Delete(AText, Length(AText), 1); end; {$IFNDEF FPC} procedure TrimWhiteSpaces(var AText: AnsiString; const ASet: TKSysCharSet); begin while (Length(AText) > 0) and CharInSetEx(AText[1], ASet) do Delete(AText, 1, 1); while (Length(AText) > 0) and CharInSetEx(AText[Length(AText)], ASet) do Delete(AText, Length(AText), 1); end; {$ENDIF} function StringToAnsiString(const AText: TKString; CodePage: Cardinal): AnsiString; var {$IFDEF FPC} CP: string; {$ELSE} Len: Integer; W: WideString; DefaultChar: AnsiChar; {$ENDIF} begin {$IFDEF FPC} if CodePage = 0 then CP := 'ansi' else CP := Format('cp%d', [Codepage]); Result := LConvEncoding.ConvertEncoding(AText, 'utf8', CP); {$ELSE} if AText <> '' then begin DefaultChar := #0; W := WideString(AText); Len := WideCharToMultiByte(CodePage, 0, PWideChar(W), -1, nil, 0, @DefaultChar, nil); SetLength(Result, Len - 1); WideCharToMultiByte(CodePage, 0, PWideChar(W), -1, PAnsiChar(Result), Len, @DefaultChar, nil); end else Result := ''; {$ENDIF} end; function StringToUTF8(const AText: string): AnsiString; begin {$IFDEF FPC} Result := AText; {$ELSE} Result := UTF8Encode(AText); {$ENDIF} end; function StringToChar(const AText: TKString; AIndex: Integer): TKChar; begin {$IFDEF FPC} Result := LazUTF8.UTF8Copy(AText, AIndex, 1); {$ELSE} Result := AText[AIndex]; {$ENDIF} end; {$IFDEF MSWINDOWS} function GetWindowsFolder(CSIDL: Cardinal; var APath: string): Boolean; type TSHGetFolderPathProc = function(hWnd: HWND; CSIDL: Integer; hToken: THandle; dwFlags: DWORD; pszPath: PAnsiChar): HResult; stdcall; var SHFolderHandle: HMODULE; SHGetFolderPathProc: TSHGetFolderPathProc; Buffer: PAnsiChar; begin Result := False; APath := ''; SHFolderHandle := GetModuleHandle(SHFolderDll); if SHFolderHandle <> 0 then begin SHGetFolderPathProc := GetProcAddress(SHFolderHandle, 'SHGetFolderPathA'); if Assigned(SHGetFolderPathProc) then begin GetMem(Buffer, MAX_PATH); try if Succeeded(SHGetFolderPathProc(0, CSIDL, 0, 0, Buffer)) then begin APath := string(Buffer); Result := True; end finally FreeMem(Buffer); end; end; end; end; function RunExecutable(const AFileName: string; AWaitForIt: Boolean): DWORD; var StartupInfo: TStartupInfo; ProcessInfo: TProcessInformation; ErrMsg: PChar; begin Result := STILL_ACTIVE; GetStartupInfo(StartupInfo); if CreateProcess(nil, PChar(AFileName), nil, nil, IsConsole, NORMAL_PRIORITY_CLASS, nil, nil, StartupInfo, ProcessInfo) then begin try if (not AWaitForIt) or (WaitForSingleObject(ProcessInfo.hProcess,INFINITE) = WAIT_OBJECT_0) then GetExitCodeProcess(ProcessInfo.hProcess, Result); finally CloseHandle(ProcessInfo.hThread); CloseHandle(ProcessInfo.hProcess); end; end else begin if FormatMessage(Format_Message_Allocate_Buffer or Format_Message_From_System, nil, GetLastError, 0, @errMsg, 0, nil) <> 0 then begin try Error('CreateProcess failed with error "' + String (errMsg) + '".'); finally LocalFree (HLOCAL(errMsg)); end; end; end; end; {$ENDIF} function SystemCodePage: Integer; begin {$IFDEF MSWINDOWS} Result := getACP; {$ELSE} {$IF DEFINED(UNIX) and (FPC_FULLVERSION>=20701)} Result := GetSystemCodepage; {$ELSE} Result := 0; {$IFEND} {$ENDIF} end; function NativeUTFToUnicode(const AText: TKString): WideChar; {$IFDEF FPC} var CharLen: Integer; {$ENDIF} begin {$IFDEF FPC} Result := WideChar(LazUTF8.UTF8CodepointToUnicode(PChar(AText), CharLen)); {$ELSE} Result := AText[1]; {$ENDIF} end; function UnicodeUpperCase(const AText: TKString): TKString; begin {$IFDEF FPC} Result := LazUTF8.UTF8UpperCase(AText); {$ELSE} {$IFDEF STRING_IS_UNICODE} Result := AnsiUpperCase(AText); {$ELSE} Result := WideUpperCase(AText); {$ENDIF} {$ENDIF} end; function UnicodeLowerCase(const AText: TKString): TKString; begin {$IFDEF FPC} Result := LazUTF8.UTF8LowerCase(AText); {$ELSE} {$IFDEF STRING_IS_UNICODE} Result := AnsiLowerCase(AText); {$ELSE} Result := WideLowerCase(AText); {$ENDIF} {$ENDIF} end; function UnicodeToNativeUTF(const AParam: WideChar): TKString; begin {$IFDEF FPC} Result := LazUTF8.UnicodeToUTF8(Cardinal(AParam)); {$ELSE} Result := AParam; {$ENDIF} end; function UnicodeStringReplace(const AText, AOldPattern, ANewPattern: TKString; AFlags: TReplaceFlags): TKString; var SearchStr, Pattern, Candidate: TKString; I, NewI, PatternLen, SearchLen: Integer; DoInc, Found: Boolean; begin Result := ''; if rfIgnoreCase in AFlags then begin SearchStr := UnicodeUpperCase(AText); Pattern := UnicodeUpperCase(AOldPattern); end else begin SearchStr := AText; Pattern := AOldPattern; end; PatternLen := Length(Pattern); SearchLen := Length(SearchStr); Found := False; I := 1; while (I <= SearchLen) do begin DoInc := True; if (rfReplaceAll in AFlags) or not Found then begin if SearchStr[I] = Pattern[1] then begin Candidate := Copy(SearchStr, I, PatternLen); if Candidate = Pattern then begin Result := Result + ANewPattern; Inc(I, PatternLen); DoInc := False; Found := True; end; end; end; if DoInc then begin NewI := StrNextCharIndex(SearchStr, I); Result := Result + Copy(SearchStr, I, NewI - I); I := NewI; end; end; end; function UTF8ToString(const AText: AnsiString): string; begin {$IFDEF FPC} Result := AText; {$ELSE} {$IFDEF COMPILER12_UP} Result := System.UTF8ToString(AText); {$ELSE} Result := System.UTF8Decode(AText); {$ENDIF} {$ENDIF} end; function MakeHexDigitPosition(Index: Int64; Digit: Integer): TKHexDigitPosition; begin Result.Index := Index; Result.Digit := Digit; end; function DigitToBin(Value: AnsiChar): Integer; begin if ((Value >= 'a') and (Value <= 'f')) then Result := Ord(Value) - Ord('a') + 10 else if ((Value >= 'A') and (Value <= 'F')) then Result := Ord(Value) - Ord('A') + 10 else if ((Value >= '0') and (Value <= '9')) then Result := Ord(Value) - Ord('0') else Result := -1; end; function DigitsToBinStr(var S: AnsiString; Convert: Boolean = True): Boolean; var I, J, K: Integer; T: AnsiString; begin // check and convert text characters to hex values 0..15 Result := True; if Convert then SetLength(T, Length(S)); J := 0; for I := 1 to Length(S) do if not CharInSetEx(S[I], [cTAB, cSPACE]) then begin K := DigitToBin(S[I]); if K >= 0 then begin if Convert then begin Inc(J); T[J] := AnsiChar(K) end; end else begin Result := False; Break; end; end; if Result and Convert then begin SetLength(T, J); S := T; end; end; function BinStrToBinary(const S: AnsiString): AnsiString; var I, J, L: Integer; B1, B2: Byte; begin L := Length(S); Result := ''; if L > 0 then begin SetLength(Result, DivUp(L, 2)); if L = 1 then Result := S else begin J := 1; for I := 1 to Length(Result) do begin B1 := Byte(S[J]); Inc(J); if J <= L then begin B2 := Byte(S[J]); Inc(J); end else B2 := 0; Result[I] := AnsiChar(B1 shl 4 + B2); end; end; end; end; function BinToDigit(Value: Byte): AnsiChar; begin if Value >= $10 then Result := '0' else if Value >= $A then Result := AnsiChar(Ord('A') + Value - 10) else Result := AnsiChar(Ord('0') + Value) end; function BinaryToDigits(Buffer: PBytes; SelStart, SelEnd: TKHexDigitPosition; AInsertSpaces: Boolean): AnsiString; var I, J, SpaceCount: Integer; begin if AInsertSpaces then SpaceCount := SelEnd.Index - SelStart.Index else SpaceCount := 0; SetLength(Result, (SelEnd.Index - SelStart.Index) * cHexDigitCount - SelStart.Digit + SelEnd.Digit + SpaceCount); J := 1; for I := SelStart.Index to SelEnd.Index do begin if ((I > SelStart.Index) or (SelStart.Digit < 1)) and ((I < SelEnd.Index) or (SelEnd.Digit > 0)) then begin Result[J] := BinToDigit((Buffer[I] shr 4) and $F); Inc(J); end; if ((I > SelStart.Index) or (SelStart.Digit < 2)) and ((I < SelEnd.Index) or (SelEnd.Digit > 1)) then begin Result[J] := BinToDigit(Buffer[I] and $F); Inc(J); end; if AInsertSpaces and (I < SelEnd.Index) then begin Result[J] := ' '; Inc(J); end; end; end; function BinaryToDigits(Buffer: PBytes; ASize: Int64; AInsertSpaces: Boolean = False): AnsiString; begin Result := BinaryToDigits(Buffer, MakeHexDigitPosition(0, 0), MakeHexDigitPosition(ASize - 1, cHexDigitCount), AInsertSpaces); end; function BinaryToDigits(const Source: AnsiString; AInsertSpaces: Boolean): AnsiString; begin Result := BinaryToDigits(PBytes(@Source[1]), MakeHexDigitPosition(0, 0), MakeHexDigitPosition(Length(Source) - 1, cHexDigitCount), AInsertSpaces); end; function BinStrToDigits(const Source: AnsiString; AInsertSpaces: Boolean): AnsiString; var I, J, CharLen, SpaceCount: Integer; begin CharLen := Length(Source) div 2; if AInsertSpaces then SpaceCount := CharLen - 1 else SpaceCount := 0; SetLength(Result, CharLen * 2 + SpaceCount); J := 1; for I := 1 to CharLen do begin Result[J] := BinToDigit(Ord(Source[I * 2 - 1])); Inc(J); Result[J] := BinToDigit(Ord(Source[I * 2])); Inc(J); if AInsertSpaces and (I < CharLen) then begin Result[J] := ' '; Inc(J); end; end; end; function InsertSpacesToDigits(const Source: AnsiString): AnsiString; var I, J, CharLen, SpaceCount: Integer; begin CharLen := Length(Source) div 2; SpaceCount := CharLen - 1; SetLength(Result, CharLen * 2 + SpaceCount); J := 1; for I := 1 to CharLen do begin Result[J] := Source[I * 2 - 1]; Inc(J); Result[J] := Source[I * 2]; Inc(J); if I < CharLen then begin Result[J] := ' '; Inc(J); end; end; end; function ReplaceDigit(Value, Digit, Pos: Integer): Integer; var I, Mask, O: Integer; begin O := 1; for I := Pos to cHexDigitCount - 2 do O := O * cHexBase; Mask := cHexBase - 1; Result := (((Value div O) and not Mask) + (Digit and Mask)) * O + Value mod O; end; end. tomboy-ng_0.39-1/kcontrols/source/kcontrols.lrs0000644000175000017500000000410514346341266021507 0ustar dbannondbannonLazarusResources.Add('kpreview_cursor_hand_free','CUR',[ #0#0#2#0#1#0' '#0#0#15#0#15#0'0'#1#0#0#22#0#0#0'('#0#0#0' '#0#0#0'@'#0#0#0#1 +#0#1#0#0#0#0#0#128#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#255 +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#3#240#0 +#0#3#240#0#0#7#240#0#0#15#248#0#0#31#248#0#0#31#252#0#0'?'#252#0#0'w'#252#0#0 +'g'#254#0#0#7#246#0#0#13#182#0#0#13#178#0#0#25#176#0#0#25#176#0#0#1#128#0#0#0 +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255 +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 +#255#255#255#255#255#255#255#255#255#255#255#255#248#7#255#255#248#7#255#255 +#240#7#255#255#224#3#255#255#192#3#255#255#192#1#255#255#128#1#255#255#0#1 +#255#255#0#0#255#255#144#0#255#255#224#0#255#255#224#0#255#255#192#5#255#255 +#192#7#255#255#228#15#255#255#254#127#255#255#255#255#255#255#255#255#255#255 +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 +#255#255#255#255 ]); LazarusResources.Add('kpreview_cursor_hand_grip','CUR',[ #0#0#2#0#1#0' '#0#0#15#0#15#0'0'#1#0#0#22#0#0#0'('#0#0#0' '#0#0#0'@'#0#0#0#1 +#0#1#0#0#0#0#0#128#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#255 +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 +#0#0#0#0#0#0#0#0#7#224#0#0#7#224#0#0#15#224#0#0#31#240#0#0'?'#240#0#0'?'#248 +#0#0#15#248#0#0#15#248#0#0#31#232#0#0#27'`'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#255#255#255 +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 +#255#255#240#15#255#255#240#15#255#255#224#15#255#255#192#7#255#255#128#7#255 +#255#128#3#255#255#192#3#255#255#224#3#255#255#192#3#255#255#192#7#255#255 +#228#159#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 +#255#255#255#255#255 ]); tomboy-ng_0.39-1/kcontrols/source/kmessagebox.pas0000644000175000017500000003036314346341266021771 0ustar dbannondbannon{ @abstract(This file is part of the KControls component suite for Delphi and Lazarus.) @author(Tomas Krysl) Copyright (c) 2020 Tomas Krysl

License:
This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html. } unit kmessagebox; // lowercase name because of Lazarus/Linux {$include kcontrols.inc} {$WEAKPACKAGEUNIT ON} interface uses {$IFDEF FPC} LCLType, LCLIntf, LMessages, LCLProc, LResources, {$ELSE} Windows, Messages, {$ENDIF} Classes, Controls, Forms, KFunctions, KEdits {$IFDEF USE_THEMES} , Themes {$IFNDEF FPC} , UxTheme {$ENDIF} {$ENDIF} ; type TKMsgBoxButton = (mbYes, mbNo, mbOK, mbCancel, mbClose, mbAbort, mbRetry, mbIgnore, mbAll, mbNoToAll, mbYesToAll, mbHelp); TKMsgBoxIcon = (miNone, miInformation, miQuestion, miWarning, miStop); function CreateMsgBox(const Caption, Text: string; const Buttons: array of TKMsgBoxButton; Icon: TKMsgBoxIcon = miNone; Def: integer = 0): TCustomForm; function CreateMsgBoxEx(const Caption, Text: string; const Btns: array of string; Icon: TKMsgBoxIcon = miNone; Def: integer = 0): TCustomForm; procedure FreeMsgBox(AMsgBox: TCustomForm); function KMsgBox(const Caption, Text: string; const Buttons: array of TKMsgBoxButton; Icon: TKMsgBoxIcon = miNone; Def: integer = 0): integer; function KMsgBoxEx(const Caption, Text: string; const Buttons: array of string; Icon: TKMsgBoxIcon = miNone; Def: integer = 0): integer; function KInputBox(const Caption, Prompt: string; var Text: string): TModalResult; function KNumberInputBox(const ACaption, APrompt: string; var AValue: double; AMin, AMax: double; AFormats: TKNumberEditAcceptedFormats = [neafDec]): TModalResult; //Win32 API message box type TKMsgBoxButtons = (mbAbortRetryIgnore, mbOkOnly, mbOkCancel, mbRetryCancel, mbYesNo, mbYesNoCancel); function MsgBox(const Caption, Text: string; const Buttons: TKMsgBoxButtons; Icon: TKMsgBoxIcon = miNone): integer; function AppMsgBox(const Caption, Text: string; Flags: integer): integer; implementation uses Math, StdCtrls, ExtCtrls, SysUtils, KGraphics, KControls, KRes; type TMsgBoxForm = class(TCustomForm) private FCloseResult: integer; procedure SetCloseResult(const Value: integer); procedure WMCloseQuery(var M: TLMessage); message LM_CLOSEQUERY; protected public constructor Create(AOwner: TComponent); override; property CloseResult: integer read FCloseResult write SetCloseResult; end; function StdButtons(ButtonType: TKMsgBoxButton): string; begin case ButtonType of mbYes: Result := sMsgBoxYes; mbNo: Result := sMsgBoxNo; mbOK: Result := sMsgBoxOk; mbCancel: Result := sMsgBoxCancel; mbClose: Result := sMsgBoxClose; mbAbort: Result := sMsgBoxAbort; mbRetry: Result := sMsgBoxRetry; mbIgnore: Result := sMsgBoxIgnore; mbAll: Result := sMsgBoxAll; mbNoToAll: Result := sMsgBoxNoToAll; mbYesToAll: Result := sMsgBoxYesToAll; mbHelp: Result := sMsgBoxHelp; end; end; { TMsgBoxForm } constructor TMsgBoxForm.Create(AOwner: TComponent); begin GlobalNameSpace.BeginWrite; try CreateNew(AOwner); finally GlobalNameSpace.EndWrite; end; end; procedure TMsgBoxForm.SetCloseResult(const Value: integer); begin FCloseResult := Value; end; procedure TMsgBoxForm.WMCloseQuery(var M: TLMessage); begin // we need new behavior here ModalResult := FCloseResult; end; function CreateMsgBox(const Caption, Text: string; const Buttons: array of TKMsgBoxButton; Icon: TKMsgBoxIcon = miNone; Def: integer = 0): TCustomForm; var Btns: array of string; I: integer; begin SetLength(Btns, Length(Buttons)); for I := 0 to High(Buttons) do Btns[I] := StdButtons(Buttons[I]); Result := CreateMsgBoxEx(Caption, Text, Btns, Icon, Def); Btns := nil; end; function CreateMsgBoxEx(const Caption, Text: string; const Btns: array of string; Icon: TKMsgBoxIcon = miNone; Def: integer = 0): TCustomForm; function FindBtn(const ACaption: string): integer; var I: integer; begin Result := -1; for I := Low(Btns) to High(Btns) do if Btns[I] = ACaption then begin Result := I; Exit; end; end; var F: TMsgBoxForm; B: TButton; La: TLabel; TB: TKTextBox; I, L, L1, L2, W, H, H1: integer; ICancel, INo: integer; IsCancel, IsFirstBtn: boolean; {$IFDEF USE_PNG_SUPPORT} Png: TKPngImage; Im: TImage; S: string; {$ENDIF} begin F := TMsgBoxForm.Create(Application); try IsFirstBtn := True; IsCancel := False; F.BorderStyle := bsDialog; F.Position := poScreenCenter; F.Caption := Caption; La := TLabel.Create(F); TB := TKTextBox.Create; try TB.Text := Text; TB.Attributes := [taLineBreak]; TB.Measure(F.Canvas, CreateEmptyRect, W, H); finally TB.Free; end; La.Caption := Text; La.AutoSize := False; La.Width := W + 20; La.Height := H + 10; La.Parent := F; L := 20; H1 := 0; {$IFDEF USE_PNG_SUPPORT} if Icon <> miNone then begin Im := TImage.Create(F); Png := TKPngImage.Create; try case Icon of miInformation: S := 'KMESSAGEBOX_INFO'; miQuestion: S := 'KMESSAGEBOX_QUESTION'; miWarning: S := 'KMESSAGEBOX_WARNING'; miStop: S := 'KMESSAGEBOX_STOP'; end; {$IFDEF FPC} Png.LoadFromLazarusResource(S); {$ELSE} Png.LoadFromResourceName(HInstance, S); {$ENDIF} Im.Picture.Assign(Png); Im.Width := Png.Width; Im.Height := Png.Height; finally Png.Free; end; Im.Transparent := True; Im.Parent := F; Im.Left := L; Inc(L, Im.Width + 15); H1 := Im.Height; Im.Top := 15 + Max(0, (La.Height - H1) div 2); end; {$ENDIF} La.Left := L; La.Top := 15 + Max(0, (H1 - La.Height) div 2); L1 := 20; for I := Low(Btns) to High(Btns) do Inc(L1, Max(F.Canvas.TextWidth(Btns[I]) + 30, 90)); Dec(L1, 10); L2 := L + LA.Width; H1 := 30 + Max(La.Height, H1); H := H1; if L2 > L1 then L := (L2 - L1) div 2 else L := 0; Inc(L, 20); ICancel := FindBtn(sMsgBoxCancel); INo := FindBtn(sMsgBoxNo); for I := Low(Btns) to High(Btns) do begin W := Max(F.Canvas.TextWidth(Btns[I]) + 20, 80); B := TButton.Create(F); B.Parent := F; B.Caption := Btns[I]; B.Left := L; B.Top := H; B.Width := W; if IsFirstBtn then begin Inc(H1, B.Height); IsFirstBtn := False; end; if Def = I then F.ActiveControl := B; if not IsCancel and ((Length(Btns) = 1) or (ICancel = I) or (INo = I) and (ICancel < 0)) then begin B.Cancel := True; F.CloseResult := I + 1; IsCancel := True; end; B.ModalResult := TModalResult(I + 1); Inc(L, W + 10); end; F.ClientWidth := Max(L1, L2) + 20; F.ClientHeight := H1 + 15; {$IFNDEF FPC} // this just disables the cancel box in system menu, not absolutely needed if not IsCancel then EnableMenuItem(GetSystemMenu(F.Handle, False), SC_CLOSE, MF_DISABLED); {$ENDIF} except FreeAndNil(F); end; Result := TCustomForm(F); end; procedure FreeMsgBox(AMsgBox: TCustomForm); begin AMsgBox.Free; end; function KMsgBox(const Caption, Text: string; const Buttons: array of TKMsgBoxButton; Icon: TKMsgBoxIcon = miNone; Def: integer = 0): integer; var F: TCustomForm; begin F := CreateMsgBox(Caption, Text, Buttons, Icon, Def); try if F <> nil then begin DPIScaleControl(F); Result := F.ShowModal end else Result := -1; finally F.Free; end; end; function KMsgBoxEx(const Caption, Text: string; const Buttons: array of string; Icon: TKMsgBoxIcon = miNone; Def: integer = 0): integer; var F: TCustomForm; begin F := CreateMsgBoxEx(Caption, Text, Buttons, Icon, Def); try if F <> nil then Result := F.ShowModal else Result := -1; finally F.Free; end; end; function KInputBox(const Caption, Prompt: string; var Text: string): TModalResult; var F: TForm; L: TLabel; E: TEdit; BUOk, BUCancel: TButton; W, I: integer; begin F := TForm.Create(Application); if F <> nil then begin F.Caption := Caption; F.BorderStyle := bsDialog; F.Position := poScreenCenter; L := TLabel.Create(F); L.Parent := F; E := TEdit.Create(F); E.Parent := F; BUOk := TButton.Create(F); BUOk.Parent := F; BUCancel := TButton.Create(F); BUCancel.Parent := F; try L.Caption := Prompt; W := Max(160, L.Canvas.TextWidth(Prompt)); F.Width := W + 60; F.Height := 140; I := (F.Width - F.ClientWidth) div 2; L.Left := 30 - I; L.Top := 15; L.FocusControl := E; E.Left := L.Left; E.Top := L.Top + 18; E.Width := Min(160, W); E.Text := Text; BUOk.Left := (F.Width - BUOk.Width - BUCancel.Width - 10) div 2 - I; BUOk.Top := E.Top + 35; BUOk.Caption := sMsgBoxOK; BUOk.Default := True; BUOk.ModalResult := mrOk; BUCancel.Left := BUOk.Left + BUOk.Width + 10; BUCancel.Top := BUOk.Top; BUCancel.Caption := sMsgBoxCancel; BUCancel.Cancel := True; BUCancel.ModalResult := mrCancel; CenterWindowOnScreen(F.Handle); Result := F.ShowModal; if Result = mrOk then Text := E.Text; finally F.Free; end; end else Result := mrCancel; end; function KNumberInputBox(const ACaption, APrompt: string; var AValue: double; AMin, AMax: double; AFormats: TKNumberEditAcceptedFormats = [neafDec]): TModalResult; var F: TForm; L: TLabel; E: TKNumberEdit; BUOk, BUCancel: TButton; W, I: integer; begin F := TForm.Create(Application); if F <> nil then begin F.Caption := ACaption; F.BorderStyle := bsDialog; L := TLabel.Create(F); L.Parent := F; E := TKNumberEdit.Create(F); E.Parent := F; BUOk := TButton.Create(F); BUOk.Parent := F; BUCancel := TButton.Create(F); BUCancel.Parent := F; try L.Caption := APrompt; W := Max(160, L.Canvas.TextWidth(APrompt)); F.Width := W + 60; F.Height := 140; I := (F.Width - F.ClientWidth) div 2; L.Left := 30 - I; L.Top := 15; L.FocusControl := E; E.Left := L.Left; E.Top := L.Top + 18; E.Width := Min(160, W); E.Options := E.Options - [neoUseUpDown, neoUseLabel]; E.AcceptedFormats := AFormats; E.Value := AValue; E.Min := AMin; E.Max := AMax; BUOk.Left := (F.Width - BUOk.Width - BUCancel.Width - 10) div 2 - I; BUOk.Top := E.Top + 35; BUOk.Caption := sMsgBoxOK; BUOk.Default := True; BUOk.ModalResult := mrOk; BUCancel.Left := BUOk.Left + BUOk.Width + 10; BUCancel.Top := BUOk.Top; BUCancel.Caption := sMsgBoxCancel; BUCancel.Cancel := True; BUCancel.ModalResult := mrCancel; CenterWindowOnScreen(F.Handle); Result := F.ShowModal; if Result = mrOk then AValue := E.Value; finally F.Free; end; end else Result := mrCancel; end; function MsgBox(const Caption, Text: string; const Buttons: TKMsgBoxButtons; Icon: TKMsgBoxIcon): integer; const WinButtons: array[TKMsgBoxButtons] of integer = (MB_ABORTRETRYIGNORE, MB_OK, MB_OKCANCEL, MB_RETRYCANCEL, MB_YESNO, MB_YESNOCANCEL); WinIcon: array[TKMsgBoxIcon] of integer = (0, MB_ICONINFORMATION, MB_ICONQUESTION, MB_ICONEXCLAMATION, MB_ICONSTOP); begin Result := MessageBox(Application.MainForm.Handle, PChar(Text), PChar(Caption), WinButtons[Buttons] or WinIcon[Icon]); end; function AppMsgBox(const Caption, Text: string; Flags: integer): integer; begin Result := Application.MessageBox(PChar(Text), PChar(Caption), Flags); end; {$IFDEF FPC} initialization {$i kmessagebox.lrs} {$ELSE} {$R kmessagebox.res} {$ENDIF} end. tomboy-ng_0.39-1/kcontrols/source/kmessagebox.res0000644000175000017500000003612414346341266022000 0ustar dbannondbannon @ KMESSAGEBOX_STOP0PNG  IHDR00WkIDATh}?9{}a‚"J)Ԥ6iim-mim*hZ4Z[iS"M5%(^^Teua}sv{gws.\;ɓ9/3s>~G%͵BB! RJLf̘A84MLDJYy&d2y<m{GK3hnnUU4440cƌܹ-۷ooJ3xW7!?~dܹyX7?{񔗣(~?ȱ7iteW^U(H)9<]]]W._{% '_]vTTT_d H4D|t׋OYc$쳔١!L]ߧbzR$ Ν;nڴi#ʏ]v\,Yɧ?'-HU^lQ^Ju2}} *x}!Du:;;9?z"qUv1sK.0 2(]K҆=k9ADi$;;Qgbs!B!>S:;;hjjx-<؈a <ɉ\YB\//!%spݻ,Z `Fef߿mRxW7TVV>|r <kOee41P9޳RZmn5ϴ@UU:ڭBy9PL&S___?z詉HK?VXdFóz5% j_II)`?~ĩ6}[hЄkn?tŻwSr cy!ldKX,=vڟlߏOHaʔ)'2@0;w3?|rLӤ`ӧ_3_4Mj =<.a:,hE(1ءCcr@CQg I&5'O>sɳ@v\[͛:y̙f a:\Pg_?3gR3 H$r.f=xߔ);at]oqOAk˖-4M>پxa+A]{0 rDV`УQ 7s&ӷo'JN f-//';((B L\&lh2::ZJtuu9QPEy6uR9uqu]ϓȪ*SmW['dHs\޲,t*׮D"aA(n;V:YoD&8~L-0'୩aOKIRd24DD"o~h4oz4L*eeeB[R 677,Xa|!-޴ L;R7pǻ % ڞu4QǃQZZʬjھMRgX@'0 TUE4B(B?OY)IttԄL&wNfN*"JxH~TK@Qh.*%%%TE1# "$YMZtX fryMJi^/@ ȶ^49S&`&#G}[:dz{ M̽2(4 MPU5o0Mx5ґ}VZZP.`0Xmz @O\9}to/4Bim?gvHy:?1ٳc^VqQ(\UEP4lyϤ!}U!R+#LUUfQ@pq xs~Pq.rR׹bw>"o9scq -bΞ=UsaPL#+W"u}Ȃ,~mb,lepʧOQR2 ǃiB)E׷bEZ[[;֍ 3JH))[z !Xg 2x A|&F7oDae-&L&I$ǏL]XWQ#uϴivtzuFS+Wlj2R]]|"|FMTNj/Z2(-e҆ η6mZAsF" #/ˏފ޻o~3i7nD Q.= ~{y%뮻h6+&zo︐_޻@Ue,-yaֻ} y'2RFw]zPn# wm7`vsT< sygť~l,FϷ7 DmS˝VSq Xn;eUʋ/B(D<ȑ#g}Ç.Qn ȧ~˿jkkCuKJ>_w >sỈ(O[['Nxg! /}kqϝ4iedyi͊#fXKf3ClۆRW>裃[lyq-jMD|뭷ZtirNyyEb?F Xmg$an:łO?m>S%,xj$߿:[p8Y 1Z[v5) k/ '"BQza:u} rp&ۿK,JKJJ4 Q_rHMNO # {//z!H$p8pt:B! yWcTW[H1\BoGw45.YzBpZZZSSSXxl*Pr=DEEŊɓ';;(ݨ Zkk,J[5s\x/C.c%s 2FƍmB #H[0at&app!GGyeǎ1R9̗Zt+W]lنP(tK !  RK:fttD"FOݻwѣGaR|Xĥu555&MT_RRr] vFbEQfTjҥKg[[[;;mM0ۤUUV}E|4ܖxE1 c_mH?eIENDB`cH KMESSAGEBOX_QUESTION0PNG  IHDR00W*IDAThyl}?ｙ{I(JdIBZY W@m+Hmu[M A&E5l SH|nR[%[2):(K$E}.qf~w >6ɇj.؉_DBEPZ^pxs<4}~+OYx(O>f?l&ӚRzJ5Jǩ?xr/ 81 V߰nU+p=bե\7}h4`*0 0h-(,Kʥs]S_QC؀߿WHuߦ#o#0/\/xn߮9 mv\( 3NmS+1`|߃h}@;628Lpt.YIA 7,,Ѭ-x;/w9|/n޸=l&'뜾hzA=k0.b@{ 4=}0I&CKs[sgV5`=n۹}:/ؼ5Qb]MqjdʘA8ZA!oZկgUO E#;7dssެO2l ֙(W]~N5RD@HT8 ̉_xj ..o@7Uf}]&_(A5Zg|Gy~e Dx?$vJp/)t۱-yoMyᶛVm=CۀlJƮ([so{. =4n{G~|drh B$#ѿXK'СD!}w\Eytc)pk^a<}FƗkn˺$?H2gݞHe" _xgq)= -۷qff. @ߒٷ(V\ה*_mvz}/YR #L@#$H/b+Gbw{A:f c+94YToQJPyL:2+,R9OȮ-F D5rʥF2 ` hR)틅`k/1,>:LfM^=ZϿ3͛'jA2!l Iz#?YdזTLjmL,il~4S6S3>THf<2R>Y|d#HafdGwV%)z`8=Q+ 7hw}M)<.l:לPs@RE{M0< ]2 lawsiUtR /zA"l=MJ_}ne(w3 0 D~t !wg)ռ+54Z,qs_K. .\!7RuáF +=`@FJVA!8x44lYkuH'?t R$ ٪k Rh !`RȤ_t.~SixmŦU^rULGϻd+E!HFoSh45l|M:`Zƪfh>{}.ug~^?ިN h1#-R!4)̴<"[Q44lB 2hgcxϦU&w|fxIxk7+з*Pk:bCBPR`:2P@>P,T^q._~iZC\"7@Az Z`^5оwTłC A;$m4[XOvH?|ل|t.@Cg@PpCךE G's1ٽ%Zl{&>3}GX PB:_"~|ߩ <>R(0]q\;h@+5L]p1)J+Rbs +r8`^)I:!7B 6jMTqL#jq)b3<[\Y @G蔒_NjMfDY~\u81;[bI;=UJ8ovG !gi e# 4W}SvT%)Xt$HHydJ)̤J)R9tIf.ZDqm: $RzG:JnZFC%ҩ} :Ҡ͈6=CRy&0PF \S;P =G&ѵB-B Q\_tY+ ]߾OVBkF~كrg3y.V/2ZK'8<]Uê<@6)4*^{y +%PF(pHrT.yScN?{CFjpMOV檭4M)A';]k]Tm85H@6UdJ*/tr#7Qxl xkϿ[I~Le29${~j3˅&ԥ$İT%nu~tW^:q;jMv] _~aƷ+?Όl}BQ8= Ne\1#\JaP24??ȡ7N?p Ǧc/y7ATMCK#XIa.c{Ȏ~?81/&Lbcء'&7F/ z@f}~kw sňodP%(p*>0%}i`NK t sKߎf{mfzp\(3MR@k7STڥ♉ެ-q(6U/`CИ$d8(IxZFo/w; =IENDB`D KMESSAGEBOX_WARNING0PNG  IHDR00WgAMA|Q cHRMz%u0`:oSIDATxb?P8=@L }b`gɌ~ 1fdz&T@ ~S@F?{v՟o_7K,=@`_z? O \bgDM SSy c` %]TQȬ(F-@~a/Oz=__3}cP`$&p_@$oN=8y3|P :: CwyӬ ΰ2dt| `$ $"1O/rI`A#O?@G3=*q3؏_2ĸe 0] o1{MK,}&\om'&~CQ^zq0#23i~eP1,uK`y 2|l2ë4/ A@ ZPX21.Ŭ3HXaѭMeOD4sL<g`8 ,lA!f9i_A ≮uoBr3|g0pAVK-;2)~Ơwzh?#},, Gq2ܸ &]O*RB]^jb&-Mԋ=-} &ïp: |bțpo?0qd 03v8$s`|ph+'oL oT,n|UkR@c~ñ8ya)`TC&_f`dͰ8;++#-Xc%!a3\>p hGO SX#j1c l3Q_^9`XKÿ3T13reȞͰn?'Tb`p4ɰXW|dF @~bbس;&=`b$i C\*@8* f`vWʷ=dxAA+- zqobz|,.;9r0!;7J9k 'r{u=^34ճ7jb2 пߘ߫} f0ixĠWb)_0g8Fa'xPg4$nm`x|AE+w.̂@1||I `A+_C=$39cAUW!jBP,||İk#fd06Ġk>#GH,@- `aV.;ssJ?RAiFhFeb)]>0ىqɏv 6! NftVYȭUbo|z=])_~.24d#'oO`K22 , π5UFFHp`k`W.,7&>{ It^ ~p `Ի`h/&F7#j3\֟gdh  %Q_~3|~ edbafWXNeWtN$3s8LLF3@1QSc8wg aAjO,?_  0, ?2H1| FF$>X|&UKQ?zpN /px%L,*xHM1 #0$Bdę?߷{ɽcw=]m@EL7hٚt~ !cR* A}#4:3&b@õ7&pr +!`M}YANhL~Ю'*B'<51>+o~ 1{XWDJ+]lR6>cX؞/׀|1٠x}tjH(ꓬq$}] 誵 43d S@`:4qIdnF* Ca} F2pMm7/jMFTi{F!]`a`Tמ77mśAfqr~r[S;B@27ݭFkhLK;x_.*z,$"a( 3S>~EԤ^vޕ p=W]0~W]Mr{230Lced,\e),K0-8hh8*mkoז9Ϝ[Y|~_t3ŋHo'e ۧޑI1~#Wا +ZUYuvŮݟioN/]:NkxYD,LYe̠H8x^fo୪?`(U?_#=IENDB`tomboy-ng_0.39-1/kcontrols/source/kdialogs.pas0000644000175000017500000003516514346341266021263 0ustar dbannondbannon{ @abstract(This file is part of the KControls component suite for Delphi and Lazarus.) @author(Tomas Krysl) Copyright (c) 2020 Tomas Krysl

License:
This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html. } unit kdialogs; // lowercase name because of Lazarus/Linux {$include kcontrols.inc} {$WEAKPACKAGEUNIT ON} interface uses Classes, Controls, Forms, SysUtils, KFunctions, KControls, KPrintPreview, KPrintSetup; type { Specifies the root folder for TKBrowseFolderDialog dialog - RootFolder property. } TKRootFolder = (brAdminTools, brAltStartUp, brAppData, brBitBucket, brCommonAdminTools, brCommonAltStartUp, brCommonAppData, brCommonDesktopDirectory, brCommonDocuments, brCommonFavorites, brCommonPrograms, brCommonStartMenu, brCommonStartUp, brCommonTemplates, brControls, brCookies, brDesktop, brDesktopDirectory, brDrives, brFavorites, brFonts, brHistory, brInternet, brInternetCache, brLocalAppData, brMyMusic, brMyPictures, brNetHood, brNetWork, brPersonal, brPrinters, brPrintHood, brProfile, brProgramFiles, brProgramFilesCommon, brPrograms, brRecent, brSendTo, brStartMenu, brStartUp, brSystem, brTemplates, brWindows, brCustom); TFolder = type string; { Specifies the folder options for TKBrowseFolderDialog dialog - Options property. } TKBrowseFolderOption = (bfSetFolder, bfBrowseForComputer, bfBrowseForPrinter, bfBrowseIncludeFiles, bfBrowseIncludeURLs, bfDontGoBelowDomain, bfEditBox, bfNewDialogStyle, bfReturnFSAncestors, bfReturnOnlyFSDirs, bfShareAble, bfStatusText, bfUseNewUI, bfValidate); TKBrowseFolderOptions = set of TKBrowseFolderOption; { Specifies the initial position for TKBrowseFolderDialog dialog - Position property. } TKBrowseFolderPosition = (poDefault, poScreenCenter, poCustom); { @abstract(Encapsulates the print preview dialog) } TKPrintPreviewDialog = class(TComponent) private FControl: TKCustomControl; FPrintPreviewForm: TKPrintPreviewForm; function GetPrintPreviewForm: TKPrintPreviewForm; public { Creates the instance. Assigns default values to properties. } constructor Create(AOwner: TComponent); override; { Shows the dialog. } procedure Show; { Shows the dialog as modal dialog. } function Execute: Boolean; { Specifies the associated preview form. } property PrintPreviewForm: TKPrintPreviewForm read GetPrintPreviewForm; published { Specifies the associated control. } property Control: TKCustomControl read FControl write FControl; end; { @abstract(Encapsulates the print preview dialog) } TKPrintSetupDialog = class(TComponent) private FControl: TKCustomControl; FPreviewDialog: TKPrintPreviewDialog; FSelAvail: Boolean; protected FPrintSetupForm: TKPrintSetupForm; procedure SetupForm(AfterCreation: Boolean); virtual; public { Creates the instance. Assigns default values to properties. } constructor Create(AOwner: TComponent); override; { Shows the dialog as modal dialog. } function Execute: Boolean; published { Specifies the associated control. } property Control: TKCustomControl read FControl write FControl; { Specifies the preview dialog for the Preview... button. If not specified, the print setup dialog creates a new one. } property PreviewDialog: TKPrintPreviewDialog read FPreviewDialog write FPreviewDialog; { If True, the Selection Only option will be checked (if selection is available for the control). } property SelAvail: Boolean read FSelAvail write FSelAvail default True; end; { @abstract(Encapsulates the browse for folder dialog - Windows only) } TKBrowseFolderDialog = class(TComponent) private FParentWindow: TWinControl; FFolder: TFolder; FLabelText: string; FPosition: TKBrowseFolderPosition; FCustomRootFolder: TFolder; FOptions: TKBrowseFolderOptions; FRootFolder: TKRootFolder; FCustomLeft, FCustomTop: Integer; procedure SetFolder(const Value: TFolder); public { Creates the instance. Assigns default values to properties. } constructor Create(AOwner: TComponent); override; { Shows the dialog as modal dialog. } function Execute: Boolean; property LabelText: string read FLabelText write FLabelText; published property CustomRootFolder: TFolder read FCustomRootFolder write FCustomRootFolder; property Folder: TFolder read FFolder write SetFolder; property Options: TKBrowseFolderOptions read FOptions write FOptions; property ParentWindow: TWinControl read FParentWindow write FParentWindow; property Position: TKBrowseFolderPosition read FPosition write FPosition default poScreenCenter; property RootFolder: TKRootFolder read FRootFolder write FRootFolder; property CustomLeft: Integer index 1 read FCustomLeft write FCustomLeft default 100; property CustomTop: Integer index 2 read FCustomTop write FCustomTop default 100; end; implementation uses KRes {$IFDEF MSWINDOWS} , ActiveX, ShlObj, Windows, Messages {$ENDIF} ; {$IFDEF MSWINDOWS} const {Common Controls version 5.O extensions} BIF_BROWSEINCLUDEURLS = $0080; BIF_NEWDIALOGSTYLE = $0040; BIF_SHAREABLE = $8000; BIF_USENEWUI = BIF_NEWDIALOGSTYLE + BIF_EDITBOX; CSIDL_FLAG_CREATE = $8000; CSIDL_ADMINTOOLS = $0030; CSIDL_COMMON_ADMINTOOLS = $002F; CSIDL_COMMON_APPDATA = $0023; CSIDL_COMMON_DOCUMENTS = $002E; CSIDL_LOCAL_APPDATA = $001C; CSIDL_MYMUSIC = $0028; CSIDL_MYPICTURES = $0027; CSIDL_PROGRAM_FILES = $0026; CSIDL_PROGRAM_FILES_COMMON = $002B; CSIDL_SYSTEM = $0025; CSIDL_WINDOWS = $0024; {$IFDEF FPC} // message from browser BFFM_INITIALIZED = 1; BFFM_SELCHANGED = 2; BFFM_VALIDATEFAILEDA = 3; // lParam:szPath ret:1(cont),0(EndDialog) BFFM_VALIDATEFAILEDW = 4; // lParam:wzPath ret:1(cont),0(EndDialog) BFFM_IUNKNOWN = 5; // provides IUnknown to client. lParam: IUnknown* // messages to browser BFFM_SETSTATUSTEXTA = WM_USER + 100; BFFM_ENABLEOK = WM_USER + 101; BFFM_SETSELECTIONA = WM_USER + 102; BFFM_SETSELECTIONW = WM_USER + 103; BFFM_SETSTATUSTEXTW = WM_USER + 104; BFFM_SETOKTEXT = WM_USER + 105; // Unicode only BFFM_SETEXPANDED = WM_USER + 106; // Unicode only {$IFDEF UNICODE} BFFM_VALIDATEFAILED = BFFM_VALIDATEFAILEDW; BFFM_SETSTATUSTEXT = BFFM_SETSTATUSTEXTW; BFFM_SETSELECTION = BFFM_SETSELECTIONW; {$ELSE} BFFM_VALIDATEFAILED = BFFM_VALIDATEFAILEDA; BFFM_SETSTATUSTEXT = BFFM_SETSTATUSTEXTA; BFFM_SETSELECTION = BFFM_SETSELECTIONA; {$ENDIF} {$ENDIF} {$ENDIF} { TKPrintPreviewDialog } constructor TKPrintPreviewDialog.Create(AOwner: TComponent); begin inherited; FPrintPreviewForm := nil; FControl := nil; end; function TKPrintPreviewDialog.Execute; begin PrintPreviewForm.Preview.Control := FControl; PrintPreviewForm.ShowModal; Result := True; end; function TKPrintPreviewDialog.GetPrintPreviewForm: TKPrintPreviewForm; begin if not Assigned(FPrintPreviewForm) then FPrintPreviewForm := TKPrintPreviewForm.Create(Self); Result := FPrintPreviewForm; end; procedure TKPrintPreviewDialog.Show; begin PrintPreviewForm.Preview.Control := FControl; PrintPreviewForm.Show; end; { TKPrintSetupDialog } constructor TKPrintSetupDialog.Create(AOwner: TComponent); begin inherited; FControl := nil; FPrintSetupForm := nil; FPreviewDialog := nil; FSelAvail := True; end; function TKPrintSetupDialog.Execute: Boolean; begin if Assigned(FControl) then begin if not Assigned(FPrintSetupForm) then begin FPrintSetupForm := TKPrintSetupForm.Create(Self); SetupForm(True); end; FPrintSetupForm.PageSetup := FControl.PageSetup; if Assigned(FPreviewDialog) then FPrintSetupForm.PreviewForm := FPreviewDialog.PrintPreviewForm; SetupForm(False); Result := FPrintSetupForm.ShowModal = mrOk; end else Result := False; end; procedure TKPrintSetupDialog.SetupForm(AfterCreation: Boolean); begin if not AfterCreation then FPrintSetupForm.SelAvail := FSelAvail; end; { TKBrowseFolderDialog } {$IFDEF MSWINDOWS} function BFCallBack(Wnd: HWND; uMsg: UINT; lPar, lpData: LPARAM): Integer stdcall; var Allocator: IMalloc; Location: PItemIDList; begin with TKBrowseFolderDialog(lpData) do try if uMsg = BFFM_INITIALIZED then begin if (bfSetFolder in Options) and (Folder <> '') then SendMessage(Wnd, BFFM_SETSELECTION, Integer(TRUE), LPARAM(PChar(Folder))) else begin SHGetMAlloc(Allocator); try SHGetSpecialFolderLocation(Application.MainForm.Handle, CSIDL_DRIVES, Location); SendMessage(Wnd, BFFM_SETSELECTION, Integer(FALSE), LPARAM(Location)); finally Allocator.Free(Location); end; end; case Position of poScreenCenter: CenterWindowOnScreen(Wnd); poCustom: SetWindowPos(Wnd, 0, CustomLeft, CustomTop, 0, 0, SWP_NOSIZE or SWP_NOZORDER); end; end; except end; Result := 0; end; {$ENDIF} constructor TKBrowseFolderDialog.Create(AOwner: TComponent); begin inherited; FParentWindow := nil; FFolder := ''; FLabelText := sBrowseDirectory; FOptions := [bfSetFolder, bfReturnOnlyFSDirs, bfDontGoBelowDomain, bfUseNewUI]; FRootFolder := brDesktop; FPosition := poScreenCenter; FCustomLeft := 100; FCustomTop := 100; end; function TKBrowseFolderDialog.Execute: Boolean; {$IFDEF MSWINDOWS} var BI: TBrowseInfo; Buf: PChar; List, Root: PItemIDList; Allocator: IMalloc; DesktopFolder: IShellFolder; I: Integer; Eaten, Flags: LongWord; {$IFDEF FPC} DisabledList: TList; {$ELSE} P: Pointer; {$ENDIF} begin Result := False; SHGetMAlloc(Allocator); if Allocator <> nil then begin GetMem(Buf, MAX_PATH); {$IFDEF FPC} DisabledList := Screen.DisableForms(nil, nil); {$ELSE} P := DisableTaskWindows(0); {$ENDIF} try if FParentWindow <> nil then BI.hwndOwner := FParentWindow.Handle else BI.hwndOwner := Application.MainForm.Handle; case FRootFolder of brAdminTools: I := CSIDL_ADMINTOOLS; brAltStartUp: I := CSIDL_ALTSTARTUP; brAppData: I := CSIDL_APPDATA; brBitBucket: I := CSIDL_BITBUCKET; brCommonAdminTools: I := CSIDL_COMMON_ADMINTOOLS; brCommonAltStartUp: I := CSIDL_COMMON_ALTSTARTUP; brCommonAppData: I := CSIDL_COMMON_APPDATA; brCommonDesktopDirectory: I := CSIDL_COMMON_DESKTOPDIRECTORY; brCommonDocuments: I := CSIDL_COMMON_DOCUMENTS; brCommonFavorites: I := CSIDL_COMMON_FAVORITES; brCommonPrograms: I := CSIDL_COMMON_PROGRAMS; brCommonStartMenu: I := CSIDL_COMMON_STARTMENU; brCommonStartUp: I := CSIDL_COMMON_STARTUP; brControls: I := CSIDL_CONTROLS; brCookies: I := CSIDL_COOKIES; brDesktop: I := CSIDL_DESKTOP; brDesktopDirectory: I := CSIDL_DESKTOPDIRECTORY; brDrives: I := CSIDL_DRIVES; brFavorites: I := CSIDL_FAVORITES; brFonts: I := CSIDL_FONTS; brHistory: I := CSIDL_HISTORY; brInternet: I := CSIDL_INTERNET; brInternetCache: I := CSIDL_INTERNET_CACHE; brLocalAppData: I := CSIDL_LOCAL_APPDATA; brMyMusic: I := CSIDL_MYMUSIC; brMyPictures: I := CSIDL_MYPICTURES; brNetHood: I := CSIDL_NETHOOD; brNetwork: I := CSIDL_NETWORK; brPersonal: I := CSIDL_PERSONAL; brPrinters: I := CSIDL_PRINTERS; brPrintHood: I := CSIDL_PRINTHOOD; brProgramFiles: I := CSIDL_PROGRAM_FILES; brProgramFilesCommon: I := CSIDL_PROGRAM_FILES_COMMON; brPrograms: I := CSIDL_PROGRAMS; brRecent: I := CSIDL_RECENT; brSendTo: I := CSIDL_SENDTO; brStartMenu: I := CSIDL_STARTMENU; brStartUp: I := CSIDL_STARTUP; brSystem: I := CSIDL_SYSTEM; brTemplates: I := CSIDL_TEMPLATES; brWindows: I := CSIDL_WINDOWS; else I := CSIDL_DESKTOP; end; if FRootFolder <> brCustom then SHGetSpecialFolderLocation(Application.MainForm.Handle, I, Root) else begin SHGetDesktopFolder(DesktopFolder); try Eaten := 0; Flags := 0; DesktopFolder.ParseDisplayName(Application.MainForm.Handle, nil, PWideChar(WideString(FCustomRootFolder)), Eaten, Root, Flags); except Root := nil; end; end; BI.pidlRoot := Root; BI.pszDisplayName := Buf; BI.lpszTitle := PChar(FLabelText); BI.ulFlags := 0; if bfBrowseForComputer in FOptions then BI.ulFlags := BIF_BROWSEFORCOMPUTER; if bfBrowseForPrinter in FOptions then BI.ulFlags := BI.ulFlags or BIF_BROWSEFORPRINTER; if bfBrowseIncludeFiles in FOptions then BI.ulFlags := BI.ulFlags or BIF_BROWSEINCLUDEFILES; if bfBrowseIncludeURLs in FOptions then BI.ulFlags := BI.ulFlags or BIF_BROWSEINCLUDEURLS or BIF_USENEWUI or BIF_BROWSEINCLUDEFILES; if bfEditBox in FOptions then BI.ulFlags := BI.ulFlags or BIF_EDITBOX; if bfNewDialogStyle in FOptions then BI.ulFlags := BI.ulFlags or BIF_NEWDIALOGSTYLE; if bfReturnFSAncestors in FOptions then BI.ulFlags := BI.ulFlags or BIF_RETURNFSANCESTORS; if bfReturnOnlyFSDirs in FOptions then BI.ulFlags := BIF_RETURNONLYFSDIRS; if bfShareAble in FOptions then BI.ulFlags := BIF_SHAREABLE or BIF_USENEWUI; if bfStatusText in FOptions then BI.ulFlags := BI.ulFlags or BIF_STATUSTEXT; if bfUseNewUI in FOptions then BI.ulFlags := BI.ulFlags or BIF_USENEWUI; if bfValidate in FOptions then BI.ulFlags := BI.ulFlags or BIF_VALIDATE; BI.lpfn := BFCallBack; BI.lParam := Integer(Self); List := SHBrowseForFolder({$IFDEF FPC}@BI{$ELSE}BI{$ENDIF}); if List <> nil then begin SHGetPathFromIDList(List, Buf); Allocator.Free(List); FFolder := Buf; Result := True; end; finally {$IFDEF FPC} Screen.EnableForms(DisabledList); {$ELSE} EnableTaskWindows(P); {$ENDIF} Allocator.Free(Root); FreeMem(Buf); end; end; end; {$ELSE} begin Result := False; end; {$ENDIF} procedure TKBrowseFolderDialog.SetFolder(const Value: TFolder); begin FFolder := Value; end; end. tomboy-ng_0.39-1/kcontrols/source/kmessagebox.lrs0000644000175000017500000014507014346341266022010 0ustar dbannondbannonLazarusResources.Add('kmessagebox_info','PNG',[ #137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0'0'#0#0#0'0'#8#6#0#0#0'W'#2#249#135 +#0#0#12#30'IDATh'#129#189#154'[l'#28#231'y'#134#159#239#159#153#221'%'#151'\' +#158'D'#153#162'D'#157'i1'#128'+'#181#146'P_Dhb'#4'h'#26')'#145']'#164'wN'#17 +#184'F.'#26' 0\'#24#5#218#162#169#218#162'@'#131#198#237'U'#0#247#164#216#17 +'\'#8'E'#11#216#149#27#161#185'q'#4#215#177#19#212#182'd)'#182'%'#138'4u'#160 +'D'#145#20#201'='#159'f'#230#239#197#156'g'#201#165#28#167#253#129#159';;' +#195#157'y'#223#247'{'#191#239#255'fv'#133'O9&'#191#252#242#160'h'#247'1'#141 +'>'#140#200'!'#132'A'#17#227' '#200#0'"'#128'.'#226':W'#16#214#180#214#239'k' +#167'y'#169'Q'#252#248#245#219'o'#254#213'2'#224'~'#218#235#203'/'#12#252#196 +#15#158#2'y"'#147#201#156#28#221'R'#160#208#223#203#240'`'#31'J)'#250#242'=8' +#174#139#235'j'#28'WS*'#215'i'#219#14'k'#165#26#213'Z'#131'R'#165'A'#187']?' +#143#221'87'#253#159'O'#159#6#218#191'('#153'OL`'#242#196#153'g'#17#158#153 +#216#182'e'#215#238#137'Q'#30#218':'#132#237#184#20#171'6'#229#154'K'#189#233 +#210'hi'#154'm'#141#6','#3','#19'L'#165#189'm'#3#180#22#214'JUV'#138'%J'#229 +#210'm'#167'Uy'#225#250'k'#191#247'<'#208#250#164'D'#30#152#192#254#227'/>&' +#202#248#254#190']c'#187#30#153#154' '#155#181'X^'#179#153#191#223'by'#205 +#193'vut'#186#244'Y5xv'#2'%'#208#147#129#222#12'd'#12'h'#181'm'#150'WW('#149 +#214#230#219#149#219#223#156#253#209#179#255#229#19#209#191#20#2#147''''#206 +#12#162#245#169#225#225#254'g'#142#30#220#203#200'p'#129'['#139'M'#174#207'7' +#169#183#2#177'b'#167#137#159'QK'#231#21'b'#239#13'%'#228'-'#143'H'#189'Qgeu' +#137'fm'#229#159#139#183#222'8u'#239#189#127#188#11'8'#155#225'36'#5#143#254 +#241#254#189#219#30'?'#246#235#7'p'#176'xo'#186#198#141'{-l'''#16'('#166'z'#0 +'N'#139#167#184#144'<&'#128#8'Z'#188#227#26'h:'#208'r'#193'2,'#242'='#253'he' +#29'6'#251#183#31#215#174#253#195#250#242#135#21'6'#177#212#134#4#246#31#127 +#241#215'D'#228#149'c'#143'N'#29'z'#228#192'N'#230#22'Z'#188'{'#173#158'R]' +#146#192#227#251#18#192'='#208#226#219#200#223#21'n'#184'"'#180#181#0#138#158 +'L'#30#195#204'm1'#7'v}1'#211#183#237''''#229#249#159'v'#173'V'#235'Z(P'#254 +#216#163#159'9'#180'{'#199'('#23#175'W'#185#189#212'F'#179#142#234#169'S'#245 +#245#26'|'#247#247'ws'#228#225'<'#0#239'\'#171#242#220#223#223#160'Rs'#252 +#127#145#4#199'4'#18#195#159#205'f'#133#202#218#252#213#197'K/'#158'\'#153'~' +'m'#14'//:FG'#4#210#224#223#187'^e'#190'+xI'#236#251#163'''w'#240#249'_-'#132 +#231#27#31#201#144#181#20'o}TAD'#240#221#19#5#203#143#140#4#7#252'h'#25'f'#22 +'e'#245'l'#201#12#238#251'M'#215#174#157#175#223#191'Vb'#157'H'#168#14'JZ' +#159#218#191'g['#168#252#230#224#227'<'#132'm#'#153#142'S'#30#152#200'E'#226 +#251#160#137#131'V'#201#247'Z'#4'W'#20'f'#174#143'l'#223#232#129#145#169#175 +'~'#27#24'XO'#240#4#129#253'''^zlx'#184#240#204#145#131'{'#152#185#211#232 +#180'M'#135#223'c'#1#144#238#5'-RX'#197#192'*DE'#202'Kbz'#159#201#246#13#147 +#27#156'xr'#226's'#223'>'#14#244'&UK'#17#16'Q'#223'?zp'#15#149#186#230#195#27 +#141'N'#240#9#185#215#1'/p'#246#245#251#29#224#207#254'x%'#2#152#0'L,*x'#145 +'HM1'#12#178#253'#'#244#141#31#253#14'0'#4'$B'#28#134'd'#242#196#153'?'#223 +#183'{'#236#241#201#189'c'#188'w=]m'#216'@'#249#164#255'E'#132#27#247#154'L' +#207'7h'#217#154#233#249#6#255't~'#137#11#151#203'!'#240#224'c'#162#136#145 +'R'#145#242'*'#29#9'A'#25#22#2'}'#249#177'#'#238#234#244#15#127#6'4'#241#23 +':3&'#255#215#31#153#154#224#230'b'#139#149#178#253'@'#224#195#181'7'#174'&p' +#225'r'#153#11#151'+!'#169'`M'#8#255#23#194'}'#225'Y'#19'AN'#172#134'h'#129 +'L~'#128#236#208#174''''#129#23#128'*'#208#0#223'B'#147''''#206'<51>'#178'+' +#155#181#152#153'o~'#10#240'1{'#168'X'#221'WDJ+'#255#152#242']'#18#190#15'l' +#163'R6'#242'>cX'#22#217#252#208#216#158'/'#254#237#215#128'|'#128#221#244'1' +'<'#177'k'#199'('#203'kv'#204':'#221'l'#147#4#255#240#142#28#253#189'Fh'#169 +'0'#159'%R'#252#221#217'z$z'#180#17'S'#222#255#155#170#5#26#188#149#29#176'z' +#250#200#14'L|'#1'x'#9#168#0'M'#243#225#175#188''#184#217#160#237'x'#159'}tj'#253'H('#165#252#234#147#172#243'q'#17'$}]' +' '#232#170#181#22#12#192'43d'#11#227'S@'#15'`'#154#136':4<'#216'G'#185#150 +'V'#127'#'#240#222'E'#181#134'F'#219#165#214't'#249#179#151'n'#135#137'8}' +#250'W6 '#16'$v'#144#208'A'#20#131#170#148#140#166#132#208#197''''#160'Q@6' +#147#197#236#25#158#244'#`'#154#192#160'R'#138'z]w'#146#239#24#130#214'P'#171 +';'#212'['#218#183'BTET'#23';)C'#18#192#131'('#144#138'F(T@ XK'#181#160'Dc` ' +#202#234#7','#192'0E'#25#7#243#189'9'#238#172#182'7'#181'N'#163#233'Ri8hM' ,#199#130#163#130'Uv#'#234#202#243'u'#154#4')2'#225#213'}'#6#225'm'#153#159 +#244'=V'#6'37'#176#207''''#160'LA'#6#28#215#187#135']Gp'#0#28'WS'#172'8'#180 +'m'#221#9'$57'#140'@'#16#165'.$'#226#139']8'#180#14'K'#169#136#198#178#4'1' +#172'|'#24#1#16'\W'#199'n@'#147#203'c'#163#229#178'V'#182'A'#240'T'#14#171 +#207':'#179#179#183#141#8#24'Q'#18'G'#249#176'~2''-'#20#229#128#161#4#211#210 +#1'A'#3#16#19#209'E'#199#213#3'V'#186'Q'#21'('#150'm'#170#13'''T'#173#163'cL' +'G'#160'K'#14#196#129#171'@'#253'n$bCk'#13'Z'#200#152'^'#4#208'N58fj'#215#185 +'R'#170#212'?k'#26'V'#248#1'W'#195#234'Z'#155'FK'#163'T'#20#218#180#218'i2' +#170#155#133#140'(OT'#130'tP'#149#136'*R*'#139#181#246#222'd-'#193'vZ8'#173 +#242','#222#13#191'6'#17#214#218'm'#7'SY'#224#175#144'K'#171'mlG'#251#29'$a' +#143#19'F!'#161'\'#146#204#134#4'R'#192#19'6'#138#19#241#241'G'#242'{'#11#159 +#214#154'l'#22#220#6#184'n'#187#130#247'0'#204'QZ'#235#247#215#202'5,'#19'\W' +#179#184#210#162'm'#187#233'T'#232#240'>q'#27'Id'#137'n'#4#2#224'F'#184#250 +'*'#12'Ca'#24#177'}'#166#138#173#200#202#127#239#29#239#205#10#245'F'#27#187 +#182'2'#227#19'pMm7/'#213'jMF'#135#161'Ti{'#149'F'#4'!'#238#251#164']'#136 +#169#31#150#193'`a'#218'`'#4#224#149#161#162#237'T'#254#172#215#158#4#254#23 +#160'7'#167#169'7m'#154#197#155#211'A'#4#204'fq'#238#245'r~'#152'r'#173#141 +#194'['#141#131#19#17'S;'#217'B@2'#169'7'#183#144#164#193#27#221#173#228#161 +#7#141'Fk'#232#207'hL'#19#202#229#22'K'#239#255#235';x'#247#3#182#186#245#230 +'_.'#183#219#245#243#171#197'*'#133#158#164#138#146'z'#141',$'#196#237#244 +#224#22'"'#4#31#183#137'a('#12'3'#176'S'#210'>'#193#190#145'~E'#177#212#164 +'^'#188#243'v'#237#222#149#21#160#14#216#10'p'#181#221''#248#175'=W]'#248#249#28'0'#143#167'~'#251#147 +#232#151#25#158'<'#177#231#161#195#223'xU'#172#161#3#142'*'#160#149#1#29'9' +#16#127'4'#18'o'#210'$L'#200#160#25#11#27'3?I'#3#18#133#188'bb'#196'K'#216 +#139'W'#138#204'\]'#152#253#232#236#239'>W]'#184#210#21''#235#3#14#170'M'#141#7#248#154#245#147#212#16#193#251'r' +#161#15#24#222#251#165#191'{230'#241#133'L'#254#161'c'#134#153#241#158#152'e' +#179'd,'#131'\'#143#133'e),K0-'#133#227'8'#160#160#222'h'#211'h8'#148'*m'#234 +'k'#243'o'#215#150#175#190'9'#243#31#207#156#195'[Y'#215'|'#224#21'~'#153'_t' +#175'3'#20#144#197#139'H'#161'o'#251#209#241#145#3''''#143'e'#10#219#167#172 ,#222#145'I1'#172'~#W'#216#167#12'+'#143#8'Z'#187'U'#183'Y'#158'u'#221'v'#197 +#174#221#159'i'#22'oN/]:'#251'N'#213'k'#137#171'x'#141'Y'#201#223#254#191#251 +#169#193#6'D,'#159'L'#14#239'Ye'#206#223#23#204#160'H8x^'#14'f'#3#175#159'o' +#224#173#170#255#127'?'#246#216'`('#188'U'#221#196#3#173#252#215#224#252#26 +#143#132#235#191#218#254#252#212'?'#183#249'_#'#234'='#139#131#251#19#227#0#0 +#0#0'IEND'#174'B`'#130 ]); LazarusResources.Add('kmessagebox_question','PNG',[ #137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0'0'#0#0#0'0'#8#6#0#0#0'W'#2#249#135 +#0#0#14'*IDATh'#129#189#154'yl'#28#215'}'#199'?'#239#189#153#217'{I'#241#144 +'(J'#148'dI'#148#148'B'#149'ZY'#181#11'W@'#171#4'm'#19'+'#150#147#26'H'#154#6 +#134#225#4#249#199'm'#224#6'u['#180'M'#10#27'A'#155#4#169#145#254#211'&E'#28 +#31'5l'#11#142'S'#216#245#21#27'H|'#187'nR['#135'%[2)'#138':(K$E'#238'}'#204 +#245#250#199#204#236#206'.'#151#150#18#167#29#224'qf'#223#206#204'~'#127#223 +#223#247'w'#188#25#10'>'#228'6'#254#201#135#250#133#246#247'j'#244'.'#132#216 +#137#160'_'#8#181#3'D'#31'B'#0#186#136#239#29'EP'#208'Z'#31#209'^'#243'p'#163 +'x'#234#133's'#175#253#195'<'#224#127#216#223#23#191'4'#240'}'#255'~+'#136'O' +'Y'#150#181#127'x(O>'#151'f'#160'?'#139#148#146'l&'#133#231#251#248#158#198 +#211#154'R'#185#142#227'z'#20'J5'#170#181#6#165'J'#3#199#169'?'#139#219'xr' +#226#233'/'#222#11'8'#191#172'1'#191#176#1#227#251#30#252#10#130#219#199'V' +#15#173#223#176'n'#152'U'#195'+p='#159'b'#213#165'\'#243#169'7}'#26#182#166 +#233'h4`*0'#13'0'#164#14#142#21'h-('#148#170','#20'K'#148#202#165's'#158']' +#249#222#228'S_'#184#27#176#127'QC'#174#216#128#205#215#223#191'WHu'#223#166 +#245'#'#235#183'o'#27'#'#145'0'#153'/'#184#204'\'#178#153'/x'#184#190'n'#223 +#174#251#174#26#2'9'#129#20#144#178' m'#129#165#192'v\'#230#23#23'('#149#10 +'3N'#229#220'mS'#207#127#229#185#208#16#253'+1`|'#223#131#253'h}'#231#192'@' +#238#246#221';628'#144#227#236#172#205#228'L'#147#186#29#145#181#28'p'#177't' +'.'#246'YIA'#198#12#12#169'7'#234',,'#206#209#172'-'#252#160'x'#246#149';/' +#30#252#254#251#128'w9|'#234#178#224#209'/n'#222#184#250#198'='#215'l'#197 +#211'&'#7''''#235#156#190'h'#227'z'#17'A='#192'k'#17'0.b'#167#180#134'@'#139 +#224'{'#13'4='#176'}0'#149'I&'#149'CKs'#151#145'[s'#189#246#221'g'#234#243 +#239'V'#184#140#164#150'5`'#243#245#247#255#166#16#226#241'='#215'n'#219#185 +'}'#235':'#166'/'#216#188'5Q'#239'b]'#180#129#1#218#7#207#209#216'M'#15#215 +#241'q'#29#141#235'j'#252#240#18#169'd'#251#202#152'A'#190#16'8Z'#0#146#148 +#149'A'#25#201'!'#163'o'#253#31'Z'#217#213#175#151'g'#254#251#3#179'UO'#9'E' +#204#239#185#246'#;7'#172#29#230#208'd'#149'ss'#14#154#222#172#187#182'O'#179 +#230#147'2'#4#215'l'#207#241#145#13#233#214#153#26'(W]~'#246'N'#133#247#206 +'5'#176'R'#138'D'#218'@'#202#222'HT8'#154#205#10#149#194#204#137#217#195#247 +#239'_'#152'xj'#154' ..o@7'#248#131#147'Uf'#150#1#175'}'#168#151']'#134#243 +'&_'#254#236'('#127#244#209'A'#180#6#173'5Z'#7#240#227#159'g'#230#154'|'#247 +'G'#23'y'#242#245#2#153'~'#19'e'#10'Dx?'#29#227'$'#26'v'#179'J'#173'p'#238 +#196#236#225#251#246'/'#188#247#212')'#130't'#219#177'-'#145#208#224#248#167 +#191#185'y'#227#234#27#183'o'#29#227#208#7#128#247#28'My'#193#225#182#155'V' +#243#175#127#179#153'm'#27#210'='#129'C'#219#128'lJ'#178#247#234''#164#198#174#251'([s'#207#223'o' +#225#211'{'#135'.'#11#188'='#31#28#175#30'4'#185'n{'#134'G~|'#137'd'#198#8'r' +#171'h'#27#17#12#16'B'#160#172'$'#8#181'#'#209#191#225'X'#233#244'K'''#187 +#189#208#161'D!'#228'}'#187'w\E'#165#174'y'#247'tc)'#248'pk'#214'^a'#207#206'<'#131'}F'#15#198#151#178#223'kn'#203#186'$'#15'?' +#191'H2g'#182#153#151#221#158#16'He" '#155#25#185#218'_'#156'x'#230'gq)'#181 +'= '#196'-'#219#183#141'qf'#214'f'#161#236'.'#11#30'@'#26#2#223#146#252#217 +#183#167'(V\'#180#6#223#215#148'*'#30'_'#251#183#179#236#188#249'mv'#221'z' +#140'}'#127#241#30'/'#188'Y'#238#240'R'#220#11'#'#3#6#171#6'L@#$H'#25#17'/b' +#3#132#4'+'#211'Gb'#197#250#207'w{A'#133#236#223':'#182'f'#232#150#13'c+94Y' +#15#139'To'#240'Q'#238#22'JP'#174'yL'#156#174#243#241#223#238#231#248#233':' +#159#253#234#4#19#23#29'2+,R9'#147#134#7'O'#191#188#200#174'-'#25'F'#6#140 +#208#11'D'#228#161'5'#188'r'#164#202#165#154'F'#153'2'#12'`'#217#10#228'h'#8 +#1'R)'#180#175#179#169#161#237#139#133#147#207#29#140#188'`'#4#228#243#169 +#245'k'#135#153'/'#186'1'#233','#15'>:LfM^=Z'#229#207#191'3'#205#155'''j'#232 +#164'A2!'#131'l'#2#24#9'Iz'#133#197'#?Yd'#215#150'TLjm'#25#181#165#18#22#185 +#174#196#30#156#26'L'#154#169','#137#190#177#143#1#15#0#21#160'il'#185#225 +#161'~'#211'4'#246#143#172#236#231#237'S'#245'6'#224#158#224#227'S'#1'3'#233 +'>'#131#151#143'TH'#247#155#24'f'#27'<2'#200#240#210'R'#204#204#217#203#196#4 +#28'>Y'#135#156#137#240#188#16'|'#251#247#194#194#29'd#'#1#202'Haf'#134#247 +'dGw'#143'V'#206#255#207'%'#160')'#209'z'#239#240'`'#30#215#213#204#23#188'8' +#237'='#182#182#5'Q+ '#149' 7'#148'h'#129'w}M'#221#246')'#215'<'#22#202'.' +#151#230#154'l'#24#177':'#244#31#128#215#156#191#228'Ps@'#153#18#169#4'RE{' ,#129#148#2'M0<'#13#182#167#241']'#141'2'#147#12'l'#187'a'#15#144#4#164#161 +#241'w'#229'si'#138'U'#183#221#18#127#128't'#136'R'#158' '#172#162#2'/'#4#237 +'zA'#211'"'#195'l'#162'=MJ'#192'_}ne'#7#240#136#253#167#222'('#147#200#26#237 +#30#169#251'w'#131'3'#195#243#5#10'0'#12#139'D~t'#27#144#2#12#3'!w'#14#244'g' +')'#213#188'+'#4#31#156#163'54'#28#159'Z'#211#15#180','#3#208'q'#240#150#235 +'s'#207'_'#143#145'K'#203'.'#253#195#251#11'.'#143#190'\!'#153'7'#145'R'#180 +#239#29#251'u'#29#195#161#181'F'#2#9'+'#129#145#26#24#15'=`'#24'@'#191#148 +#146'F'#253'J'#214#15#2#173#161'V'#247#168#219'A'#153#147'!'#240'8x44'#138#14 +#255#248#167#163'lYkuH'''#138#129#175'?t'#9#215'R$'#12#217#170#186#241#24'k' +#25#208#234#10#5'Rh'#20#10'!'#205#28'`'#2#202#16'R'#237#200#164#147#156'_t.' +#203'~'#163#233'Sixm'#198#227#197#166'U'#132#160'^r'#184#235#214'U'#236#253 +#141'L'#140#245#182#7#254#249#241#2'G'#207#187'd'#7#173#22#243#162'+'#195'E' +#22#180#237#214#8'!H'#153#22'F'#178'oSh'#128'4'#4#162#207#243#131'5l'#15#194 +#1#240'|M'#177#226#225#184':`Z'#198#170'f'#215'h'#150#28'>'#247'{}'#236#191 +'.'#191#132'u'#128'g~^'#229'?'#222#168#146#27'N '#149'h1'#223#218#19'#-'#4#30 +#165'R!4'#166')'#16#202#204#180'<'#0'"'#232'['#186'Q'#135'44l'#159'B'#217#13 +'2'#142'hg'#31#209'cx'#142#207#166'U&w|fxI'#202#4'xk'#178#201'7'#30'+'#208 +#183'*'#25'P'#23'k'#218':b'#160'CB'#237#24'PR`'#152':2P'#1#194'@'#232#162#231 +#235'>'#179#187#177#22'P,'#187'T'#27'^'#139'q'#186#251#148'.'#246#237#138#195 +'_~i'#205#18#224'ZC'#165#238#243#183#15'\"7'#156'@'#153#161#238#229#7#24'A' +#252'z'#13'Z`'#25#129#7#208'^5'#250#206#208#190'w'#180'T'#169#255#142#161#204 +#214#5#190#134#197#130'C'#195#214#237#12'A;$'#218#21#191'm'#140#246'4['#214 +'X'#236#26'Ov'#20#170'H'#197'?|'#181#130#163#20#217#132#234#8#252#8'|t'#191 +#30'.@'#235#224'C'#194#20#184#158#141'g'#151#167#8#22#252#218'@Pp'#28#15'C' +#154#128#192#215#154#185'E'#7#215#11#244#222#202#247#177#5'G''s'#129'1'#174 +#173#217#189'%'#211#201'Zl{'#229#157'&'#169'>3'#208'}'#20'G'#241'X'#138#12 +#137#169#152'PB:'#188'_"'#1'~'#3'|'#223#169#16#172#11'<'#169#181'>R('#215'0' +#141#160#163#156']'#176'q\'#191';'#20#150'h'#159#184#140#132'@'#132'+'#174 +#168#226#198#229#163'5L]p1'#19#18')'#5'J'#181'+'#175'R'#18#165'bs'#134#12'+r' +'8'#140'`^)I:!'#168'7'#28#220#218'B'#180#176#241#13#237'6'#15#215'jM'#134#7 +#160'Tq'#130'L#'#130#181'j'#139'q'#209')'#23'b'#236#183'3'#136#224#173#201#6 +#247'<[\'#154'Y'#194#239#165#12'@G'#30#232#148#146#232#188'_'#151#254#5#144 +'Nj'#234'M'#151'f'#241#204'D'#228#1#163'Y'#156'~'#161#156#25#160'\u'#144#4 +#213'8'#186#17'1'#182';['#8'b'#134#4#231#155'I'#197';'#23'='#142#207'U'#17'J' +#182#192#201#240'8'#221'ov'#130#191#140#148#8#195'G'#135#9'!gi'#12#3#202'e' +#155#185'#'#143#190#9'4'#0'W'#158'}'#237#235#243#142'S'#127'v'#177'T%'#159#18 +#29')Xt'#237#219#18#18#196#229'$'#132#192'HH'#146'y'#147'd'#222#196'J)'#204 +#164#194'J)R9'#131't'#191'If'#133#25'.ZD'#172'q'#147'm'#25#25#145#156':'#229 +#19#205#13#230'$'#197'R'#147'z'#241#252#27#181#139'G'#23#128':'#224'J'#192 +#215'n'#243#201'Z'#189'F'#210#4'C'#181'%'#210#169'}'#209#10#230#184#23':'#210 +#160#134#234#130#205#136#165#249#196'6'#147'='#235#20#238#162'C'#163#236#133 +'R'#137'y&'#230#137#214'0'#130#24'P'#134#8'F'#24#19#233#164' '#151#22'\'#152 +#171'S'#155';'#241#26'P'#13'='#224'G'#228'&'#182#222#244#216#228#192#138#209 +#181#229#134#193'B-'#214#223#196#220#28#181#185'B'#9#164#148#173#207'Q'#27'\' +'_t'#185#229#163'Y'#190#240#7#249#150#23'+'#13#205#29#247#23#153#245#20#233 +#188#25#3#28']'#223#190'O'#135#132#162'VBkF'#251#192#244#29'~'#250#147#201 +#217#131#255'r'#237'g'#128'3'#192'y'#160#25#173#137#29#223'.'#127#175'V/'#147 +#177#192'2'#218'Z'#143'K''8'#142#2'<'#238#5#240']'#205'U'#195#170#3'<@6)'#184 +#235#143#243'4*^'#144#235'{y '#220'+%PF('#157'p'#159#207'H'#134'r'#130#147 +#167#202'T.'#28'ySc'#242#189#247#167'N?'#255#181'{C'#240#29#236#247'F'#2'jp'#219'M'#27#134 +#127#253'O'#158'V'#230#170#173#154'4M)'#209#29'A'';'#179#137#140#218#2#129']' +#243#176'k'#154']'#155#19'Tm85'#239#147#27#178'H'#229#140#14#137#4#251'@6' ,#173#192'U'#146#225#188'd'#227'J'#201#201#233'*/'#253'tr'#234#248'#7'#223'Q' +#187'xl'#10#152#9#13#232'xk'#211#235#5#135#174#207#191'[I'#175#220'~'#204'Le' +#174#21'29$'#133#209#242'{'#183'~'#187#219'j3'#21#164#203#133'&'#212#165'$' +#179#194#196#176'T'#171'%'#151#177#165#167#140#177'n'#26#130'u'#3#130#209'~' +#193#212't'#149'W^'#156#154':q'#224#230';j'#23#143'M'#19#164#204#2#224'v'#131 +']'#238#13#141'_'#156'~a'#198#183'+?'#206#140'l'#251'}'#169#228#16#194'B'#136 +#232'Q8='#12#232#12'Ne'#180#189#19'\'#22#203#243'1#'#132#128'\J'#176'aP'#144 +'24??'#184#200#161'7'#207'N'#29'?p'#243#29#213#11#199#166'c'#204'/y7'#240'A' +#6#0#248#245#133#137#146#239'T'#159'M'#244#141#14#152#150#181'CK#X'#3'I'#1'a' +#255'.c'#185#189'{'#200#142'~?8'#150'1/&L'#24#237#23#172#233#135'b'#209#230 +#213#255#154'c'#250#216#161'''&'#31#255#242'7'#171#23#142'F'#204'/'#11#30'z' +#199'@'#247'f'#2'}'#235'~'#247#206#235#179'kw'#127#11's'#197#136'od'#17#202 +#192'P'#18'%'#5'('#17#228'p'#213#217'*'#183'>'#27#237#214#217'0%}i'#193'`N' +#146'K'#11#28#199#231#228't'#133#211#211#11#179's'#135#30#190#251#236'K'#223 +#142#178#205''#187'f'#247#232#224#214#253'{'#172#252#154'mfz' +'p\(3'#167#146#249'MR'#153#25#132'@k'#191#234'7'#203'S'#190#239'T'#220#218 +#165#147#205#226#153#137#185#195#7#222#172#6'-q'#21'('#19#244'6U'#254'/'#255 +#213'`'#25'C'#204#208#152'$'#193#179#202'd8'#23#141'(Ix'#4'Z'#142'F'#131#160 +#159'o'#16'<'#231#255#255#251'g'#143'e6'#9#24#225'P'#225'g'#21#187#191'&0' +#194#15#247'n8>'#244#191#219#252'/w'#245';'#226#12#17#214'='#0#0#0#0'IEND' +#174'B`'#130 ]); LazarusResources.Add('kmessagebox_stop','PNG',[ #137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0'0'#0#0#0'0'#8#6#0#0#0'W'#2#249#135 +#0#0#15'kIDATh'#129#189#154'}'#140#21#245#185#199'?'#191#153'9'#175'{'#246 +#156'}a'#193#133#8#187#200#202#194#130#8'"'#224'J'#5#19')'#212#164'6ii'#168 +'m-'#194'm'#170'i'#161#186#21#237#31'm*'#181'hZ4'#218'Z['#163'iS'#178'"'#21 +#195'M5%('#132#220#16'^'#196'^T'#16'e'#223#192'ua'#151'}'#129#221'sv'#15'{' +#222'g'#230'w'#255#152#153#179's'#206'.\'#173#222';'#201#147'9/3s'#190#223 +#231#249'>'#207#239#249#253'~G'#240'%'#28#205#205#205#181'B'#136#133#192'B!' +#196#12#160#6#16'RJ'#0'L'#211''#159#239#142#154#154#26'f'#204#152'A8'#28 +#198'4ML'#211'DJY'#240#218'y'#239'&'#20#143#199#233#237#237#165#175#175#143 +'d2y<'#22#139'm{'#228#145'G'#14#2#185#207'K'#228'3'#19'hnn'#174'UU'#245#247 +#165#165#165#247'4440c'#198#140''#186#186#186 +#24#30#30#222#127#238#220#185'-'#219#183'oo'#7#244#207'J'#228'3'#17'x'#245 +#213'W7'#8'!'#158#155'?'#127'~d'#238#220#185'y'#192#217'X'#140#254'7'#223#228 +#210'?'#255#201#229#189'{'#241#148#151#163#250#253'(~?'#200#177#223'7'#211'i' +#204't'#154#220#200#8'e'#171'W'#19'^'#181#138#240#170'U('#165#165#0'H)9'#127 +#254'<]]]W._'#190#252#171#199#30'{'#236'% '#131#149'''_'#140#192#174']'#187 +'vTTT'#172'_'#178'd'#9#145'H'#4#211'4'#201'D'#163'|'#250#252#243't'#191#244 +#18#138#215#139#191#186#26'OY'#25#184#188#142#148'c$'#236#179#148#146#220#208 +#16#217#161'!L]'#167#252#251#223#167'b'#253'z'#148#210'R'#164#148'$'#18#9#206 +#157';'#199#192#192#192#127'n'#218#180'i#'#144#192#202#143#127#143#192#174']' +#187'v\'#127#253#245#235#151',Y'#130#170#170#152#166#201#167#207'?'#207'''' +#191#253'-'#158'H'#132#192#244#233#8'U'#29#3'^l'#206'Q'#244'^J'#137#212'u2}}' +#228#18#9'*'#30'x'#128#200'}'#247'!'#165'D'#215'u:;;9'#127#254#252'?'#30'z' +#232#161#255#0#226#215'"qU'#2#187'v'#237#218'1s'#230#204#245'K'#151'.'#197'0' +#12'2'#209'('#239#175']K'#162#173#141#210#134#6#132#166#129#157#156#227#188 +'='#193'k9AD'#144#18'i'#24'$;;Qg'#205'b'#242's'#207'!B!'#0'>'#253#244'S:;;' +#223'hjj'#218'x-'#18#234#181'<'#223#216#216#136'a'#24#12#159'<'#201#137#187 +#239#134'\'#142#146'Y'#179#16'B\'#219#235#19#1'/'#2'/'#0'!%'#8#129#183#162#2 +'sp'#144#145#221#187#241',Z'#132#168#168' '#18#137'`'#24'F'#253#178'e'#203'f' +#239#223#191#255'm'#174'R'#161#198#17'x'#245#213'W7TVV>'#190'|'#249'r'#132#16 +#12#159'<'#201#127#127#237'k'#4#175#191#30'Oee'#30#140'4'#205'1P'#166'9'#222 +#179'RZ'#0'm'#19'n'#208#246'5'#238#207#180'@'#0'UU'#137#191#254':'#218#173 +#183'By9'#161'P'#136'L&S___'#31'?z'#244#232#169#137'H'#20#16#176'K'#229'?V' +#172'X'#225#15#6#131'd'#162#209'F'#247#237#195#179'z5'#194#235'%'#24#12#146#203#229#150 +'j'#154#246'_'#237#237#237#3#20'II)`'#163#170#191#159'?'#127'~'#196#169'6' +#239'}'#235'[h'#161#208#132#224'k'#127#242#19'n?t'#136#197#187'wSr'#195#13'c' +#223#219'y!l'#160#197'dK'#234#234'X'#252#198#27',=v'#140#218#159#253'l'#220 +#247#170#223#143'O'#211'H'#252#226#23#24#134#129#199#227'a'#202#148')'#161 +#198#198#198''''#128'2@'#155'0'#2';w'#238#188'3'#28#14'?'#181'|'#249'rL'#211 +#164#243#15#127'`'#232#192#1#2#211#167#143#3'_'#247#243#159'3'#229#235'_'#199 +'4M'#8#4#152#188'j'#21#177#227#199#201#13#13#229'=<.a'#129#146#186':'#230#188 +#240#2#131#217','#209'h'#148#202'E'#139'('#157'1'#131#216#161'Ccr'#2#212'@'#0 +#163#167#7'CQ'#16#179'g'#19#12#6'I&'#147'5'#147'''O>s'#242#228#201#179'@v\'#4 +#132#16'['#231#205#155#151#31#160':'#159'y'#134#224#204#153#19#130#159#188'f' +#13#134'a'#160#235':'#185'\'#142#172#162'Pg_?'#206#235#182#198#3'3gR'#251#204 +'3'#244#13#15#147'H$'#200#229'r'#244#246#246#18#190#235'.f='#254'x'#129#236 +#144#18#223#148')'#152#127#255';'#185#225'at]'#167#178#178#146#27'o'#188'q' +#179#29#5'OA'#4#154#155#155'k'#3#129#192#179#203#150'-'#195'4M>'#217#190#157 +#244#249#243'x'#194'a+A]'#178#185#238#158'{0'#12#163#192'r'#185#28#134#16'DV' +#172'`'#244#189#247#208#163'Q'#11#184#13#222'7s&'#211#183'o'''#154'J'#145'N' +#167#11#238#29#30#30'f'#202'-'#183#224'//'''#254#206';'#249'((B L'#147'\&' +#131'lh'#192#235#245'2::Z'#157'J'#165#14'tuu'#245'9QP'#0#20'Ey'#184#182#182 +'6'#239#253#238#191#252#5#127'u'#245#184'R9u'#237#218'q'#224'u]'#207#147#200 +#170'*S'#183'm'#195'W['#155#247#168#183#182#150#234''''#159'd'#200#238'Hs' +#185'\'#222#178#217','#233't'#154#142#142#14'*'#215#174#165#248#240'D"'#168 +#251#246'a'#196#227#24#134'A('#20#226#182#219'n'#219#0#132#28#231';'#4'V:' +#205'Y'#255#155'o'#226#137'D&'#172'8'#153#254'~L'#211#28#7#222'-'#167#140#162 +'0'#229#137''''#240#214#212#224#173#169'a'#242#19'O'#16'K'#167'I'#165'Rd2'#25 ,#210#233'4'#137'D'#130'D"'#145'o'#179#1#204#254'~'#140'h4oz4'#138#153'L'#162 +#1#218#251#239#163#170'*eee'#132'B'#161'['#128'R'#192#11#160'677'#215#250#253 +#254#167#22',X'#128'a'#24'|'#242#228#147#8'!'#242'-'#130#187'<'#198'O'#158'd' +#242#170'U'#232'0'#14#188#243'^'#215'ur@'#201'W'#190#130#239#142';'#24'L$' +#136#199#227#164#211'i2'#153#12#217'l6'#127#159'i'#154#248#253'~'#230'L'#159 +'N'#203#186'ud.\@'#166#211'y3FG!'#151'CQ'#20#148#21'+'#240'z'#189'D'#163#209 +#138#209#209#209#253#221#221#221#189'@F'#17'B,'#172#170#170#202#247#236#209 +'C'#135'P}'#190#9#7#165#209#142#14'>'#222#180#9#153'L'#230';R7p'#199#187#195 +#195#195#12'%'#147#12#218#158#214'u'#29#211'4Q'#20#5#143#199#131#199#227#193 +#231#243'QZZ'#202#172#234'j'#218#190#249'MRg'#206'X@''0'#245#196#9'TUE'#211 +'4B'#161#16#181#181#181#243#0#31#160'('#192'B'#167#238#199'?'#252#16'OY'#217 +#213#251#27')Itt'#208#222#212#132'L&'#243#218'w'#164#144'N'#167#201'f'#179 +#232#186'N*'#149'"'#149'J'#141#3#238#241'x'#240#218#3#212#212'H'#132#174#239 +'~'#151'TK'#203#196#224#133'@Q'#20#132#16'h'#23'.'#160#170'*%%%'#148#151#151 +#215#219#4'TE'#8'1#'#24#12'"'#165'$'#27#139'YMZ'#145't'#4#133#205'X'#178#189 +#157#246#245#235#201#13#15#147#205'f'#201#229'ry'#25#185'MJ'#137#166'i'#5#192 +#189'^/'#129'@'#128#10#175#151#190#13#27#200#182#183#163'^'#205#243#238#215 +#233'4'#154#166'9S'#214#235#28#2#154#148#178'&'#16#8'`'#154'&'#177'#G'#242'}' +#189'[:'#238#136'dz{'#201#14#12' M'#147#204#189#247'2'#189#185#25#132'('#144 +#146#174#235#150#215'4'#13'M'#211'PU5o'#154#166#17'0M'#6#31'x'#0#189#163#195 +#242#176'5'#16#21#180#198#210#145#175'}VZZP'#22'.'#164#164#164#132'`0Xm'#143 +#5#170#130#189'z '#221'@'#243'O'#25#3#174#199#227'\9}'#154'to/'#210'4'#17'B' +#144'im'#165#251#7'?'#192'g'#3'vH'#0'y'#240#197#17#240#233':'#195'?'#254'1' +#198#217#179'c^V'#213'qQ('#254'\U'#148#188#19#20'E'#1#171#165'P4ly'#20#207 +#164#164#235#156#238#233'!}'#241#162'U'#157#24#27#242#133#16#8'!'#144'R'#230 +'+'#139'#'#155#137'LUU'#200'fQ'#132'@'#170#234#216#243#132'p'#186#1#151#239 +#198#218'q'#9#22'x'#247's'#236'~Pq.r'#170#144#219#251'R'#215#185#210#210'b' +#129'w>'#23'"o'#254'9s'#152#182'c'#7'q'#195' '#147#201#228#19#214'-'#151'b' +#243#148#149#17#249#243#159#241#206#158'='#230'U'#247#217#237#237#226'sa'#4#0 +'PL'#211'<'#159'H$'#144'R'#18'nl'#196#24#29#181'<::J'#252#244'i'#140'x<'#15 +#220#237#253#224#220#185#204#216#185#147#184'a'#144#205'f'#173#198#206#241 +#148#13'~"'#18#30#143#7#127'e%'#229'6'#9#197'-'#21#7#224#4#164'<'#139#22#161 +'i'#154'5Xf2'#3'N'#154'('#134'a\H&'#147'H)Q'#195'aL]'#199#24#29#229#202#153 +'3'#152#153#12#249'X'#185#188'_2o'#30#179'v'#239'&n'#151'QgLP'#138't'#234#246 +#154#155#140#215#235'%PUE'#229'K/'#225#159'3g'#236#251#162#179#226#152#162 +#160#149#149#161#170#170#211'~'#12'`-'#189#152'J.'#151';522'#130#148#146'`C' +#3#153'K'#151#136#127#252'1'#210'NF'#28'}'#218#28'Jo'#186#137#134'7'#222'`' +#196'n'#29#28#240'@A'#18':`'#139#137'8'#145'qHL'#254#235'_'#9'8$'#174'&)U' +#181'$'#167#170#164'R)._'#190'|'#22'kvf('#201'd'#242#228#208#208'P>'#145'#+W' +'"u}'#188#231#129#200#130#5',~'#251'mb'#217','#217'l'#150#130#234'e'#19'p' +#202#167'O'#215'QR'#169#177#170'2'#1#9#143#199#131#175#162#130'i'#175#188'B' +#176#161#1#213')'#185'E'#165#215#183'bE'#254#190#145#145#17'Z[[;'#176#214#141 +#12#165#169#169#169'3'#149'J'#157#137#199#227'H))['#189'z'#226#165#10'!X'#180 +'g'#15#151#18#9'2'#182#180#220#4#156#138#228#241'x'#8#9'A|'#211'&F7o'#134'D' +#2'a'#143#168#5'e'#210#5#144#146#18#166#188#240#2#154'-'#31#183#169#170#138 +#215'&'#144'L&I$'#18#157#199#143#31#239#206#19#0'L]'#215#15#247#244#244'X'#17 +#248#234'WQ#'#145#130#196'u'#14#207#180'i'#232'vt'#138#189#15#224#245'z'#169 +#240#249#242'u'#222#248#228#19'F'#127#250'S'#204'+W'#236#199#137#2'2'#5#249 +'R]]'#160#255'|'#180'"'#145'|'#4#6#6#6#136'F'#163#167#129#148'M'#192'T'#0#217 +#211#211#243#199#139#23'/Z2(-e'#210#134#13#133#206#183#173#231#197#23#153'6m' +'ZA'#25's'#200#4#2#1#166'F"'#12#217'#'#172#3#214''#136'/'#151#203#143#222#138#162#144#222#187#151#196'o~3'#14#188#170 +'i'#248'7nD'#13#135'Q'#20#133#174#174'.'#142#30'='#250#138#13'~'#20'{y%'#239 +#198#3#7#14#156#191#235#174#187#150'h'#154'6+'#28#14#227#187#233'&'#18#255 +#250#23'zo'#239#184#144'_'#222#187#151'@U'#21#245#223#248#6'e'#217',-'#235 +#214#229#251'ya'#155#226#214#187'}'#150#177#24#217#227#199#9#223'y'''#158#178 ,'2R'#175#189'F'#226'w'#191#179#170#146']z'#157#156'Pn'#190#25#239'#'#143' ' +#132#160#179#179#147#150#150#150'w'#183'm'#219#246'7`'#0#24'v'#8#184'sT<'#250 +#232#163#13's'#230#204'yg'#241#226#197#165'~'#191#159'l,F'#207#183#191#141 +#209#215'7'#150#128#238#179#11#220'Dm'#176'S'#203#157#17'VS'#20#171#159'q'#13 +'Xn'#207';'#224'eU'#21#202#139'/B(D<'#30#231#200#145'#'#137'g'#159'}'#246#193 +#195#135#15#159#2'.'#216'Q'#144'n'#9#1#200#167#159'~'#186#253#242#229#203#191 +'jkkC'#215'uKJ'#207'>'#155'_'#199#255'w'#15#183#172#10'>sI'#204#137#150#26#14 +#163#254#250#215'('#246#174'O[['#27'''N'#156'x'#249#240#225#195'g'#129'!'#172 +#10#148'/}'#197'k'#163#242#224#193#131#31#222'q'#199#29#245#186#174#207#157 +'4i'#18#162#162#2#239#178'ed'#222'y'#7'i'#215#244#255#205#138#229'#'#138'fX' +#138'Kf'#5'3'#175#235#174'Cl'#219#134'RW'#135#16#130#150#150#22'>'#250#232 +#163#131'['#182'ly'#25#232#7#6'q-jMD'#0#192'|'#235#173#183#222'Z'#186'ti'#189 +#148'rNyy'#185'Eb'#205#26#244#143'?F'#14#12'Xm'#239'g$'#225#206#7'a'#143#212 +'n'#25':'#4#197#130#5#168'O?m'#145#16#130#142#142#14'>'#248#224#131#131#247 +#223#127#255'S'#192'%,'#237#23'x'#255'j'#4'$'#160#239#223#191#127#255#173#183 +#222':['#215#245#250'p8'#140#240#249#240#172'Y'#131#12#6'1Z['#17'v5) '#3#227 +#128#231#189'k'#131'/ '''#4'"'#20'B'#251#225#15'Q'#31'z'#8#225#243'a'#24#6#29 +#29#29#156':u'#234#224'}'#247#221#247#148#13#188#31#171#242#140#219'r'#154'p' +#127#192'&'#145#219#191#127#255#219'K'#150','#153#157'J'#165#234'KJJ'#208'4' +#13'Q_'#143'r'#247#221'HM'#131#206'N'#208#245#2#29'O'#20#129#9'#'#20#10#161 +#221'{/'#218'/'#127#137'z'#243#205#8'!H$'#18#180#181#181#209#210#210#226#6 +#223#199#231#221#224'p'#147'8p'#224#192#219#245#245#245#241't:'#189#20#240 +#134'B!'#11#252#188'y'#152#171'WcTW['#15#234#235#3#155'H1'#248#252'\B'#8#212 +#219'oG'#251#206'w'#240'45'#161'.Y'#130#240'z'#17'Bp'#225#194#5'ZZZ'#18#135 +#14#29#250'SSS'#211#203'X'#178#233#191#22'x'#248'l'#187#148'*Pr'#207'='#247 +#220#220#216#216#248'DEE'#197#138#201#147''';;('#133#171#15#221#221#168#153 +#12'Zkk'#193',J['#184#16'5'#18#193's'#227#141#227#230#8#131#131#131'\'#188'x' +#145#139#23'/'#190#219#220#220#252#167'C'#135#14#157#5'.c%'#236#23#219#228's' +#29#10#214'2F'#217#198#141#27#215#212#213#213'm'#14#133'B'#11'#'#145#8#145'H' +#4#175#215'[0a'#153#232#181#27't&'#147'app'#144#161#161'!'#162#209#232'GG' +#142#28'ye'#199#142#29#239#2'1'#172'R9'#204#151#181#205'Zt'#173#6#4#128#178 +#149'+W'#206']'#182'l'#217#134'P(tK '#16#184'!'#24#12#18#10#133#8#6#131#4#131 +#193#2#224#206'RK:'#157'ftt'#148'D"'#209#25#141'FO'#239#221#187'w'#207#209 +#163'G'#187#176#6#166'a'#219'R|'#217#27#221#19#220#227#1#252'X'#171#196#165 +#141#141#141'u555'#243'&M'#154'T_RRr] '#16#168'vFbEQ'#200'f'#179#3#169'Tj' +#224#210#165'Kg[[[;'#142#29';'#214'm'#3'M0'#214#219#164#249#191#252#171#193 +'U'#238'U'#177'V'#137'}E'#230#193#138#150#243'|'#137#229#213#28#150'4'#220 +#150#229#255#243#207#30#215'x'#142#130'E'#200'1'#165#232#26#19#11#168'c_'#202 +#223'm'#254#7#31'H'#225'?'#143#171#233'e'#0#0#0#0'IEND'#174'B`'#130 ]); LazarusResources.Add('kmessagebox_warning','PNG',[ #137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0'0'#0#0#0'0'#8#6#0#0#0'W'#2#249#135 +#0#0#0#4'gAMA'#0#0#177#142'|'#251'Q'#147#0#0#0' cHRM'#0#0'z%'#0#0#128#131#0#0 +#249#255#0#0#128#232#0#0'u0'#0#0#234'`'#0#0':'#151#0#0#23'o'#151#169#153#212 +#0#0#16'SIDATx'#156'b'#252#255#255'?'#195'P'#6#0#1#196'8'#212'='#0#16'@'#140 +#255#255#253#162#178#137'L'#12#255#127'}b`'#248#243#149#235#255#143'g'#201 +#140#255'~'#9'1'#176#139#207'fd'#23'z'#198#192'&'#4'T@'#221#0#3#8' '#160#7'~' +'S'#213'@'#6'F'#22#160#227'?'#242#253'{'#127'v'#213#159#175'o'#221#255#253 +#249#195#192#202#205#127#134#137'_7'#131#145'K'#246','#181'='#0#16'@'#140#255 +#127#189#167#170#129#192#24'`'#250#247#233#234#178'_'#31#30#134#191'z'#200 +#194#240#235#199'?'#6#9#153'O'#12'\'#162'bg'#153'D'#28'M'#129#10#254'S'#211 +#19#0#1#196#248#255#247#23#170#25#198#192#196#194#240#255#199'S'#231#127#239 +#142#237'y'#241#128#149#225#243#155#255#12#255#255#255'c`'#231#252#205' %' +#255#141#129']T'#167#150'Q'#200#172#133#1'(F-'#0#16'@'#140#255#255'~'#167#154 +'a'#192#144#229#254#255#225#248#170'/O'#31'z='#127#192#1#228#255#1#134#247'_' +#134#31'_'#255'3'#8#137'}c'#144'P`'#248#193'$'#19#166#199#200'&p'#155#225#223 +'_'#170#216#8#16'@'#140#255#169#18#26#160'$'#193#200#240#255#227#185#202#223 +'oN'#183'='#190#201#205#240#29#24#177#194#226#223#25'8y'#127'3<'#186#206#204 +#192#204#252#151'AQ'#227#19#3#135#164'a/'#163#128'Q'#9#3'8'#239'Q'#158#148#0 +#2#8#152#137#127'Rl'#8#168#228#1#134'('#215#255#215#27'.'#189'{'#244'Q'#249 +#217']6'#6#14'`'#178#145'Q'#253#202#192#198#254#151#225#254#21#22#134#15#175 +#24#25#248#133'~0'#200#171#255#248#206'"'#19#16#198#196#175#189#133#129#10#5 +#8'@'#0#1#243#192'G*x'#128#145#241#255#231's'#157'?^\*}|'#131#157#225#251'g' +#6#6'i'#213'o'#192'd'#243#11#152#220#255'2|z'#195#0#246#196#223'_'#255#24#148 +'4'#223'1'#8'**'#31'`'#146#137'r'#4#197#26#165#177#0#16'@'#20'Vd'#144#164#195 +#240#251#181#254#191#23#203#207'?'#185#193#200#248#230#9#11#3#23#207#31#6'E' +#189#175#12#204#140#127#128#17#243#151#129#153#233#15#195#147#219#204#12'Oo' +#179#0'c'#225''''#131#138#238#151#127'l'#202'I!'#140#252#186#235')r='#16#0#4 +#16'0'#6#222'R'#162#29'X'#242#176'1'#252#255'pp'#233#215''''#151#163#238'_' +#230#6':'#248#31#131#130#246'W'#6#30#254'_'#192#20#242#23#24#3#127#24#152#128 +'%'#231#143'/'#255#25#174#159'd'#3'f'#232#127#12#178'*'#31#25'd5'#249#158'2+' +#231#154'1'#176#240''#3#203'|P'#12#127#2'::'#194#229#11'C'#132#245'w'#160#131#25#193'y' +#129#153#233#31#195#205#211#172#12#215#206#176'2'#240#240#254'd'#176't|'#197 +' `'#146#222#200'$'#23#222#0#236#12#17#237'$'#128#0'"'#161'1'#7#180#248#223 +'O'#222#255'/'#250#14#188#188'r'#215#232#198'I'#1'`'#217#254#151'A'#223#241 ,'#'#3#159#240'O'#134'?@G3'#128'='#240#15#24#3#127#24'*'#166'q3'#188#251#248 +#23#236#216#143'_'#254'2'#196#184#127'e'#136#178#249#9#245#0'0'#131#255#135 +#196#194#201']'#28#12'o'#158'1'#2#243#194'{'#6'MK'#225#7','#134'}&'#140'\' +#146'o'#137'm'''#1#4#16#176'&~C'#156#251#129#25#247#255#151#179'Q'#127#159 +#205'^zq'#143#0'0#23'#200'i~eP1'#250#4',u'#254#131'K'#23'`y'#9#172#11#254'2|' +#255#255#155#161'l2'#23#195#171#183#160#192#249#203#240#245#251#127#134'4' +#191'/'#12'A'#166'@'#15#128#202#12#160'ZP'#5#199#202#242#15'X'#172'21'#156 +#216#201#14'.'#197#172#29#159'3HX'#199#205'a'#209#173'Me'#0#213'OD4s'#0#2#8 +#152#132#136#201#3'L'#160#246#142#236#255#23#147#247'<<'#247'Z'#237#206#25'n' +'`e'#245#139#193#208#229#29#3'+'#176#181#249#15#234#1'P'#195#13#212#254#249 +#193#240#139#161'l'#10#15#195#227#151#160'x'#3#134#244#175#191#12#197#17#159 +#24'\5'#255'0|'#7#246#13#192#181'3'#16#131#250#10#127#129#153#250#248#14'v' +#134''''#192'ZZ'#30#216#0#180't'#254#246#143#195'n'#133#21#147#136#201'Ip' +#177'K'#160'X'#5#8' "<'#192#8#238#231#254#127#179'r'#210#151';'#235's'#207 +#237#22#5#182'6'#255#129'3'#174#130#238'7p'#11#19'\'#146#129#162#28#152#132 +#152#128#201#234'7'#176'F.'#159#206#195'p'#251#17#3'8'#185#252#7'f'#228#150 +#228#143#12#198#146'@'#15'|'#7#170#253#11'R'#11#245'00'#198#222'>g`8'#176#145 +#11',l'#227#242#130'A'#214'!f9'#155'i_'#28#184#253'A '#22#0#2#136#241#255#143 +#135#4'<'#0#204#184#255#190#137#254#127#214'u'#227#206#241'oB'#183#206'r3' +#136#202'|g0p'#2#182#161#24'A'#25#247#15#164#214#5#213'V'#127#255#131'K'#157 +#191#172#191#24#170#128#153#248#226'-'#144';'#127#2#165#191'2'#204')~'#198 +#160#200#245#135#225#231'w'#144'zh'#183#248'?#'#216'},,'#12#12'G'#183'q2'#220 +#184#192#206' &'#245#155#193#197#247#29#3#159']O*'#139'R'#196#28'B]^'#128#0#2 +#22#163#248'jb&'#144'-'#204#255#159'M'#157#254#254#230#225#212#139#251#5#192 +'=-}'#135#247#12#18#138#192'&'#195#175#127#208#218#21#218'p'#3':'#134#9#152 +#254#255#179'|b'#200#155#192#204'p'#224#244'o'#134#31'?'#190'0'#240'q'#254'd' +#216#213#13#236#7'0'#176'3'#252#254#205#4'v8'#24#255#131'$s'#22'`'#24#189'|' +#194#202'ph+'''#195#247'oL'#12#182#206'o'#25'T'#237','#142#177#185'n'#183#5 +#150'|'#255#24#240#212'U'#0#1#196#248#255#231'k'#28'R@'#147#153#185#24#254 +#127#191'c'#249#239'~'#195#177#139#251'8'#128#237'y'#14#6'a)`'#197#227#242#22 +#156'T'#254#131'C'#30#18#154#160'&'#201#255'_'#159#25#24#127#189'f`d'#251#192 +#144#212#205#205#176#227'8;'#3'++#'#131#134#252#31#134#141'-'#159#24'X'#191 +#177#3'c'#132#17'%'#244'!'#30'a'#4#246#220#254'3\>'#197#206'p'#10'h'#143#152 +#212#31#6'G'#239'O'#12#2#206'S'#147'X'#148'#'#231#255#255#5'j1c'#207#11#0#1#4 +'l'#204#225#242#0'3'#208'Q_'#153#24'^'#204#218#240#242#242'9'#223#243#251#249 +#129#142#254#195'`'#234#254#158#129#15'X'#243#130'K'#30#176#195#191'3'#128#2 +#225#255#175#15#192'T'#244#3#152'1'#255'3'#176'r'#255'e'#200#158#202#205#176 +'n?'''#176'Tb`p4'#254#201#176#160#20'XW|d'#7'F'#20#180#21#11#210#251#31#234 +#25#160#7'@'#234#190'~bb'#216#179#142#139#225#195';&'#6'=`'#221'b'#228'$'#248 +#134#195'i'#133#9#19#159#202'C\'#197'*@'#0#1#251#3'8*'#13'f`'#177#249'vW'#202 +#183#235'='#179#207#238#22'dx'#243#148#137'AA'#235'+'#131#158'-'#180#216#252 +#11#236#176#252'z'#7'q'#252#239'o'#208#16'b'#2'z'#0#24#154#192#142'|'#225',.' +#134#229';9'#193#238#139'r'#255#198'0!'#253';'#195#247'7'#28#144'J'#22'9'#244 +#161#158#0#137#131#242#194#221'k'#172#12''''#246'r'#2'{u'#255#24#156'=^3'#136 +#184'4'#213#179#234#151'7'#225'jb'#0#4#16#208#3#216'2'#9#208#208#191#223#152 +#254#223#171#188#244#224#244'}'#237#11#7#5#128#6#254'f0'#247#252#8'i'#235#255 +'x'#15#196#160#142#212'W'#184#195#25#224#14'b'#0#171')_'#192#193'0g'#19#23'8' +#191#150'F'#127'a'#168#142#252#201#240#249#25''''#196'xP'#218'g'#128#228#1 +#184#7#128'4$n'#24#25#246'm'#230'`x|'#143#133'AE'#227#7#131#149'+'#235'w.' +#231#5#14#204#130#26#167#254#255#197#244#4'@'#0'1'#130#186'|'#152#162#192#228 +#243'|I'#253#199#11#179#26#206#236#21'`'#248#248#134#145'A'#223#238'+'#131 +#162#230#7#134'_'#159#158#3'C'#254'=$'#243#130'39'#3''#253'c'#248#254#147#145'AU'#144#137#225#247#7#14 +#144'W!j'#193#201#8'B'#255#255#135#233#25'P,||'#203#196#176'k#'#7#176#24'fd0' ,'6'#253#196#160'k'#171#240#144#211#127#183'>#'#135#240'GH,@'#244#3#4#16#176 +'-'#244#9#225' `'#177#249#239#221'a'#255#31#23#235'V'#156#217#197#204#241#244 +'.;'#131#164#244's'#6's'#167#219#192'J'#246'?R'#146'A'#3#255#145'iFhFeb'#224 +#230#254#3')]>'#178'0'#252#133#217#137#150'q'#17#201#143#17#137#15#244#4#144 +#186'v'#145#133#225#220#9'6'#6'!'#225#191#12'N'#192'f'#139#128#215#204'tV' +#141#184'Y'#200#173'U'#128#0'b'#252#255#253#25#148#5#138#190#191#140#127'o' +#212#29'|z'#230#140#237#201'='#162#192#162#241#29#131#169#253']'#6')'#197'_' +#192'~.'#22#199#195#210'24d'#255'#'#197#6''''#223'o'#134#215#192#214#230'O`' +#4'K'#242'22'#252#254#194#10','#9#153#161#161#207#128#164#22'5'#255#192#138 +'UFFH'#251'p'#207#22'`k'#245#21#19#131#174#222#23'`'#203'W'#241'.'#151#203',' +'7&>'#185'{'#224#202#19#168#24' '#128#16'I'#8#148't^'#239#13#254'~'#186'p' +#205#241#157#252#12#143#175#255'`'#208#212#187#207'`h'#255#141#225#215'/&'#6 +'F'#140#14'7#j3'#5#230#25#160#185'\'#130#191#24#214#159'gdh'#152#195#11#204#3 +#140#12'%Q_'#24#178#189'~3|~'#194#13#14'ed'#143'b'#203#7#176#216'a'#5'f'#153 +#155'WX'#24'N'#29'e'#3'WtN'#14#175#24'$'#157'3'#230's8LL'#130'F3'#3'@'#0'1' +#254#255#246#20#210'Q'#249#247'S'#240#247#165#194'c'#183#143#220#213'8w'#144 +#131#225#239#215'g'#12#206'a'#31#24#132#196#255'AjO,'#30#128#187#28#158#137 +#129#169#144#229'?'#195'_'#254#239#12#190#21#130#12#151#238#178'0'#176#3#249 +','#172#12#12#139#170'?2'#216'H'#176'1|'#251#10#141#201#255#200#21#26#3#188 +'FF'#196#6'$'#193#130#236'>'#188#23'X|'#134'g7'#223'3'#24'X'#127'`'#208#183#254#9'l'#187 +#16'1J'#0'/'#22#129#161#198#254#143#225#29#235'w'#6#251'la'#134'o'#192#208#7 +#133#226#171#247'L'#12#149#177'_'#24'j'#253#254#1#139'd6D'#0#160#20#161#200 +#177#193#0#175'#@'#149#219#211#199'L'#12#135#246#176#1'['#2#12#12#214'V'#31 +#24#20#28'|7q8'#244#5#254'gb'#249#7#16'@'#192#138#236#27#176#216'|'#162#241 +#243'd'#218#174'K'#251'^'#202'^8'#248#135'AH'#232'3'#131'k'#196'W'#176#230 +#127#136#12#143#195#225'H'#17#1#138#1'`d2'#138'|c'#136'l'#225'e'#216'}'#146 +#131#129#21#200#151#145#248#195#176#176#18'X'#146#240#0'K'#149'oL'#224#252 +#198#0'u$f'#145#138#26' 0'#185#147'GY'#25#238#222'bf'#144#149#251#205'`k'#247 +#147#129'7`'#181#11#139#130#243'^'#128#0#2'w)'#255#156'/'#157#255#234#212#178 +#132#189#27#4#25#190#190#251#204'`'#238#242#141'A'#195#16#17#250#132#221#207 +#8#181#25#146#12'8x'#255'0'#220#250#244#155'a'#9'0'#234#191#0'c!'#194#17'X' +#163#202'33|~'#193#137#208#11#205#172#16#14#154#227'a-U'#168#28#168'X'#253 +#252#145#145'a'#255'n6`'#177#202#192'`'#1',V'#149#157#188#183's'#216#183#135 +#2#4#16#227#223'w'#23#149'~'#31#139#187'pz'#215'g'#222#139'G'#254'2'#168'h' +#127'g'#176#241#250#14#12'y'#228'l'#139#173'S'#129#228'-'#228#250#128#1#146#1 +#217'9'#255'1'#176#3#155#31#224'N'#229'WV`3'#156#133#1'6'#152#141'3'#217' {' +#0'-c'#131'b'#242#204'i'#22#134'k'#151#153#24#248#5#128#25#218#14#216'Z'#181 +'J'#171#0#8' '#198#159#135#194#214#222';|<'#232#216'.v'#160#175#127'0'#184 +#135'}e'#16#151#254#195#240#7#20#250#140'0w'#226#240#0'J'#249#143#164#10#173 +#161#134#226#207#255#140'X'#28#138#234#248#255#176#182#17#146#25#160'T'#247 +#253#27'0C'#31'dax'#254#140#137#193#196#232';'#131#166#185#210'E'#128#0'b' +#252#178'L'#242#235#177'='#28'\'#183'/'#253'e'#224#19#248#195#160#162#243#27 +'4_'#129#176#152#24#15#160#171#192'P'#142#233'Y'#6#168'g'#254'#'#139#161#201 +'!'#2#3'B'#129#154#24#175#128'u'#194#227'GL'#12'""'#255#24#28#236#254'|'#6#8 +' '#198'O'#243#249'~'#30#221#203#205'v'#255'&3'#216#225#191#177#142#177'b' +#203#5#216'<'#133#3#16'Q'#144'1'#18#161#14#236#9'`'#177#12'j'#205#8#240#3#27 +'z6?'#191#1#4#16#227#247#195#25's'#222#157'Z'#144#252#230'5'#27#195#175#159 +#12'h!O'#2#192#22#27#255#209#243#9'j'#168'"+'#254#143#174#30#222#232'D'#196 +#30','#169#177#0#163'B'#136#239#27#131#176#182#221'Q'#128#0#2#22#163#223#153 +#127#158','#169#248#247#250#152')'#19#167'0/0'#22#152'P'#156#131'3'#9#161'Y' +#136#236#30#228'b'#16'Y;,'#189#195'='#129#240#16#182#218#25#226'hF$'#243'@' +#28#214#127#255#190#190#249#193#200#175'z'#147#221',{*@'#0#13#249#197#30#0#1 +'4'#228'='#0#16'`'#0#215#29#169#167#169#214#253#188#0#0#0#0'IEND'#174'B`'#130 ]); tomboy-ng_0.39-1/kcontrols/source/kprintsetup.pas0000644000175000017500000003213714346341266022052 0ustar dbannondbannon{ @abstract(This file is part of the KControls component suite for Delphi and Lazarus.) @author(Tomas Krysl) Copyright (c) 2020 Tomas Krysl

License:
This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html. } unit kprintsetup; // lowercase name because of Lazarus/Linux {$include kcontrols.inc} interface uses {$IFDEF FPC} LCLType, LCLIntf, LResources, {$IFnDEF LCLWinCE}PrintersDlgs, {$ENDIF} {$ELSE} Windows, Messages, Dialogs, {$ENDIF} SysUtils, Variants, Classes, Graphics, Controls, Forms, StdCtrls, ExtCtrls, KControls, KPrintPreview; type TPrintEvent = procedure(PageSetup: TKPrintPageSetup) of object; TExtPrintOption = ( xpoRange, xpoScale ); TExtPrintOptions = set of TExtPrintOption; { TKPrintSetupForm } TKPrintSetupForm = class(TForm) BUConfigure: TButton; CoBPrinterName: TComboBox; EDTitle: TEdit; GBFileToPrint: TGroupBox; GBPrinter: TGroupBox; GBPrintOptions: TGroupBox; LBPrinterName: TLabel; BUPrint: TButton; BUCancel: TButton; CBFitToPage: TCheckBox; CBPageNumbers: TCheckBox; CBUseColor: TCheckBox; GBMargins: TGroupBox; CoBMarginUnits: TComboBox; LBMarginUnits: TLabel; CBMirrorMargins: TCheckBox; GBPageSelection: TGroupBox; RBAll: TRadioButton; RBRange: TRadioButton; RBSelectedOnly: TRadioButton; LBRangeTo: TLabel; LBCopies: TLabel; EDLeft: TEdit; LBLeft: TLabel; LBRight: TLabel; EDRight: TEdit; EDTop: TEdit; LBTop: TLabel; EDBottom: TEdit; LBBottom: TLabel; EDRangeFrom: TEdit; EDRangeTo: TEdit; EDCopies: TEdit; Label1: TLabel; EDPrintScale: TEdit; LBUnitsLeft: TLabel; LBUnitsTop: TLabel; LBUnitsRight: TLabel; LBUnitsBottom: TLabel; BUPreview: TButton; CBPaintSelection: TCheckBox; BUOk: TButton; CBPrintTitle: TCheckBox; CBCollate: TCheckBox; CBLineNumbers: TCheckBox; CBWrapLines: TCheckBox; procedure BUConfigureClick(Sender: TObject); procedure CoBMarginUnitsChange(Sender: TObject); procedure RBAllClick(Sender: TObject); procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); procedure BUPreviewClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure EDTopExit(Sender: TObject); procedure CBPageNumbersClick(Sender: TObject); procedure BUPrintClick(Sender: TObject); procedure FormShow(Sender: TObject); private { Private declarations } FPrevSetup: TKPrintPageSetup; FPageSetup: TKPrintPageSetup; FPreviewForm: TKCustomPrintPreviewForm; FPreviewCreated: Boolean; FSelAvail: Boolean; FUpdateLock: Boolean; FOnPrintClick: TPrintEvent; FOptionsVisible: TKPrintOptions; FOptionsEnabled: TKPrintOptions; FExtOptionsEnabled: TExtPrintOptions; {$IFnDEF LCLWinCE} FPSD: TPrinterSetupDialog; {$ENDIF} procedure SetPageSetup(const Value: TKPrintPageSetup); procedure SetPreviewForm(const Value: TKCustomPrintPreviewForm); protected procedure PageSetupToForm; virtual; procedure FormToPageSetup; virtual; procedure ValidateForm; public { Public declarations } property PageSetup: TKPrintPageSetup read FPageSetup write SetPageSetup; property PreviewForm: TKCustomPrintPreviewForm read FPreviewForm write SetPreviewForm; property SelAvail: Boolean read FSelAvail write FSelAvail; property OnPrintClick: TPrintEvent read FOnPrintClick write FOnPrintClick; property OptionsVisible: TKPrintOptions read FOptionsVisible write FOptionsVisible; property OptionsEnabled: TKPrintOptions read FOptionsEnabled write FOptionsEnabled; property ExtOptionsEnabled: TExtPrintOptions read FExtOptionsEnabled write FExtOptionsEnabled; end; implementation {$IFDEF FPC} {$R *.lfm} {$ELSE} {$R *.dfm} {$ENDIF} uses Printers, KFunctions, KRes, KMessageBox; procedure TKPrintSetupForm.FormCreate(Sender: TObject); begin FPageSetup := nil; FPrevSetup := TKPrintPageSetup.Create(nil); FPreviewForm := nil; FPreviewCreated := False; FOptionsVisible := [poCollate..poUseColor]; FOptionsEnabled := FOptionsVisible; FExtOptionsEnabled := [Low(TExtPrintOption)..High(TExtPrintOption)]; {$IfnDEF LCLWinCE} FPSD := TPrinterSetupDialog.Create(Self); {$IFDEF FPC} FPSD.Title := sPSPrinterSetup; {$ENDIF} {$ENDIF} end; procedure TKPrintSetupForm.FormDestroy(Sender: TObject); begin if FPreviewCreated then begin FPreviewForm.Free; FPreviewCreated := False; end; FPrevSetup.Free; end; procedure TKPrintSetupForm.FormShow(Sender: TObject); begin PageSetupToForm; end; procedure TKPrintSetupForm.PageSetupToForm; function FmtMargin(Value: Double): string; const Fmt = '%.*f'; var Precision: Integer; begin case FPageSetup.Units of puCM: Precision := 1; puMM: Precision := 0; puInch: Precision := 2; else Precision := 0; end; Result := Format(Fmt, [Precision, Value]); end; function FmtUnit: string; begin case FPageSetup.Units of puMM: Result := 'mm'; puInch: Result := '"'; puHundredthInch: Result := '".100'; else Result := 'cm'; end; end; procedure SetupCheckBox(CB: TCheckBox; Option: TKPrintOption); begin CB.Checked := Option in FPageSetup.Options; CB.Enabled := Option in FOptionsEnabled; CB.Visible := Option in FOptionsVisible; end; var S: string; begin if Assigned(FPageSetup) then begin FUpdateLock := True; try SetupCheckBox(CBCollate, poCollate); SetupCheckBox(CBFitToPage, poFitToPage); SetupCheckBox(CBPageNumbers, poPageNumbers); SetupCheckBox(CBUseColor, poUseColor); SetupCheckBox(CBPaintSelection, poPaintSelection); SetupCheckBox(CBPrintTitle, poTitle); SetupCheckBox(CBLineNumbers, poLineNumbers); SetupCheckBox(CBWrapLines, poWrapLines); SetupCheckBox(CBMirrorMargins, poMirrorMargins); try CoBPrinterName.Text := ''; CoBPrinterName.Items.Assign(Printer.Printers); CoBPrinterName.ItemIndex := CoBPrinterName.Items.IndexOf(FPageSetup.PrinterName); if FPageSetup.IsDefaultPrinter then begin if CoBPrinterName.ItemIndex < 0 then CoBPrinterName.ItemIndex := Printer.PrinterIndex; end else begin // no default printer selected! if CoBPrinterName.Items.Count > 0 then CoBPrinterName.ItemIndex := 0; end; except // silent, keep default or successfully obtained data end; RBSelectedOnly.Enabled := FPageSetup.SelAvail and FSelAvail; case FPageSetup.Range of prRange: RBRange.Checked := True; prAll: RBAll.Checked := True; prSelectedOnly: RBSelectedOnly.Checked := True; end; RBAll.Caption := Format(sPSAllPages, [FPageSetup.PageCount]); RBRange.Enabled := xpoRange in FExtOptionsEnabled; EDRangeFrom.Enabled := RBRange.Checked and RBRange.Enabled; EDRangeFrom.Text := IntToStr(FPageSetup.StartPage); EDRangeTo.Enabled := RBRange.Checked and RBRange.Enabled; EDRangeTo.Text := IntToStr(FPageSetup.EndPage); EDCopies.Text := IntToStr(FPageSetup.Copies); EDPrintScale.Enabled := not CBFitTopage.Checked and (xpoScale in FExtOptionsEnabled); EDPrintScale.Text := IntToStr(FPageSetup.Scale); EDTitle.Text := FPageSetup.Title; CoBMarginUnits.ItemIndex := Integer(FPageSetup.Units); S := FmtUnit; EDBottom.Text := FmtMargin(FPageSetup.UnitMarginBottom); LBUnitsBottom.Caption := S; EDLeft.Text := FmtMargin(FPageSetup.UnitMarginLeft); LBUnitsLeft.Caption := S; EDRight.Text := FmtMargin(FPageSetup.UnitMarginRight); LBUnitsRight.Caption := S; EDTop.Text := FmtMargin(FPageSetup.UnitMarginTop); LBUnitsTop.Caption := S; finally FUpdateLock := False; end; end; end; procedure TKPrintSetupForm.FormToPageSetup; var Options: TKPrintOptions; begin if Assigned(FPageSetup) and not FUpdateLock then begin FPageSetup.LockUpdate; try Options := []; if CBCollate.Checked then Include(Options, poCollate); if CBFitToPage.Checked then Include(Options, poFitToPage); if CBPageNumbers.Checked then Include(Options, poPageNumbers); if CBUseColor.Checked then Include(Options, poUseColor); if CBPaintSelection.Checked then Include(Options, poPaintSelection); if CBPrintTitle.Checked then Include(Options, poTitle); if CBMirrorMargins.Checked then Include(Options, poMirrorMargins); if CBLineNumbers.Checked then Include(Options, poLineNumbers); if CBWrapLines.Checked then Include(Options, poWrapLines); FPageSetup.PrinterName := CoBPrinterName.Text; FPageSetup.Options := Options; if RBSelectedOnly.Checked then FPageSetup.Range := prSelectedOnly else if RBRange.Checked then FPageSetup.Range := prRange else FPageSetup.Range := prAll; FPageSetup.StartPage := StrToIntDef(EDRangeFrom.Text, FPageSetup.StartPage); FPageSetup.EndPage := StrToIntDef(EDRangeTo.Text, FPageSetup.EndPage); FPageSetup.Copies := StrToIntDef(EDCopies.Text, FPageSetup.Copies); FPageSetup.Scale := StrToIntDef(EDPrintScale.Text, FPageSetup.Scale); FPageSetup.Title := EDTitle.Text; FPageSetup.Units := TKPrintUnits(CoBMarginUnits.ItemIndex); FPageSetup.UnitMarginBottom := StrToFloatDef(AdjustDecimalSeparator(EDBottom.Text), FPageSetup.UnitMarginBottom); FPageSetup.UnitMarginLeft := StrToFloatDef(AdjustDecimalSeparator(EDLeft.Text), FPageSetup.UnitMarginLeft); FPageSetup.UnitMarginRight := StrToFloatDef(AdjustDecimalSeparator(EDRight.Text), FPageSetup.UnitMarginRight); FPageSetup.UnitMarginTop := StrToFloatDef(AdjustDecimalSeparator(EDTop.Text), FPageSetup.UnitMarginTop); finally FPageSetup.UnlockUpdate; end; end; end; procedure TKPrintSetupForm.BUPrintClick(Sender: TObject); begin FormToPageSetup; if Assigned(FOnPrintClick) then FOnPrintClick(FPageSetup) else FPageSetup.PrintOut; end; procedure TKPrintSetupForm.BUConfigureClick(Sender: TObject); var PrinterCount: Integer; begin {$IFDEF LCLWinCE} KMsgBox(sPSErrPrintSetup, sPSErrPrinterConfiguration, [mbOk], miStop) {$ELSE} FormToPageSetup; if FPageSetup.IsDefaultPrinter then begin PrinterCount := 0; try PrinterCount := Printer.Printers.Count; Printer.Orientation := FPageSetup.Orientation; Printer.Copies := FPageSetup.Copies; if FPSD.Execute then begin FPageSetup.LockUpdate; try FPageSetup.Orientation := Printer.Orientation; FPageSetup.Copies := Printer.Copies; finally FPageSetup.UnlockUpdate; end; PageSetupToForm; end; except if PrinterCount = 0 then KMsgBox(sPSErrPrintSetup, sPSErrNoPrinterInstalled, [mbOk], miStop) else KMsgBox(sPSErrPrintSetup, sPSErrPrinterUnknown, [mbOk], miStop); end end else KMsgBox(sPSErrPrintSetup, sPSErrNoDefaultPrinter, [mbOk], miStop) {$ENDIF} end; procedure TKPrintSetupForm.EDTopExit(Sender: TObject); begin if not FUpdateLock then ValidateForm; end; procedure TKPrintSetupForm.CoBMarginUnitsChange(Sender: TObject); begin if Assigned(FPageSetup) then begin FPageSetup.Units := TKPrintUnits(CoBMarginUnits.ItemIndex); PageSetupToForm; end; end; procedure TKPrintSetupForm.CBPageNumbersClick(Sender: TObject); begin FormToPageSetup; end; procedure TKPrintSetupForm.RBAllClick(Sender: TObject); begin if not FUpdateLock then ValidateForm; end; procedure TKPrintSetupForm.SetPageSetup(const Value: TKPrintPageSetup); begin if Value <> FPageSetup then begin FPrevSetup.Assign(Value); FPageSetup := Value; PageSetupToForm; end; end; procedure TKPrintSetupForm.SetPreviewForm(const Value: TKCustomPrintPreviewForm); begin if Value <> FPreviewForm then begin if FPreviewCreated then begin FPreviewForm.Free; FPreviewCreated := False; end; FPreviewForm := Value; end; end; procedure TKPrintSetupForm.ValidateForm; begin FormToPageSetup; PageSetupToForm; end; procedure TKPrintSetupForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean); begin if FPreviewCreated then FPreviewForm.Hide; if ModalResult = mrOk then FormToPageSetup else if Assigned(FPageSetup) then FPageSetup.Assign(FPrevSetup); end; procedure TKPrintSetupForm.BUPreviewClick(Sender: TObject); begin ValidateForm; if FPreviewForm = nil then begin FPreviewForm := TKPrintPreviewForm.Create(nil); FPreviewCreated := True; end; if FPreviewForm is TKPrintPreviewForm then TKPrintPreviewForm(FPreviewForm).Preview.Control := FPageSetup.Control; FPreviewForm.Show; end; end. tomboy-ng_0.39-1/kcontrols/source/kedits.pas0000644000175000017500000020715114346341266020745 0ustar dbannondbannon{ @abstract(This file is part of the KControls component suite for Delphi and Lazarus.) @author(Tomas Krysl) Copyright (c) 2020 Tomas Krysl

License:
This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html. } unit kedits; // lowercase name because of Lazarus/Linux {$include kcontrols.inc} {$WEAKPACKAGEUNIT ON} interface uses {$IFDEF FPC} LCLType, LCLIntf, LMessages, LCLProc, LResources, {$ELSE} Windows, Messages, {$ENDIF} SysUtils, Classes, Controls, Forms, Graphics, StdCtrls, ComCtrls, Dialogs, KFunctions, KControls, KDialogs, KLog {$IFDEF USE_THEMES} , Themes {$IFNDEF FPC} , UxTheme {$ENDIF} {$ENDIF} ; const KM_NE_UPDATEUPDOWN = KM_BASE + 101; type TKLabelPosition = ( lpAbove, lpBelow, lpLeft, lpRight ); TKNumberEditAcceptedFormat = ( neafAscii, neafBin, neafDec, neafFloat, neafHex, neafOct ); TKNumberEditAcceptedFormats = set of TKNumberEditAcceptedFormat; TKNumberEditDisplayedFormat = ( nedfAsInput, nedfAscii, nedfBin, nedfDec, nedfFloat, nedfHex, nedfOct ); TKNumberEditHexPrefix = ( nehpC, nehpPascal ); TKNumberEditOption = ( neoKeepEmpty, neoLowerCase, neoUnsigned, neoUseLabel, neoUsePrefix, neoUseUpDown, neoWarning, neoClampToMinMax ); TKNumberEditOptions = set of TKNumberEditOption; const DefaultNumberEditOptions = [neoLowerCase, neoUseLabel, neoUsePrefix, neoUseUpDown, neoWarning, neoClampToMinMax]; type { TKNumberValue } TKNumberValue = class private FIVal: Int64; FFVal: Extended; FHasInt: Boolean; function GetFVal: Extended; function GetIVal: Int64; function GetUIVal: UInt64; procedure SetHasInt(const Value: Boolean); procedure SetIVal(const AValue: Int64); procedure SetFVal(const AValue: Extended); procedure SetUIVal(const AValue: UInt64); public constructor CreateEmpty; constructor CreateI(const AValue: Int64); constructor CreateF(const AValue: Extended); procedure Assign(const AValue: TKNumberValue); procedure Clear(AHasIntState: Boolean); function Clamp(const AMinimum, AMaximum: TKNumberValue; ASigned: Boolean = True): Boolean; function EqualsTo(const AValue: TKNumberValue): Boolean; function GreaterThan(const AValue: TKNumberValue; ASigned: Boolean = True): Boolean; function LowerThan(const AValue: TKNumberValue; ASigned: Boolean = True): Boolean; property IVal: Int64 read GetIVal write SetIVal; property FVal: Extended read GetFVal write SetFVal; property HasInt: Boolean read FHasInt write SetHasInt; property UIVal: UInt64 read GetUIVal write SetUIVal; end; { TKCustomNumberEdit } TKCustomNumberEdit = class(TCustomEdit) private FAcceptedFormats: TKNumberEditAcceptedFormats; FCustomSuffix: string; FDecimalSeparator: Char; FDisplayedFormat: TKNumberEditDisplayedFormat; {$IFDEF FPC} FFlat: Boolean; {$ENDIF} FFixedWidth: Integer; FHexPrefix: TKNumberEditHexPrefix; FLabel: TLabel; FLabelPosition: TKLabelPosition; FLabelSpacing: Cardinal; FLastInputFormat: TKNumberEditDisplayedFormat; FLog: TKLog; FMax: TKNumberValue; FMin: TKNumberValue; FOptions: TKNumberEditOptions; FPrecision: Integer; FRealUpDownStep: Extended; FUpdateUpDown: Boolean; FUpDown: TUpDown; FUpdownChanging: Boolean; FUpDownStep: Extended; FValue: TKNumberValue; FWarningColor: TColor; FOnUpDownChange: TNotifyEvent; procedure CMEnabledChanged(var Msg: TLMessage); message CM_ENABLEDCHANGED; procedure CMVisibleChanged(var Msg: TLMessage); message CM_VISIBLECHANGED; procedure CMBiDiModeChanged(var Msg: TLMessage); message CM_BIDIMODECHANGED; procedure KMNEUpdateUpDown(var Msg: TLMessage); message KM_NE_UPDATEUPDOWN; procedure WMPaste(var Msg: TLMPaste); message LM_PASTE; procedure WMKillFocus(var Msg: TLMKillFocus); message LM_KILLFOCUS; procedure WMMove(var Msg: TLMMove); message LM_MOVE; procedure WMSetFocus(var Msg: TLMSetFocus); message LM_SETFOCUS; procedure WMSize(var Msg: TLMSize); message LM_SIZE; protected procedure Change; override; {$IFDEF FPC} procedure CreateWnd; override; procedure DoOnChangeBounds; override; {$ENDIF} procedure DoWarning(AValue: TKNumberValue); virtual; function GetCaption: TCaption; virtual; procedure GetFormat(AText: string; var Fmt: TKNumberEditDisplayedFormat; AValue: TKNumberValue); virtual; function GetMax: Extended; virtual; function GetMaxAsInt: Int64; function GetMin: Extended; virtual; function GetMinAsInt: Int64; virtual; procedure GetPrefixSuffix(Format: TKNumberEditDisplayedFormat; out Prefix, Suffix: string); virtual; function GetRealSelStart: Integer; virtual; function GetRealSelLength: Integer; virtual; function GetSigned: Boolean; virtual; function GetValue: Extended; virtual; function GetValueAsInt: Int64; virtual; function GetValueAsText: string; virtual; function InspectInputChar(Key: Char): Char; virtual; function IsCaptionStored: Boolean; virtual; function IsCustomSuffixStored: Boolean; virtual; function IsMaxStored: Boolean; virtual; function IsMinStored: Boolean; virtual; function IsUpDownStepStored: Boolean; virtual; function IsValueStored: Boolean; virtual; procedure KeyPress(var Key: Char); override; procedure Notification(AComponent: TComponent; Operation: TOperation); override; procedure SafeSetFocus; virtual; procedure SetAcceptedFormats(AValue: TKNumberEditAcceptedFormats); virtual; procedure SetCaption(const AValue: TCaption); virtual; procedure SetCustomSuffix(const AValue: string); virtual; procedure SetDecimalSeparator(Value: Char); virtual; procedure SetDisplayedFormat(AValue: TKNumberEditDisplayedFormat); virtual; procedure SetFixedWidth(AValue: Integer); virtual; {$IFDEF FPC} procedure SetFlat(Value: Boolean); virtual; {$ENDIF} function SetFormat(AValue: TKNumberValue): string; virtual; procedure SetHexPrefix(AValue: TKNumberEditHexPrefix); virtual; procedure SetLabelPosition(Value: TKLabelPosition); virtual; procedure SetLabelSpacing(Value: Cardinal); virtual; procedure SetMax(AMax: Extended); virtual; procedure SetMaxAsInt(AMax: Int64); virtual; procedure SetMin(AMin: Extended); virtual; procedure SetMinAsInt(AMin: Int64); virtual; procedure SetName(const Value: TComponentName); override; procedure SetOptions(AValue: TKNumberEditOptions); virtual; procedure SetParent(AParent: TWinControl); override; procedure SetPrecision(AValue: Integer); virtual; procedure SetUpDownStep(AValue: Extended); virtual; procedure SetValue(AValue: Extended); virtual; procedure SetValueAsInt(AValue: Int64); virtual; procedure SetValueAsText(const AValue: string); virtual; procedure TextToValue; virtual; procedure UpdateFormats; virtual; procedure UpdateLabel; virtual; procedure UpdateMaxMin; virtual; procedure UpdateUpDown(AValue: TKNumberValue); virtual; procedure UpdateUpDownPos; virtual; procedure UpDownChange; virtual; procedure UpDownChangingEx(Sender: TObject; var AllowChange: Boolean; NewValue: {$IFDEF COMPILER19_UP}Integer{$ELSE}SmallInt{$ENDIF}; Direction: TUpDownDirection); procedure ValueToText; virtual; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; function Empty: Boolean; virtual; procedure Validate; virtual; property AcceptedFormats: TKNumberEditAcceptedFormats read FAcceptedFormats write SetAcceptedFormats default [neafDec]; property Caption: TCaption read GetCaption write SetCaption stored IsCaptionStored; property CustomSuffix: string read FCustomSuffix write SetCustomSuffix stored IsCustomSuffixStored; property DecimalSeparator: Char read FDecimalSeparator write SetDecimalSeparator; property DisplayedFormat: TKNumberEditDisplayedFormat read FDisplayedFormat write SetDisplayedFormat default nedfAsInput; property FixedWidth: Integer read FFixedWIdth write SetFixedWidth default 0; property HexPrefix: TKNumberEditHexPrefix read FHexPrefix write SetHexPrefix default nehpC; property LabelPosition: TKLabelPosition read FLabelPosition write SetLabelPosition default lpAbove; property LabelSpacing: Cardinal read FLabelSpacing write SetLabelSpacing default 3; property LastInputFormat: TKNumberEditDisplayedFormat read FLastInputFormat write FLastInputFormat; property Log: TKLog read FLog write FLog; property Max: Extended read GetMax write SetMax stored IsMaxStored; property MaxAsInt: Int64 read GetMaxAsInt write SetMaxAsInt; property Min: Extended read GetMin write SetMin stored IsMinStored; property MinAsInt: Int64 read GetMinAsInt write SetMinAsInt; property Options: TKNumberEditOptions read FOptions write SetOptions default DefaultNumberEditOptions; property Precision: Integer read FPrecision write SetPrecision default 2; property Signed: Boolean read GetSigned; property UpDownStep: Extended read FUpDownStep write SetUpDownStep stored IsUpDownStepStored; property Value: Extended read GetValue write SetValue stored IsValueStored; property ValueAsInt: Int64 read GetValueAsInt write SetValueAsInt; property ValueAsText: string read GetValueAsText write SetValueAsText; property WarningColor: TColor read FWarningColor write FWarningColor default clRed; property OnUpDownChange: TNotifyEvent read FOnUpDownChange write FOnUpDownChange; end; { TKNumberEdit } TKNumberEdit = class(TKCustomNumberEdit) published property AcceptedFormats; property Caption; property CustomSuffix; property DecimalSeparator; property DisplayedFormat; property FixedWidth; property HexPrefix; property LabelPosition; property LabelSpacing; property Log; property Max; property MaxAsInt; property Min; property MinAsInt; property Options; property Precision; property UpDownStep; property Value; property ValueAsInt; property WarningColor; property OnUpDownChange; property Anchors; property AutoSelect; property AutoSize; property BiDiMode; property BorderStyle; property Color; property Constraints; {$IFDEF FPC} { Specifies the same as Ctl3D in Delphi. } property Flat: Boolean read FFlat write SetFlat default False; {$ELSE} { Inherited property - see Delphi help. } property Ctl3D; {$ENDIF} property DragCursor; property DragKind; property DragMode; property Enabled; property Font; property HideSelection; property MaxLength; property ParentBiDiMode; property ParentColor; property ParentFont; property ParentShowHint; property PopupMenu; property ReadOnly; property ShowHint; property TabOrder; property TabStop; property Visible; property OnChange; property OnClick; property OnContextPopup; property OnDblClick; property OnDragDrop; property OnDragOver; property OnEndDock; property OnEndDrag; property OnEnter; property OnExit; property OnKeyDown; property OnKeyPress; property OnKeyUp; property OnMouseDown; {$IFDEF COMPILER9_UP} property OnMouseEnter; property OnMouseLeave; {$ENDIF} property OnMouseMove; property OnMouseUp; property OnStartDock; property OnStartDrag; end; TKFileNameEditButtonStyle = (fbNone, fbButton, fbBitBtn, fbSpeedBtn, fbUser); TKFileNameEditButtonAlign = (fbaRight, fbaLeft, fbaLeftDown, fbaRightDown); TKFileNameEditOption = (foFolderOnly, foSaveDialog, foAlwaysInitialDir, foAddToList, foCheckPath, foCorrectPath, foPathMustExist, foAddInitialDir, foCheckWithInitialDir, foWarning); TKFileNameEditOptions = set of TKFileNameEditOption; TKFileNameEditDlgProperties = class(TPersistent) private FInitialDir: TFolder; FDefaultExt: string; FFilter: string; FFilterIndex: Integer; FOpenOptions: TOpenOptions; FBrowseOptions: TKBrowseFolderOptions; FBrowseDlgLabel: string; function IsOpenOptionsStored: Boolean; function IsBrowseOptionsStored: Boolean; protected public constructor Create; published property BrowseDlgLabel: string read FBrowseDlgLabel write FBrowseDlgLabel; property BrowseOptions: TKBrowseFolderOptions read FBrowseOptions write FBrowseOptions stored IsBrowseOptionsStored; property DefaultExt: string read FDefaultExt write FDefaultExt; property Filter: string read FFilter write FFilter stored True; property FilterIndex: Integer read FFilterIndex write FFilterIndex default 1; property InitialDir: TFolder read FInitialDir write FInitialDir; property OpenOptions: TOpenOptions read FOpenOptions write FOpenOptions stored IsOpenOptionsStored; end; { TKFileNameEdit } TKFileNameEdit = class(TCustomComboBox) private FButton: TControl; FButtonAlign: TKFileNameEditButtonAlign; FButtonStyle: TKFileNameEditButtonStyle; FButtonText: TCaption; FButtonWidth: Integer; FButtonDist: Integer; {$IFDEF FPC} FFlat: Boolean; {$ENDIF} FLog: TKLog; FOptions: TKFileNameEditOptions; FWarningColor: TColor; FBtnOnClick: TNotifyEvent; FDlgProperties: TKFileNameEditDlgProperties; function GetFileName: TFileName; procedure SetFileName(const Value: TFileName); procedure SetButton(Value: TControl); function IsButtonStored: Boolean; procedure SetButtonAlign(Value: TKFileNameEditButtonAlign); procedure SetButtonStyle(Value: TKFileNameEditButtonStyle); procedure SetButtonText(const Value: TCaption); function IsButtonTextStored: Boolean; procedure SetButtonWidth(Value: Integer); procedure SetButtonDist(Value: Integer); function GetWholeWidth: Integer; function GetWholeLeft: Integer; {$IFDEF FPC} procedure SetFlat(Value: Boolean); {$ENDIF} procedure SetWholeWidth(Value: Integer); procedure SetWholeLeft(const Value: Integer); procedure SetOptions(Value: TKFileNameEditOptions); procedure UpdateButton; procedure CMEnabledChanged(var Msg: TLMessage); message CM_ENABLEDCHANGED; procedure CMVisibleChanged(var Msg: TLMessage); message CM_VISIBLECHANGED; procedure CMBiDiModeChanged(var Msg: TLMessage); message CM_BIDIMODECHANGED; procedure WMMove(var Msg: TLMMove); message LM_MOVE; procedure WMSize(var Msg: TLMSize); message LM_SIZE; protected procedure ButtonClick(Sender: TObject); virtual; procedure ButtonExit(Sender: TObject); virtual; procedure DoEnter; override; procedure DoExit; override; procedure DropDown; override; procedure KeyDown(var Key: Word; Shift: TShiftState); override; procedure SetParent(AParent: TWinControl); override; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure Notification(AComponent: TComponent; Operation: TOperation); override; published property Style; {Must be published before Items} property Anchors; property AutoSize; property BiDiMode; property Button: TControl read FButton write SetButton stored IsButtonStored; property ButtonAlign: TKFileNameEditButtonAlign read FButtonAlign write SetButtonAlign default fbaRight; property ButtonDist: Integer read FButtonDist write SetButtonDist default 8; property ButtonStyle: TKFileNameEditButtonStyle read FButtonStyle write SetButtonStyle default fbButton; property ButtonText: TCaption read FButtonText write SetButtonText stored IsButtonTextStored; property ButtonWidth: Integer read FButtonWidth write SetButtonWidth default 70; property CharCase; property Color; property Constraints; {$IFDEF FPC} { Specifies the same as Ctl3D in Delphi. } property Flat: Boolean read FFlat write SetFlat default False; {$ELSE} { Inherited property - see Delphi help. } property Ctl3D; {$ENDIF} property DlgProperties: TKFileNameEditDlgProperties read FDlgProperties; property DragCursor; property DragKind; property DragMode; property DropDownCount; property Enabled; property FileName: TFileName read GetFileName write SetFileName; property Font; property ItemHeight; property Log: TKLog read FLog write FLog; property MaxLength; property Options: TKFileNameEditOptions read FOptions write SetOptions default [foAddToList, foCheckPath, foWarning]; property ParentBiDiMode; property ParentColor; property ParentFont; property ParentShowHint; property PopupMenu; property ShowHint; property Sorted; property TabOrder; property TabStop; property Visible; property WarningColor: TColor read FWarningColor write FWarningColor default clRed; property WholeLeft: Integer read GetWholeLeft write SetWholeLeft stored False; property WholeWidth: Integer read GetWholeWidth write SetWholeWidth stored False; property OnChange; property OnClick; property OnContextPopup; property OnDblClick; property OnDragDrop; property OnDragOver; property OnDrawItem; property OnDropDown; property OnEndDock; property OnEndDrag; property OnEnter; property OnExit; property OnKeyDown; property OnKeyPress; property OnKeyUp; property OnMeasureItem; property OnMouseDown; {$IFDEF COMPILER9_UP} property OnMouseEnter; property OnMouseLeave; {$ENDIF} property OnMouseMove; property OnMouseUp; property OnStartDock; property OnStartDrag; property Items; { Must be published after OnMeasureItem } end; function CorrectPath(const S, InitialDir: TFileName; Options: TKFileNameEditOptions; out Err: Boolean; Log: TKLog): TFileName; function CorrectSubDirName(var S: string; out Warn: Boolean; Log: TKLog): Boolean; implementation uses ClipBrd, Buttons, Math, Types, TypInfo, KMessageBox, KRes; const IdStartCharSet = ['_', 'a'..'z', 'A'..'Z']; IdCharSet = ['0'..'9'] + IdStartCharSet; SubDirIllegalCharSet = [#0..#31, '<', '>', ':', '"', '/', '\', '|', '*', '?']; function CorrectPath(const S, InitialDir: TFileName; Options: TKFileNameEditOptions; out Err: Boolean; Log: TKLog): TFileName; function FindCharFromPos(const S: string; AChar: Char; ALen: Integer; var APos: Integer): Boolean; var Bk: Integer; begin {ignore multiple backslashes} while (APos < ALen) and (S[APos] = AChar) do Inc(APos); Bk := APos; while (Bk < ALen) and (S[Bk] <> AChar) do Inc(Bk); Result := Bk < ALen; end; var I, Len, K: Integer; B0, B, B1, B2, Warn, DirAdded: Boolean; T, T1: string; begin T := S; Err := False; DirAdded := False; Len := Length(T); K := 1; B0 := False; B := False; B1 := False; B2 := False; for I := 1 to Len do if T[I] = '/' then T[I] := '\'; if Len > 0 then begin {check drive} if CharInSetEx(UpCase(T[1]), ['A'..'Z']) and (T[2] = ':') then begin if (T[3] <> '\') then begin Insert('\', T, 3); Inc(Len); end; K := 4; end else if (S[1] = '.') and (S[2] = '\') then //check current dir K := 3 else if (S[1] = '.') and (S[2] = '.') and (S[3] = '\') then //check parent dir K := 4 { else //check protocol - not enabled begin I := 0; while not (S[I] in [':', '\']) do Inc(I); if (I <> 0) and (S[I] = ':') then begin T1 := LowerCase(Copy(S, 1, I - 1)); if (T1 = 'http') or (T1 = 'ftp') or (T1 = 'gopher') or (T1 = 'mailto') or (T1 = 'nntp') then K := Length(T1) + 2; end; end}; if K = 1 then begin if Options * [foCorrectPath, foAddInitialDir] <> [] then while CharInSetEx(T[1], SubDirIllegalCharSet) do Delete(T, 1, 1); if foAddInitialDir in Options then begin if InitialDir[Length(InitialDir)] = '\' then T := Format('%s%s', [InitialDir, T]) else T := Format('%s\%s', [InitialDir, T]); Len := Length(T); K := Length(InitialDir) + 2; B0 := True; if Assigned(Log) then Log.Log(lgNote, Format(sEDCurrentDirAdded, [S])); DirAdded := True; end; end; {check subdirectories} while (K < Len) and (FindCharFromPos(T, '\', Len, K) or (foFolderOnly in Options)) do begin {check or correct next subdirectory} if K < Len then begin I := K; while (I < Len) and (T[I] <> '\') do Inc(I); if T[I] <> '\' then Inc(I); T1 := Copy(T, K, I - K); if CorrectSubDirName(T1, Warn, nil) then begin if Warn then B := True; if (foCorrectPath in Options) or not Warn then begin Delete(T, K, I - K); Insert(T1, T, K); Len := Length(T); Inc(K, Length(T1) + 1); end else Inc(K, I - K + 1); end else Inc(K, Length(T1) + 1); end; end; {check file name} if not (foFolderOnly in Options) then begin if K < Len then begin T1 := Copy(T, K, Len - K + 1); if CorrectSubDirName(T1, Warn, nil) then begin if Warn then B := True; if (foCorrectPath in Options) or not Warn then begin Delete(T, K, Len - K); T := T + T1; end; end; end else B1 := True; end; {check for path presence} if foPathMustExist in Options then if foFolderOnly in Options then begin if not DirectoryExists(T) then B2 := True; end else if not B1 then begin if not (foCheckWithInitialDir in Options) or DirAdded then T1 := T else if (InitialDir = '') or (ExtractFilePath(T) <> '') then T1 := T else if InitialDir[Length(InitialDir)] = '\' then T1 := InitialDir + T else T1 := Format('%s\%s', [InitialDir, T]); if not FileExists(T1) then B2 := True; end; {log errors} if Assigned(Log) then begin if B then if foFolderOnly in Options then begin if foCorrectPath in Options then Log.Log(lgInputError, Format(sEDBadDirCorr, [S, T])) else if foCheckPath in Options then Log.Log(lgWarning, Format(sEDBadDir, [T])); end else if foCorrectPath in Options then Log.Log(lgInputError, Format(sEDBadPathCorr, [S, T])) else if foCheckPath in Options then Log.Log(lgWarning, Format(sEDBadPath, [T])); if B1 and (Options * [foCheckPath, foCorrectPath] <> []) then Log.Log(lgWarning, sEDMissingFileName); if B2 then if foFolderOnly in Options then Log.Log(lgWarning, Format(sEDNoExistingDir, [T])) else Log.Log(lgWarning, Format(sEDNoExistingPath, [T])); end; end; Err := B0 or B or B1 or B2; Result := T; end; function CorrectSubDirName(var S: string; out Warn: Boolean; Log: TKLog): Boolean; function IsSpecialName(const S: string): Boolean; var T: string; begin if S[4] = '.' then T := Copy(S, 1, 3) else T := S; Result := (T = 'AUX') or (T = 'PRN') or (T = 'CON'); end; var I, Len: Integer; T: string; begin Result := False; Warn := True; T := S; if Length(S) > 0 then begin if CharInSetEx(S[1], SubDirIllegalCharSet) then begin S[1] := '_'; Result := True; end; I := 2; Len := Length(S); while (I <= Len) do begin if CharInSetEx(S[I], SubDirIllegalCharSet) then begin Delete(S, I, 1); Dec(Len); Dec(I); Result := True; end; Inc(I); end; if IsSpecialName(UpperCase(S)) then begin S := '_' + S; Inc(Len); Result := True; end; while S[Len] = '.' do begin Delete(S, Len, 1); Dec(Len); Result := True; Warn := False; end; if S = '.' then begin S[1] := '_'; Result := True; end; end else begin S := '_'; Result := True; end; if Result and Warn and Assigned(Log) then Log.Log(lgInputError, Format(sEDBadSubDirName, [T, S])); end; { TKNumberValue } procedure TKNumberValue.Clear(AHasIntState: Boolean); begin if AHasIntState then IVal := 0 else FVal := 0; end; constructor TKNumberValue.CreateEmpty; begin IVal := 0; end; constructor TKNumberValue.CreateF(const AValue: Extended); begin FVal := AValue; end; constructor TKNumberValue.CreateI(const AValue: Int64); begin IVal := AValue; end; procedure TKNumberValue.Assign(const AValue: TKNumberValue); begin FFVal := AValue.FFVal; FIVal := AValue.FIVal; FHasInt := AValue.FHasInt; end; function TKNumberValue.Clamp(const AMinimum, AMaximum: TKNumberValue; ASigned: Boolean): Boolean; begin Result := False; if LowerThan(AMinimum, ASigned) then begin Assign(AMinimum); Result := True; end else if GreaterThan(AMaximum, ASigned) then begin Assign(AMaximum); Result := True; end; end; function TKNumberValue.EqualsTo(const AValue: TKNumberValue): Boolean; begin if FHasInt then Result := IVal = AValue.IVal else Result := FVal = AValue.FVal; end; function TKNumberValue.GetFVal: Extended; begin if FHasInt then Result := FIVal else Result := FFVal end; function TKNumberValue.GetIVal: Int64; const cMaxInt64F = 9.223372036854775807E+18; cMinInt64F = -9.223372036854775808E+18; {$IF DEFINED(FPC) OR DEFINED(COMPILER12_UP)} // maybe incorrect version, I don't know which Delphi version does not complain anymore cMaxInt64 = 9223372036854775807; cMinInt64 = -9223372036854775808; {$IFEND} begin if FHasInt then Result := FIVal else begin try try Result := Round(FFVal) except // try to clamp the value to Int64 limits // this requires the Extended type with sufficient precision, at least 10 bytes // might be not accurate when Extended is mapped to Double etc. {$IF DEFINED(FPC) OR DEFINED(COMPILER12_UP)} if FFVal > cMaxInt64F then Result := cMaxInt64 else if FFVal < cMinInt64F then Result := cMinInt64 else {$IFEND} Result := 0; end; except Result := 0; end; end; end; function TKNumberValue.GetUIVal: UInt64; const cMaxUInt64F = 1.8446744073709551615E+19; cMinUInt64F = 0E+01; // maybe incorrect version, I don't know which Delphi version does not complain anymore {$IF DEFINED(FPC) OR DEFINED(COMPILER12_UP)} cMaxUInt64 = 18446744073709551615; cMinUInt64 = 0; {$IFEND} begin if FHasInt then Result := UInt64(FIVal) else begin try try Result := Round(FFVal) except // try to clamp the value to UInt64 limits // this requires the Extended type with sufficient precision, at least 10 bytes // might be not accurate when Extended is mapped to Double etc. {$IF DEFINED(FPC) OR DEFINED(COMPILER12_UP)} if FFVal > cMaxUInt64F then Result := cMaxUInt64 else if FFVal < cMinUInt64F then Result := cMinUInt64 else {$IFEND} Result := 0; end; except Result := 0; end; end; end; function TKNumberValue.GreaterThan(const AValue: TKNumberValue; ASigned: Boolean): Boolean; begin if FHasInt then begin if ASigned then Result := IVal > AValue.IVal else Result := UIVal > AValue.UIVal end else Result := FVal > AValue.FVal; end; function TKNumberValue.LowerThan(const AValue: TKNumberValue; ASigned: Boolean): Boolean; begin if FHasInt then begin if ASigned then Result := IVal < AValue.IVal else Result := UIVal < AValue.UIVal end else Result := FVal < AValue.FVal; end; procedure TKNumberValue.SetFVal(const AValue: Extended); begin FFVal := AValue; FHasInt := False; end; procedure TKNumberValue.SetHasInt(const Value: Boolean); begin if Value <> HasInt then begin if Value then IVal := IVal else FVal := FVal; end; end; procedure TKNumberValue.SetIVal(const AValue: Int64); begin FIVal := AValue; FHasInt := True; end; procedure TKNumberValue.SetUIVal(const AValue: UInt64); begin FIVal := Int64(AValue); FHasInt := True; end; { TKNumberEdit } constructor TKCustomNumberEdit.Create(AOwner: TComponent); begin inherited; FMin := TKNumberValue.CreateI(0); FMax := TKNumberValue.CreateI(1000); FValue := TKNumberValue.CreateI(0); Text := ''; FWarningColor := clRed; FOptions := [neoLowerCase, neoUseLabel, neoUsePrefix, neoUseUpDown, neoWarning, neoClampToMinMax]; FAcceptedFormats := [neafDec]; FDecimalSeparator := GetFormatSettings.DecimalSeparator; FDisplayedFormat := nedfAsInput; FLastInputFormat := nedfDec; FFixedWidth := 0; FPrecision := 2; FCustomSuffix := ''; FLabelPosition := lpAbove; FLabelSpacing := 3; FLog := nil; FUpDown := TUpDown.Create(Self); FUpDown.TabStop := False; FUpDown.OnChangingEx := UpDownChangingEx; FUpDownStep := 1; FUpdownChanging := False; FUpdateUpDown := True; FLabel := TLabel.Create(Self); FLabel.FocusControl := Self; FOnUpDownChange := nil; end; destructor TKCustomNumberEdit.Destroy; begin FMin.Free; FMax.Free; FValue.Free; inherited; end; procedure TKCustomNumberEdit.Change; begin inherited; TextToValue; UpdateUpDown(FValue); end; {$IFDEF FPC} procedure TKCustomNumberEdit.CreateWnd; begin inherited; UpdateUpDownPos; UpdateLabel; end; procedure TKCustomNumberEdit.DoOnChangeBounds; begin inherited; UpdateUpDownPos; UpdateLabel; end; {$ENDIF} procedure TKCustomNumberEdit.DoWarning(AValue: TKNumberValue); var Fmt: TKNumberEditDisplayedFormat; begin if (ComponentState * [csLoading, csDesigning] = []) and HasParent then begin if neoWarning in FOptions then Font.Color := FWarningColor; if Assigned(FLog) then begin if FDisplayedFormat = nedfAsInput then Fmt := FLastInputFormat else Fmt := FDisplayedFormat; case Fmt of nedfDec: FLog.Log(lgInputError, Format(sEDBadIntValueAsStr, [SetFormat(FMin), SetFormat(FMax), SetFormat(AValue)])); nedfFloat: FLog.Log(lgInputError, Format(sEDBadFloatValueAsStr, [SetFormat(FMin), SetFormat(FMax), SetFormat(AValue)])); nedfHex: FLog.Log(lgInputError, Format(sEDBadHexValueAsStr, [SetFormat(FMin), SetFormat(FMax), SetFormat(AValue)])); end; end; end; end; function TKCustomNumberEdit.Empty: Boolean; begin Result := (Text = '') or (Text = '-'); end; function TKCustomNumberEdit.GetCaption: TCaption; begin Result := FLabel.Caption; end; procedure TKCustomNumberEdit.GetFormat(AText: string; var Fmt: TKNumberEditDisplayedFormat; AValue: TKNumberValue); var I: Int64; D: Extended; Code: Integer; W: Byte; K: Integer; begin AValue.Clear(True); if AText = '' then Exit; if FCustomSuffix <> '' then begin K := Pos(FCustomSuffix, AText); if (K > 0) and (K = Length(AText) - Length(FCustomSuffix) + 1) then Delete(AText, K, Length(CustomSuffix)); while (AText <> '') and (AText[Length(AText)] = ' ') do SetLength(AText, Length(AText) - 1); end; if AText = '' then Exit; // decimal integer - most probable if neafDec in FAcceptedFormats then begin I := DecStrToInt(AText, Code); if (Code = 0) then begin Fmt := nedfDec; AValue.IVal := I; Exit; end; end; // hexadecimal integer if neafHex in FAcceptedFormats then begin if FFixedWidth > 0 then W := FFixedWidth else W := 8; // 32 bit I := HexStrToInt(AText, W, Signed, Code); if (Code = 0) then begin Fmt := nedfHex; AValue.IVal := I; Exit; end; end; // binary integer if neafBin in FAcceptedFormats then begin if FFixedWidth > 0 then W := FFixedWidth else W := 16; // 16 bit I := BinStrToInt(AText, W, Signed, Code); if (Code = 0) then begin Fmt := nedfBin; AValue.IVal := I; Exit; end; end; // octal integer if neafOct in FAcceptedFormats then begin I := OctStrToInt(AText, Code); if (Code = 0) then begin Fmt := nedfBin; AValue.IVal := I; Exit; end; end; // double - custom suffix only if neafFloat in FAcceptedFormats then begin K := Pos('.', AText); if K = 0 then K := Pos(',', AText); if K = 0 then K := Pos(DecimalSeparator, AText); if K > 0 then AText[K] := '.'; Val(AText, D, Code); if (Code = 0) then begin Fmt := nedfFloat; AValue.FVal := D; Exit; end; end; // ascii - least probable if neafAscii in FAcceptedFormats then begin if FFixedWidth > 0 then W := FFixedWidth else W := 4; // 32 bit AValue.IVal := AsciiToInt(AText, W); Fmt := nedfAscii; end; end; function TKCustomNumberEdit.GetMax: Extended; begin Result := FMax.FVal; end; function TKCustomNumberEdit.GetMaxAsInt: Int64; begin Result := FMax.IVal; end; function TKCustomNumberEdit.GetMin: Extended; begin Result := FMin.FVal; end; function TKCustomNumberEdit.GetMinAsInt: Int64; begin Result := FMin.IVal; end; procedure TKCustomNumberEdit.GetPrefixSuffix(Format: TKNumberEditDisplayedFormat; out Prefix, Suffix: string); begin Prefix := ''; Suffix := ''; case Format of nedfBin: if neoLowerCase in FOptions then Suffix := 'b' else Suffix := 'B'; nedfHex: if neoUsePrefix in FOptions then case FHexPrefix of nehpPascal: Prefix := '$'; nehpC: Prefix := '0x'; end else if neoLowerCase in FOptions then Suffix := 'h' else Suffix := 'H'; nedfOct: if neoLowerCase in FOptions then Suffix := 'o' else Suffix := 'O'; end; end; function TKCustomNumberEdit.GetRealSelLength: Integer; begin if Sellength >= 0 then Result := SelLength else Result := -SelLength; end; function TKCustomNumberEdit.GetRealSelStart: Integer; begin if Sellength >= 0 then Result := SelStart else Result := SelStart - SelLength; end; function TKCustomNumberEdit.GetSigned: Boolean; begin Result := not (neoUnsigned in FOptions); end; function TKCustomNumberEdit.GetValue: Extended; begin TextToValue; Result := FValue.FVal; end; function TKCustomNumberEdit.GetValueAsInt: Int64; begin TextToValue; Result := FValue.IVal; end; function TKCustomNumberEdit.GetValueAsText: string; begin TextToValue; Result := SetFormat(FValue); end; function TKCustomNumberEdit.InspectInputChar(Key: Char): Char; var S: string; KeyDec, KeyHex, KeyBin, KeyOct, KeyFLoat, KeySuffix: Char; begin S := Copy(Text, 1, GetRealSelStart) + Copy(Text, GetRealSelStart + GetRealSelLength + 1, Length(Text)); if neafAscii in FAcceptedFormats then Result := Key else begin Result := #0; if neafDec in FAcceptedFormats then begin KeyDec := Key; if CharInSetEx(KeyDec, ['0'..'9','-',#8]) then begin if (KeyDec = '-') and (SelStart <> 0) then KeyDec := #0; if (Pos('0', S) = 1) and (neafOct in FAcceptedFormats) then KeyDec := #0; end else KeyDec := #0; end else KeyDec := #0; if neafHex in FAcceptedFormats then begin KeyHex := Key; if CharInSetEx(KeyHex, ['0'..'9', 'a'..'f', 'A'..'F', #8, 'x', 'X', 'h', 'H']) then begin if CharInSetEx(KeyHex, ['x', 'X']) and ((SelStart > 1) or (Pos('x', S) <> 0) or (Pos('X', S) <> 0)) then KeyHex := #0; if CharInSetEx(KeyHex, ['h', 'H']) and ((SelStart < Length(S)) or (Pos('h', S) <> 0) or (Pos('H', S) <> 0)) then KeyHex := #0; if neoLowerCase in FOptions then begin if CharInSetEx(KeyHex, ['A'..'F', 'X']) then Inc(KeyHex, Ord('a') - Ord('A')); end else if CharInSetEx(KeyHex, ['a'..'f', 'x']) then Inc(KeyHex, Ord('A') - Ord('a')); end else KeyHex := #0; end else KeyHex := #0; if neafBin in FAcceptedFormats then begin KeyBin := Key; if CharInSetEx(KeyBin, ['0'..'1', 'b', 'B', #8]) then begin if CharInSetEx(KeyBin, ['b', 'B']) and ((SelStart < Length(S)) or (Pos('b', S) <> 0) or (Pos('B', S) <> 0)) then KeyBin := #0; end else KeyBin := #0; end else KeyBin := #0; if neafOct in FAcceptedFormats then begin KeyOct := Key; if CharInSetEx(KeyOct, ['0'..'7', #8]) then begin if (Pos('0', S) > 1) then KeyOct := #0; end else KeyOct := #0; end else KeyOct := #0; if neafFloat in FAcceptedFormats then begin KeyFloat := Key; if CharInSetEx(KeyFLoat, ['0'..'9','-', '.', ',', 'e', 'E', DecimalSeparator, #8]) then begin if (KeyFloat = '-') and (SelStart <> 0) then KeyFloat := #0; if CharInSetEx(KeyFLoat, ['.', ',', DecimalSeparator]) and ((Pos('.', S) <> 0) or (Pos(',', S) <> 0) or (Pos(DecimalSeparator, S) <> 0)) then KeyFloat := #0; end else KeyFloat := #0; end else KeyFLoat := #0; if FCustomSuffix <> '' then begin if (Pos(Key, FCustomSuffix) <> 0) or (Key = ' ') then KeySuffix := Key else KeySuffix := #0; end else KeySuffix := #0; if KeyFloat <> #0 then Result := KeyFLoat; if KeyBin <> #0 then Result := KeyBin; if KeyHex <> #0 then Result := KeyHex; if KeyDec <> #0 then Result := KeyDec; if KeyOct <> #0 then Result := KeyOct; if KeySuffix <> #0 then Result := KeySuffix; end; end; function TKCustomNumberEdit.IsCaptionStored: Boolean; begin Result := FLabel.Caption <> Name; end; function TKCustomNumberEdit.IsCustomSuffixStored: Boolean; begin Result := FCustomSuffix <> ''; end; function TKCustomNumberEdit.IsMaxStored: Boolean; begin Result := FMax.IVal <> 1000; end; function TKCustomNumberEdit.IsMinStored: Boolean; begin Result := FMin.IVal <> 0; end; function TKCustomNumberEdit.IsUpDownStepStored: Boolean; begin Result := FUpDownStep <> 1; end; function TKCustomNumberEdit.IsValueStored: Boolean; begin Result := GetValue <> 0; end; procedure TKCustomNumberEdit.KeyPress(var Key: Char); begin inherited; if Key >= #32 then begin Key := InspectInputChar(Key); if Key <> #0 then Font.Color := clWindowText; end end; procedure TKCustomNumberEdit.Notification(AComponent: TComponent; Operation: TOperation); begin inherited; if Operation = opRemove then if AComponent = FUpDown then FUpDown := nil else if AComponent = FLabel then FLabel := nil; end; procedure TKCustomNumberEdit.SafeSetFocus; var Form: TCustomForm; begin Form := GetParentForm(Self); if (Form <> nil) and Form.Visible and Form.Enabled and Visible and Enabled then Form.ActiveControl := Self; end; procedure TKCustomNumberEdit.SetAcceptedFormats(AValue: TKNumberEditAcceptedFormats); begin if AValue <> FAcceptedFormats then begin TextToValue; FAcceptedFormats := AValue; UpdateFormats; UpdateMaxMin; ValueToText; end; end; procedure TKCustomNumberEdit.SetCaption(const AValue: TCaption); begin FLabel.SetTextBuf(PChar(AValue)); end; procedure TKCustomNumberEdit.SetCustomSuffix(const AValue: string); begin if AValue <> FCustomSuffix then begin TextToValue; FCustomSuffix := AValue; ValueToText; end; end; procedure TKCustomNumberEdit.SetDecimalSeparator(Value: Char); begin if Value <> FDecimalSeparator then begin FDecimalSeparator := Value; SetValue(GetValue); end; end; procedure TKCustomNumberEdit.SetDisplayedFormat(AValue: TKNumberEditDisplayedFormat); begin if FDisplayedFormat <> AValue then begin TextToValue; FDisplayedFormat := AValue; UpdateFormats; UpdateMaxMin; ValueToText; end; end; procedure TKCustomNumberEdit.SetFixedWidth(AValue: Integer); begin if FFixedWidth <> AValue then begin TextToValue; FFixedWidth := AValue; ValueToText; end; end; {$IFDEF FPC} procedure TKCustomNumberEdit.SetFlat(Value: Boolean); begin if Value <> FFlat then begin FFlat := Value; Invalidate; end; end; {$ENDIF} function TKCustomNumberEdit.SetFormat(AValue: TKNumberValue): string; var Prefix, Suffix: string; A: ShortString; W: Byte; J: Integer; F, G: Extended; Fmt: TKNumberEditDisplayedFormat; begin Result := ''; if FDisplayedFormat = nedfAsInput then begin if Frac(AValue.FVal) <> 0 then Fmt := nedfFloat else Fmt := FLastInputFormat; end else Fmt := FDisplayedFormat; GetPrefixSuffix(Fmt, Prefix, Suffix); case Fmt of nedfAscii: begin if FFixedWidth > 0 then W := FFixedWidth else W := 4; Result := IntToAscii(AValue.IVal, W); end; nedfBin: begin if FFixedWidth > 0 then W := FFixedWidth else W := 16; Result := IntToBinStr(AValue.IVal, W, Suffix); end; nedfDec: begin if Signed then Result := IntToDecStr(AValue.IVal, FFixedWidth) else Result := UIntToDecStr(AValue.IVal, FFixedWidth) end; nedfFloat: begin if FPrecision < 0 then begin Result := FloatToStrF(AValue.FVal, ffGeneral, 15, 15); end else if FPrecision > 0 then begin Str(AValue.FVal:FFixedWidth:FPrecision, A); Result := string(A); end else begin // determine number of valid decimal digits W := 0; F := AValue.FVal; G := Frac(F); while not (IsZero(G, 1E-10) or IsZero(1 - G, 1E-10)) do begin F := F * 10; G := Frac(F); Inc(W); end; Str(AValue.FVal:FFixedWidth:W, A); Result := string(A); end; J := Pos('.', Result); if J = 0 then J := Pos(',', Result); if J > 0 then Result[J] := FDecimalSeparator; end; nedfHex: begin if FFixedWidth > 0 then W := FFixedWidth else W := 8; Result := IntToHexStr(AValue.IVal, W, Prefix, Suffix, neoLowerCase in FOptions); end; nedfOct: begin Result := IntToOctStr(AValue.IVal); end; end; if (Result <> '') and (FCustomSuffix <> '') then Result := Result + ' ' + FCustomSuffix; end; procedure TKCustomNumberEdit.SetHexPrefix(AValue: TKNumberEditHexPrefix); begin if FHexPrefix <> AValue then begin TextToValue; FHexPrefix := AValue; ValueToText; end; end; procedure TKCustomNumberEdit.SetLabelPosition(Value: TKLabelPosition); begin if Value <> FLabelPosition then begin FLabelPosition := Value; UpdateLabel; end; end; procedure TKCustomNumberEdit.SetLabelSpacing(Value: Cardinal); begin if Value < 1 then Value := 1; if Value <> FLabelSpacing then begin FLabelSpacing := Value; UpdateLabel; end; end; procedure TKCustomNumberEdit.SetMax(AMax: Extended); begin if AMax <> FMax.FVal then begin TextToValue; FMax.FVal := AMax; UpdateMaxMin; ValueToText; end; end; procedure TKCustomNumberEdit.SetMaxAsInt(AMax: Int64); begin if AMax <> FMax.IVal then begin TextToValue; FMax.IVal := AMax; UpdateMaxMin; ValueToText; end; end; procedure TKCustomNumberEdit.SetMin(AMin: Extended); begin if AMin <> FMin.FVal then begin TextToValue; FMin.FVal := AMin; UpdateMaxMin; ValueToText; end; end; procedure TKCustomNumberEdit.SetMinAsInt(AMin: Int64); begin if AMin <> FMin.IVal then begin TextToValue; FMin.IVal := AMin; UpdateMaxMin; ValueToText; end; end; procedure TKCustomNumberEdit.SetName(const Value: TComponentName); var S: string; begin S := Name; inherited; if (Text = S) or (Text = Value) or (FLabel.Caption = S) then begin if (Text = S) or (Text = Value) then Text := '0'; if (FLabel <> nil) and (csSetCaption in ControlStyle) then FLabel.SetTextBuf(PChar(Name)); end; end; procedure TKCustomNumberEdit.SetOptions(AValue: TKNumberEditOptions); begin if FOptions <> AValue then begin TextToValue; FOptions := AValue; UpdateLabel; UpdateMaxMin; ValueToText; end; end; procedure TKCustomNumberEdit.SetParent(AParent: TWinControl); begin inherited; UpdateUpDown(FValue); UpdateLabel; end; procedure TKCustomNumberEdit.SetPrecision(AValue: Integer); begin if FPrecision <> AValue then begin TextToValue; FPrecision := AValue; ValueToText; end; end; procedure TKCustomNumberEdit.SetUpDownStep(AValue: Extended); begin if FUpDownStep <> AValue then begin TextToValue; FUpDownStep := AValue; ValueToText; end; end; procedure TKCustomNumberEdit.SetValue(AValue: Extended); var Warn: Boolean; begin Font.Color := clWindowText; FValue.FVal := AValue; if neoClampToMinMax in FOptions then Warn := FValue.Clamp(FMin, FMax, Signed) else Warn := False; ValueToText; UpdateUpDown(FValue); if Warn then DoWarning(FValue); end; procedure TKCustomNumberEdit.SetValueAsInt(AValue: Int64); var Warn: Boolean; begin Font.Color := clWindowText; FValue.IVal := AValue; if neoClampToMinMax in FOptions then Warn := FValue.Clamp(FMin, FMax, Signed) else Warn := False; ValueToText; UpdateUpDown(FValue); if Warn then DoWarning(FValue); end; procedure TKCustomNumberEdit.SetValueAsText(const AValue: string); var Fmt: TKNumberEditDisplayedFormat; Warn: Boolean; begin Font.Color := clWindowText; Fmt := nedfAsInput; GetFormat(AValue, Fmt, FValue); if neoClampToMinMax in FOptions then Warn := FValue.Clamp(FMin, FMax, Signed) else Warn := False; ValueToText; UpdateUpDown(FValue); if Warn then DoWarning(FValue); end; procedure TKCustomNumberEdit.TextToValue; begin GetFormat(Text, FLastInputFormat, FValue); if neoClampToMinMax in FOptions then if FValue.Clamp(FMin, FMax, Signed) then DoWarning(FValue); end; procedure TKCustomNumberEdit.UpdateFormats; var Fmt: TKNumberEditDisplayedFormat; Fmts: set of TKNumberEditDisplayedFormat; begin if FAcceptedFormats = [] then FAcceptedFormats := [neafDec]; Fmts := []; Fmt := nedfAsInput; if (neafAscii in FAcceptedFormats) then begin Include(Fmts, nedfAscii); Fmt := nedfAscii end; if (neafBin in FAcceptedFormats) then begin Include(Fmts, nedfBin); Fmt := nedfBin end; if (neafOct in FAcceptedFormats) then begin Include(Fmts, nedfOct); Fmt := nedfOct end; if (neafFloat in FAcceptedFormats) then begin Include(Fmts, nedfFloat); Fmt := nedfFloat end; if (neafHex in FAcceptedFormats) then begin Include(Fmts, nedfHex); Fmt := nedfHex end; if (neafDec in FAcceptedFormats) then begin Include(Fmts, nedfDec); Fmt := nedfDec end; if not (FDisplayedFormat in Fmts) then begin FDisplayedFormat := nedfAsInput; FLastInputFormat := Fmt; end; end; procedure TKCustomNumberEdit.UpdateLabel; var P: TPoint; begin if FLabel <> nil then if neoUseLabel in FOptions then begin case FLabelPosition of lpAbove: P := Point(Left, Top - FLabel.Height - Integer(FLabelSpacing)); lpBelow: P := Point(Left, Top + Height + Integer(FLabelSpacing)); lpLeft: P := Point(Left - Math.Max(Integer(FLabelSpacing), FLabel.Width + 3), Top + (Height - FLabel.Height) div 2); lpRight: P := Point(Left + Width + Integer(FLabelSpacing), Top + (Height - FLabel.Height) div 2); end; FLabel.Left := P.X; FLabel.Top := P.Y; FLabel.Parent := Parent end else FLabel.Parent := nil; end; procedure TKCustomNumberEdit.UpdateMaxMin; begin try if (neafHex in FAcceptedFormats) or (FDisplayedFormat = nedfHex) then begin if Signed then begin FMin.IVal := KFunctions.MinMax(FMin.IVal, Low(Integer), High(Integer)); FMax.IVal := KFunctions.MinMax(FMax.IVal, Low(Integer), High(Integer)); if FMax.LowerThan(FMin, True) then FMax.Assign(FMin); end else begin FMin.IVal := KFunctions.MinMax(FMin.IVal, 0, High(LongWord)); FMax.IVal := KFunctions.MinMax(FMax.IVal, 0, High(LongWord)); if FMax.LowerThan(FMin, False) then FMax.Assign(FMin); end; end else begin if FMax.LowerThan(FMin, Signed) then FMax.Assign(FMin); end; except FMin.IVal := 0; FMax.IVal := 1000; end; end; procedure TKCustomNumberEdit.UpdateUpDown(AValue: TKNumberValue); var Fmt: TKNumberEditDisplayedFormat; AbsMax, D, PP: Extended; begin if FUpdateUpdown and (FUpDown <> nil) then if neoUseUpDown in FOptions then begin AbsMax := Math.Max(Abs(FMax.FVal), Abs(FMin.FVal)); if FDisplayedFormat = nedfAsInput then Fmt := FLastInputFormat else Fmt := FDisplayedFormat; D := 1; case Fmt of nedfDec: D := MinMax(FUpDownStep, 1, Math.Max(AbsMax / 10, 1)); nedfHex: D := MinMax(FUpDownStep, 1, Math.Max(AbsMax / 16, 1)); nedfOct: D := MinMax(FUpDownStep, 1, Math.Max(AbsMax / 8, 1)); nedfBin: D := MinMax(FUpDownStep, 1, Math.Max(AbsMax / 2, 1)); nedfFloat: begin PP := IntPower(10, FPrecision); D := MinMax(FUpDownStep * PP, 1, Math.Max(AbsMax * PP / 10, 1)) / PP; end; end; // UpDown min, max and position are ShortInt! (ough) // - must increase the order accordingly if absolute maximum number has more digits while AbsMax / D > 30000 do case Fmt of nedfDec, nedfFloat: D := D * 10; nedfHex: D := D * 16; nedfOct: D := D * 8; nedfBin: D := D * 2; end; FUpdownChanging := True; try FUpDown.Min := Trunc(FMin.FVal / D); FUpDown.Max := Trunc(FMax.FVal / D); FUpDown.Position := Trunc(AValue.FVal / D); FUpDown.Parent := Parent; FRealUpDownStep := D; finally FUpdownChanging := False; end; end else FUpDown.Parent := nil; end; procedure TKCustomNumberEdit.UpdateUpDownPos; begin if FUpDown <> nil then FUpDown.SetBounds(Left + Width, Top, FUpDown.Width, Height); end; procedure TKCustomNumberEdit.UpDownChange; begin if Assigned(FOnUpDownChange) then FOnUpDownChange(Self); end; procedure TKCustomNumberEdit.UpDownChangingEx(Sender: TObject; var AllowChange: Boolean; NewValue: {$IFDEF COMPILER19_UP}Integer{$ELSE}SmallInt{$ENDIF}; Direction: TUpDownDirection); var V: Extended; begin if (neoUseUpDown in FOptions) and (FUpDown <> nil) and not FUpdownChanging then begin SafeSetFocus; Font.Color := clWindowText; FUpdateUpDown := False; V := MinMax(NewValue * FRealUpDownStep, FMin.FVal, FMax.FVal); if V <> Value then begin if (DisplayedFormat = nedfAsInput) and (neafDec in AcceptedFormats) and (Frac(V) = 0) then LastInputFormat := nedfDec; Value := V; UpDownChange; FUpdateUpDown := True; PostMessage(Handle, KM_NE_UPDATEUPDOWN, 0, 0); end; end; end; procedure TKCustomNumberEdit.Validate; var Fmt: TKNumberEditDisplayedFormat; begin if Empty and (neoKeepEmpty in FOptions) then Exit; Fmt := nedfAsInput; GetFormat(Text, Fmt, FValue); if (Fmt = nedfAsInput) and (neoClampToMinMax in FOptions) then FValue.Clamp(FMin, FMax, Signed) else FLastInputFormat := Fmt; Text := SetFormat(FValue); if (Fmt = nedfAsInput) and (ComponentState * [csLoading, csDesigning] = []) and HasParent then begin if neoWarning in FOptions then Font.Color := FWarningColor; if Assigned(FLog) then FLog.Log(lgInputError, sEDFormatNotAccepted); end; end; procedure TKCustomNumberEdit.ValueToText; begin Text := SetFormat(FValue); end; procedure TKCustomNumberEdit.KMNEUpdateUpDown(var Msg: TLMessage); begin TextToValue; UpdateUpDown(FValue); end; procedure TKCustomNumberEdit.CMBiDiModeChanged(var Msg: TLMessage); begin inherited; if FLabel <> nil then FLabel.BiDiMode := BidiMode; end; procedure TKCustomNumberEdit.CMEnabledChanged(var Msg: TLMessage); begin inherited; if FLabel <> nil then FLabel.Enabled := Enabled; if FUpDown <> nil then FUpDown.Enabled := Enabled; end; procedure TKCustomNumberEdit.CMVisibleChanged(var Msg: TLMessage); begin inherited; if FLabel <> nil then FLabel.Visible := Visible; if FUpDown <> nil then FUpDown.Visible := Visible; end; procedure TKCustomNumberEdit.WMKillFocus(var Msg: TLMKillFocus); begin inherited; Validate; end; procedure TKCustomNumberEdit.WMSetFocus(var Msg: TLMSetFocus); begin inherited; Font.Color := clWindowText; end; procedure TKCustomNumberEdit.WMMove(var Msg: TLMMove); begin inherited; UpdateUpDownPos; UpdateLabel; end; procedure TKCustomNumberEdit.WMPaste(var Msg: TLMPaste); var S: string; I: Integer; begin if ClipBoard.HasFormat(CF_TEXT) then begin S := ClipBoard.AsText; for I := 1 to Length(S) do if (InspectInputChar(S[I]) = #0) and not (csDesigning in ComponentState) then begin Font.Color := WarningColor; if Assigned(FLog) then FLog.Log(lgError, sEDClipboardFmtNotAccepted); SelLength := 0; Exit; end; Font.Color := clWindowText; inherited; end; end; procedure TKCustomNumberEdit.WMSize(var Msg: TLMSize); begin inherited; UpdateUpDownPos; UpdateLabel; end; { TKFileNameEditDlgProperties } constructor TKFileNameEditDlgProperties.Create; begin FInitialDir := ''; FDefaultExt := ''; FFilter := sEDAllFiles; FFilterIndex := 1; FOpenOptions := [ofHideReadOnly, ofEnableSizing]; FBrowseOptions := [bfReturnOnlyFSDirs, bfDontGoBelowDomain]; FBrowseDlgLabel := ''; end; function TKFileNameEditDlgProperties.IsBrowseOptionsStored: Boolean; begin Result := FBrowseOptions <> [bfSetFolder, bfReturnOnlyFSDirs, bfDontGoBelowDomain]; end; function TKFileNameEditDlgProperties.IsOpenOptionsStored: Boolean; begin Result := FOpenOptions <> [ofHideReadOnly, ofEnableSizing]; end; { TKFileNameEdit } constructor TKFileNameEdit.Create(AOwner: TComponent); begin inherited; FButton := nil; FButtonStyle := fbNone; FButtonAlign := fbaRight; FButtonText := sEDBrowse; FButtonWidth := 75; FButtonDist := 8; SetButtonStyle(fbButton); FOptions := [foAddToList, foCheckPath, foWarning]; FWarningColor := clRed; ControlStyle := ControlStyle - [csSetCaption]; FDlgProperties := TKFileNameEditDlgProperties.Create; FLog := nil; end; destructor TKFileNameEdit.Destroy; begin FDlgProperties.Free; inherited; end; procedure TKFileNameEdit.ButtonClick(Sender: TObject); var OD: TOpenDialog; SD: TSaveDialog; BF: TKBrowseFolderDialog; begin if foFolderOnly in FOptions then begin BF := TKBrowseFolderDialog.Create(Self); try if (Text = '') or (foAlwaysInitialDir in FOptions) then BF.Folder := FDlgProperties.InitialDir else BF.Folder := Text; BF.LabelText := FDlgProperties.BrowseDlgLabel; BF.Options := FDlgProperties.BrowseOptions; if BF.Execute then begin Text := BF.Folder; Change; if foAddToList in FOptions then Items.Insert(0, Text); FDlgProperties.InitialDir := ExtractFilePath(Text); Font.Color := clWindowText; end; finally BF.Free; end; end else if foSaveDialog in FOptions then begin SD := TSaveDialog.Create(Self); try if (Text = '') or (foAlwaysInitialDir in FOptions) then SD.InitialDir := FDlgProperties.InitialDir else SD.InitialDir := ExtractFilePath(Text); SD.DefaultExt := FDlgProperties.DefaultExt; SD.Filter := FDlgProperties.Filter; SD.FilterIndex := FDlgProperties.FilterIndex; SD.Options := FDlgProperties.OpenOptions; if SD.Execute then begin Text := SD.FileName; Change; if foAddToList in FOptions then Items.Insert(0, Text); FDlgProperties.InitialDir := ExtractFilePath(Text); Font.Color := clWindowText; end; finally SD.Free; end; end else begin OD := TOpenDialog.Create(Self); try if (Text = '') or (foAlwaysInitialDir in FOptions) then OD.InitialDir := FDlgProperties.InitialDir else OD.InitialDir := ExtractFilePath(Text); OD.DefaultExt := FDlgProperties.DefaultExt; OD.Filter := FDlgProperties.Filter; OD.FilterIndex := FDlgProperties.FilterIndex; OD.Options := FDlgProperties.OpenOptions; if OD.Execute then begin Text := OD.FileName; Change; if foAddToList in FOptions then Items.Insert(0, Text); FDlgProperties.InitialDir := ExtractFilePath(Text); Font.Color := clWindowText; end; finally OD.Free; end; end; if Assigned(FBtnOnClick) then FBtnOnClick(Sender); end; procedure TKFileNameEdit.ButtonExit(Sender: TObject); begin DoExit; end; procedure TKFileNameEdit.CMBiDiModeChanged(var Msg: TLMessage); begin inherited; {switch the button position}; UpdateButton; end; procedure TKFileNameEdit.CMEnabledChanged(var Msg: TLMessage); begin inherited; if Assigned(FButton) then FButton.Enabled := Enabled; end; procedure TKFileNameEdit.CMVisibleChanged(var Msg: TLMessage); begin inherited; if Assigned(FButton) then FButton.Visible := Visible; end; procedure TKFileNameEdit.DoEnter; begin Font.Color := clWindowText; inherited; end; procedure TKFileNameEdit.DoExit; var B: Boolean; H: HWnd; begin inherited; if FButton is TWinControl then H := TWinControl(FButton).Handle else H := 0; if (GetFocus <> H) and (ComponentState * [csLoading, csDesigning] = []) then begin Text := CorrectPath(Text, FDlgProperties.InitialDir, FOptions, B, FLog); if B then begin if foWarning in FOptions then Font.Color := FWarningColor end else if foAddToList in FOptions then if (Items.IndexOf(Text) < 0) and (Text <> '') then Items.Insert(0, Text); end; end; function TKFileNameEdit.GetFileName: TFileName; begin Result := Text; end; procedure TKFileNameEdit.KeyDown(var Key: Word; Shift: TShiftState); begin inherited; if Key = VK_RETURN then Key := 0; end; procedure TKFileNameEdit.DropDown; var I: Integer; begin // clear empty items if > 1 if Items.Count > 1 then for I := 0 to Items.Count - 1 do if Items[I] = '' then Items.Delete(I); inherited; end; procedure TKFileNameEdit.SetButton(Value: TControl); var PI: PPropInfo; N: TNotifyEvent; begin if (FButtonStyle = fbUser) and (Value <> Self) then begin FButton.Free; FBtnOnClick := nil; FButton := Value; if Assigned(FButton) then begin PI := GetPropInfo(FButton, 'OnClick'); if PI <> nil then begin FBtnOnClick := TNotifyEvent(GetMethodProp(FButton, PI)); N := ButtonClick; SetMethodProp(FButton, PI, TMethod(N)); UpdateButton; FButton.Parent := Parent; end; FButton.FreeNotification(Self); end; end; end; procedure TKFileNameEdit.SetButtonAlign(Value: TKFileNameEditButtonAlign); begin if Value <> FButtonAlign then begin FButtonAlign := Value; UpdateButton; end; end; procedure TKFileNameEdit.SetButtonStyle(Value: TKFileNameEditButtonStyle); begin if FButtonStyle <> Value then begin if FButtonStyle <> fbUser then FButton.Free; FButtonStyle := Value; FButton := nil; FBtnOnClick := nil; case Value of fbButton: begin FButton := TButton.Create(Self); try (FButton as TButton).OnClick := ButtonClick; except end; end; fbBitBtn: begin FButton := TBitBtn.Create(Self); try with FButton as TBitBtn do begin {$IFDEF FPC} Glyph.LoadFromLazarusResource('OPENDIR'); {$ELSE} Glyph.LoadFromResourceName(HInstance, 'OPENDIR'); {$ENDIF} Glyph.Transparent := True; OnClick := ButtonClick; end; except end; end; fbSpeedBtn: begin FButton := TSpeedButton.Create(Self); try with FButton as TSpeedButton do begin {$IFDEF FPC} Glyph.LoadFromLazarusResource('OPENDIR'); {$ELSE} Glyph.LoadFromResourceName(HInstance, 'OPENDIR'); {$ENDIF} Glyph.Transparent := True; OnClick := ButtonClick; end; except end; end; end; UpdateButton; if Assigned(FButton) then begin FButton.Name := '_internal_'; FButton.Parent := Parent; end; end; end; procedure TKFileNameEdit.SetButtonText(const Value: TCaption); begin if Value <> FButtonText then begin FButtonText := Value; UpdateButton; end; end; procedure TKFileNameEdit.SetButtonWidth(Value: Integer); begin if Value <> FButtonWidth then begin FButtonWidth := Value; UpdateButton; end; end; procedure TKFileNameEdit.SetButtonDist(Value: Integer); begin if Value <> FButtonDist then begin FButtonDist := Value; UpdateButton; end; end; procedure TKFileNameEdit.SetFileName(const Value: TFileName); var B: Boolean; begin if Value <> Text then begin if ComponentState * [csLoading, csDesigning] = [] then begin Text := CorrectPath(Value, FDlgProperties.InitialDir, FOptions, B, FLog); if not (csDesigning in ComponentState) then begin if B then begin if foWarning in FOptions then Font.Color := FWarningColor end else begin if foWarning in FOptions then Font.Color := clWindowText; if foAddToList in FOptions then if (Items.IndexOf(Text) < 0) and (Text <> '') then Items.Insert(0, Text); end; Change; end; end else Text := Value; end; end; procedure TKFileNameEdit.SetOptions(Value: TKFileNameEditOptions); begin if Value <> FOptions then FOptions := Value; end; procedure TKFileNameEdit.SetParent(AParent: TWinControl); begin inherited; if Assigned(FButton) then begin if Parent <> nil then UpdateButton; FButton.Parent := AParent; end; end; procedure TKFileNameEdit.WMMove(var Msg: TLMMove); begin inherited; UpdateButton; end; procedure TKFileNameEdit.UpdateButton; procedure SetButtonPos(ALeft, ADown: Boolean); begin if ALeft then if ADown then begin FButton.Left := Left; FButton.Top := Top + Height + FButtonDist; end else begin FButton.Left := Left - FButton.Width - FButtonDist; FButton.Top := Top; FButton.Height := Height; end else if ADown then begin FButton.Left := Left + Width - FButton.Width; FButton.Top := Top + Height + FButtonDist; end else begin FButton.Left := Left + Width + FButtonDist; FButton.Top := Top; FButton.Height := Height; end; end; var M: TNotifyEvent; begin if Assigned(FButton) then begin if FButtonText <> '&' then FButton.SetTextBuf(PChar(FButtonText)) else FButton.SetTextBuf(''); FButton.Width := FButtonWidth; if IsPublishedProp(FButton, 'OnExit') then try SetOrdProp(FButton, 'TabStop', Integer(True)); SetOrdProp(FButton, 'TabOrder', TabOrder + 1); M := ButtonExit; SetMethodProp(FButton, 'OnExit', TMethod(M)); except end; if BiDiMode in [bdLeftToRight, bdRightToLeftReadingOnly] then if FButtonAlign in [fbaLeft, fbaLeftDown] then SetButtonPos(True, FButtonAlign = fbaLeftDown) else SetButtonPos(False, FButtonAlign = fbaRightDown) else if FButtonAlign in [fbaLeft, fbaLeftDown] then SetButtonPos(False, FButtonAlign = fbaLeftDown) else SetButtonPos(False, FButtonAlign = fbaRightDown); end; end; procedure TKFileNameEdit.Notification(AComponent: TComponent; Operation: TOperation); begin inherited; if (AComponent = FButton) and (Operation = opRemove) then FButton := nil; end; procedure TKFileNameEdit.WMSize(var Msg: TLMSize); begin inherited; UpdateButton; end; function TKFileNameEdit.IsButtonStored: Boolean; begin Result := (FButton <> nil) and (FButton.Name <> '_internal_'); end; function TKFileNameEdit.IsButtonTextStored: Boolean; begin Result := FButtonText <> sEDBrowse; end; function TKFileNameEdit.GetWholeLeft: Integer; begin if Assigned(FButton) then Result := Min(Left, FButton.Left) else Result := Left; end; {$IFDEF FPC} procedure TKFileNameEdit.SetFlat(Value: Boolean); begin if Value <> FFlat then begin FFlat := Value; Invalidate; end; end; {$ENDIF} procedure TKFileNameEdit.SetWholeLeft(const Value: Integer); var L: Integer; begin L := WholeLeft; if L <> Value then begin if Assigned(FButton) then FButton.Left := FButton.Left + Value - L; Left := Left + Value - L; end; end; function TKFileNameEdit.GetWholeWidth: Integer; begin if Assigned(FButton) then Result := Max(Left + Width, FButton.Left + FButton.Width) - WholeLeft else Result := Width; end; procedure TKFileNameEdit.SetWholeWidth(Value: Integer); var W: Integer; begin W := WholeWidth; if W <> Value then begin if Assigned(FButton) then begin if BiDiMode in [bdLeftToRight, bdRightToLeftReadingOnly] then begin case FButtonAlign of fbaLeft: Width := Max(Value - Left + FButton.Left, 5); fbaRight: Width := Max(Value - (FButton.Left + FButton.Width - Left - Width), 5); else Width := Max(Value, FButton.Width + 5); end; end else begin case FButtonAlign of fbaRight: Width := Max(Value - Left + FButton.Left, 5); fbaLeft: Width := Max(Value - (FButton.Left + FButton.Width - Left - Width), 5); else Width := Max(Value, FButton.Width + 5); end; end; UpdateButton; end else Width := Value; end; end; {$IFDEF FPC} initialization {$i kedits.lrs} {$ELSE} {$R kedits.res} {$ENDIF} end. tomboy-ng_0.39-1/kcontrols/source/kgraphics.pas0000644000175000017500000036241514346341266021442 0ustar dbannondbannon{ @abstract(This file is part of the KControls component suite for Delphi and Lazarus.) @author(Tomas Krysl) Copyright (c) 2020 Tomas Krysl

License:
This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html. } unit kgraphics; // lowercase name because of Lazarus/Linux {$include kcontrols.inc} {$IFNDEF REGISTER_PICTURE_FORMATS} {$WEAKPACKAGEUNIT ON} {$ENDIF} interface uses {$IFDEF FPC} // use the LCL interface support whenever possible {$IFDEF MSWINDOWS} Windows, {$ENDIF} GraphType, IntfGraphics, FPImage, LCLType, LCLIntf, LMessages, LResources, {$ELSE} Windows, Messages, JPeg, {$IFDEF USE_PNG_SUPPORT} PngImage, {$ENDIF} {$ENDIF} Classes, Forms, Graphics, Controls, Types, KFunctions, KControls {$IFDEF USE_THEMES} , Themes {$IFNDEF FPC} , UxTheme {$ENDIF} {$ENDIF} ; const { PNG Support } PNGHeader = #137'PNG'#13#10#26#10; MNGHeader = #138'MNG'#13#10#26#10; { Default value for the @link(TKSizingGrips.GripColor) property. } cSizingGripColor = clNavy; { Default value for the @link(TKSizingGrips.GripSize) property. } cSizingGripSize = 8; { Default value for the @link(TKSizingGrips.MidGripConstraint) property. } cSizingMidGripConstraint = (3 * cSizingGripSize + 10); type { Declares possible values for the Style parameter of the @link(BrightColor) function. } TKBrightMode = ( { The Color will be brightened with Percent of its entire luminosity range. } bsAbsolute, { The Color will be brightened with Percent of its current luminosity value. } bsOfBottom, { The Color will be brightened with Percent of the difference of its entire luminosity range and current luminosity value. } bsOfTop ); { Declares RGB + Alpha channel color description allowing both to access single channels and the whole color item. } TKColorRec = packed record case Integer of 0: (R, G, B, A: Byte); 1: (Value: Cardinal); end; { Pointer to TKColorRec. } PKColorRec = ^TKColorRec; { Dynamic array for TKColorRec. } TKColorRecs = array[0..MaxInt div SizeOf(TKColorRec) - 1] of TKColorRec; { Dynamic array for TKColorRecs. } PKColorRecs = ^TKColorRecs; { Dynamic array for TKColorRec. } TKDynColorRecs = array of TKColorRec; { String type for @link(ImageByType) function. } TKImageHeaderString = string[10]; {$IFDEF USE_PNG_SUPPORT} {$IFDEF FPC} { @exclude } TKPngImage = TPortableNetworkGraphic; {$ELSE} {$IFDEF COMPILER12_UP} { @exclude } TKPngImage = TPngImage; {$ELSE} { @exclude } TKPngImage = TPngObject; {$ENDIF} {$ENDIF} {$ENDIF} TKJpegImage = TJpegImage; { Declares possible values for the Attributes parameter in the @link(DrawAlignedText) function. } TKTextAttribute = ( { Bounding rectangle is calculated. No text is drawn. } taCalcRect, { Text will be clipped within the given rectangle. } taClip, { Text will be drawn with end ellipsis if it does not fit within given width. } taEndEllipsis, { Given rectangle will be filled. } taFillRect, { Only the text within given rectangle will be filled. } taFillText, { Include padding created by aligns in the @link(TKTextBox.PointToIndex) calculation. } taIncludePadding, { Text will be drawn as multi-line text if it contains carriage returns and line feeds. } taLineBreak, { Text will be drawn with path ellipsis if it does not fit within given width. } taPathEllipsis, { Text line(s) will be broken between words if they don't fit within given width. } taWordBreak, { Text line(s) will be broken if they don't fit within col width. } taWrapText, //JR:20091229 { White spaces will be trimmed at the beginning or end of text lines. } taTrimWhiteSpaces, { Text will be drawn with start ellipsis if it does not fit within given width. } taStartEllipsis ); { Set type for @link(TKTextAttribute) enumeration. } TKTextAttributes = set of TKTextAttribute; { Declares possible values for the HAlign parameter in the @link(DrawAlignedText) function. } TKHAlign = ( { Text is aligned to the left border of a cell rectangle. } halLeft, { Text is horizontally centered within the cell rectangle. } halCenter, { Text is aligned to the right border of a cell rectangle. } halRight, { Text is aligned to the left and right border of a cell rectangle. } halJustify ); { Declares possible values for the StretchMode parameter in the @link(ExcludeShapeFromBaseRect) function. } TKStretchMode = ( { Shape is not stretched. } stmNone, { Shape is zoomed out. } stmZoomOutOnly, { Shape is zoomed in. } stmZoomInOnly, { Shape is zoomed arbitrary. } stmZoom ); { For backward compatibility. } TKTextHAlign = TKHAlign; { Declares possible values for the VAlign parameter in the @link(DrawAlignedText) function. } TKVAlign = ( { Text is aligned to the upper border of a cell rectangle. } valTop, { Text is vertically centered within the cell rectangle. } valCenter, { Text is aligned to the lower border of a cell rectangle. } valBottom ); { For backward compatibility. } TKTextVAlign = TKVAlign; { Declares possible values for the AStates parameter in the @link(DrawButtonFrame) function. } TKButtonDrawState = ( { Use OS themes/styles to draw button. } bsUseThemes, { Draw disabled button. } bsDisabled, { Draw pressed button. } bsPressed, { Draw normal focused button. } bsFocused, { Draw normal hot button. } bsHot ); { Set of TKButtonState values. } TKButtonDrawStates = set of TKButtonDrawState; { Contains common properties for all KCOntrols TGraphic descendants. } TKGraphic = class(TGraphic) protected FDescription: string; FFileFilter: string; public { Creates the instance. } constructor Create; override; { Gives description for design time loader. } property Description: string read FDescription; { Gives file filter for design time loader. } property FileFilter: string read FFileFilter; end; { A simple platform independent encapsulation for a 32bpp bitmap with alpha channel with the ability to modify it's pixels directly. } { TKAlphaBitmap } TKAlphaBitmap = class(TKGraphic) private FAutoMirror: Boolean; FCanvas: TCanvas; FDirectCopy: Boolean; FHandle: HBITMAP; FHeight: Integer; {$IFNDEF MSWINDOWS} FImage: TLazIntfImage; // Lazarus only FMaskHandle: HBITMAP; {$ENDIF} FOldBitmap: HBITMAP; FPixels: PKColorRecs; FPixelsChanged: Boolean; FUpdateLock: Integer; FWidth: Integer; function GetScanLine(Index: Integer): PKColorRecs; function GetHandle: HBITMAP; function GetHasAlpha: Boolean; function GetPixel(X, Y: Integer): TKColorRec; procedure SetPixel(X, Y: Integer; Value: TKColorRec); protected { Calls OnChanged event. } procedure Changed(Sender: TObject); override; { Paints itself to ACanvas at location ARect. } procedure Draw(ACanvas: TCanvas; const ARect: TRect); override; { Returns True if bitmap is empty. } function GetEmpty: Boolean; override; { Returns the bitmap height. } function GetHeight: Integer; override; { Returns True. Treat alpha bitmap as transparent because of the possible alpha channel. } function GetTransparent: Boolean; override; { Returns the bitmap width. } function GetWidth: Integer; override; { Specifies new bitmap height. } procedure SetHeight(Value: Integer); override; { Specifies new bitmap width. } procedure SetWidth(Value: Integer); override; { Does nothing. Bitmap is never transparent. } procedure SetTransparent(Value: Boolean); override; public { Creates the instance. } constructor Create; override; { Creates the instance from application resources. For Lazarus 'BMP' type is taken, for Delphi RT_RCDATA is taken. } constructor CreateFromRes(const ResName: string); { Destroys the instance. } destructor Destroy; override; { Paints alpha bitmap onto Canvas at position given by X, Y. The alpha bitmap is combined with the background already drawn on Canvas using alpha channel stored in the alpha bitmap. } procedure AlphaDrawTo(ACanvas: TCanvas; X, Y: Integer); { Paints alpha bitmap onto Canvas at position given by ARect. The alpha bitmap is combined with the background already drawn on Canvas using alpha channel stored in the alpha bitmap. } procedure AlphaStretchDrawTo(ACanvas: TCanvas; const ARect: TRect); { Fills the alpha channel with Alpha. If the optional IfEmpty parameter is True, the alpha channel won't be modified unless it has zero value for all pixels. } procedure AlphaFill(Alpha: Byte; IfEmpty: Boolean = False); overload; { Fills the alpha channel according to given parameters. Currently it is used internally by @link(TKDragWindow). } procedure AlphaFill(Alpha: Byte; BlendColor: TColor; Gradient, Translucent: Boolean); overload; { Fills the alpha channel with AAlpha for pixels with AColor. } procedure AlphaFillOnColorMatch(AColor: TColor; AAlpha: Byte); { Modifies the alpha channel with Percent of its current value. If the optional IfEmpty parameter is True, the alpha channel will be set to percent of full scale if it has zero value. } procedure AlphaFillPercent(Percent: Integer; IfEmpty: Boolean); { Copies shareable properties of another instance into this instance of TKAlphaBitmap. } procedure Assign(Source: TPersistent); override; { Copies shareable properties of this instance into another instance of TKAlphaBitmap. } procedure AssignTo(Dest: TPersistent); override; { Brightens the image by given percent and bright mode. } procedure Brighten(APercent: Single; AMode: TKBrightMode = bsAbsolute); { Clears the image. } procedure Clear; {$IFDEF FPC}override;{$ENDIF} { Combines the pixel at given location with the given color. } procedure CombinePixel(X, Y: Integer; Color: TKColorRec); { Takes dimensions and pixels from AGraphic. } procedure CopyFrom(AGraphic: TGraphic); { Takes dimensions and pixels from ABitmap. } procedure CopyFromAlphaBitmap(ABitmap: TKAlphaBitmap); { Takes diemnsions and pixels from APngImage. } procedure CopyFromJpeg(AJpegImage: TJPEGImage); {$IFDEF USE_PNG_SUPPORT} { Takes diemnsions and pixels from APngImage. } procedure CopyFromPng(APngImage: TKPngImage); {$ENDIF} { Takes 90-rotated dimensions and pixels from ABitmap. } procedure CopyFromRotated(ABitmap: TKAlphaBitmap); { Takes portion from AGraphic at position X and Y. } procedure CopyFromXY(X, Y: Integer; AGraphic: TGraphic); { Takes portion from ABitmap at position X and Y. } procedure CopyFromXYAlphaBitmap(X, Y: Integer; ABitmap: TKAlphaBitmap); { Takes portion from AJpegImage at position X and Y. } procedure CopyFromXYJpeg(X, Y: Integer; AJpegImage: TJPEGImage); {$IFDEF USE_PNG_SUPPORT} { Takes portion from APngImage at position X and Y. } procedure CopyFromXYPng(X, Y: Integer; APngImage: TKPngImage); { Takes diemnsions and pixels from APngImage. } procedure CopyToPng(APngImage: TKPngImage); {$ENDIF} { Copies a location specified by ARect from ACanvas to bitmap. } procedure DrawFrom(ACanvas: TCanvas; const ARect: TRect); overload; { Copies a portion of AGraphic to bitmap at position X and Y. } procedure DrawFrom(AGraphic: TGraphic; X, Y: Integer); overload; { Calls @link(TKAlphaBitmap.Draw). } procedure DrawTo(ACanvas: TCanvas; const ARect: TRect); { Fill with Color. } procedure Fill(Color: TKColorRec); { Convert to grayscale. } procedure GrayScale; {$IFNDEF FPC} { Does nothing. } procedure LoadFromClipboardFormat(AFormat: Word; AData: THandle; APalette: HPALETTE); override; {$ENDIF} { Loads the bitmap from a file. Overriden to support PNG as well. } procedure LoadFromFile(const Filename: string); override; { Loads the bitmap from bitmap and mask handles. } procedure LoadFromHandles(ABitmap, AMask: HBITMAP); { Loads the bitmap from another TGraphic instance. } procedure LoadFromGraphic(Image: TGraphic); virtual; { Loads the bitmap from a stream. } procedure LoadFromStream(Stream: TStream); override; { Locks calls to @link(TKAlphaBitmap.Changed). } procedure LockUpdate; virtual; { Mirrors the bitmap pixels horizontally. } procedure MirrorHorz; { Mirrors the bitmap pixels vertically. } procedure MirrorVert; {$IFNDEF FPC} { Does nothing. } procedure SaveToClipboardFormat(var AFormat: Word; var AData: THandle; var APalette: HPALETTE); override; {$ENDIF} { Saves the bitmap to a stream. } procedure SaveToStream(Stream: TStream); override; { Specifies the bitmap size. } procedure SetSize(AWidth, AHeight: Integer); {$IFNDEF FPC} reintroduce;{$ENDIF} { Unlocks calls to @link(TKAlphaBitmap.Changed). } procedure UnlockUpdate; virtual; { Updates the bitmap handle from bitmap pixels. } procedure UpdateHandle; dynamic; { Updates the pixels from bitmap handle. } procedure UpdatePixels; dynamic; { Automatically mirrors the bitmap vertically for Linux hosts, when reading/writing from/to a stream. } property AutoMirror: Boolean read FAutoMirror write FAutoMirror default True; { Returns the bitmap memory canvas. } property Canvas: TCanvas read FCanvas; { Temporary flag. Use when copying data directly from another TGraphic to TKAlphaBitmap. } property DirectCopy: Boolean read FDirectCopy write FDirectCopy; { Returns the bitmap handle. } property Handle: HBITMAP read GetHandle; { Returns true if alpha channel is nonzero for at least one pixel. } property HasAlpha: Boolean read GetHasAlpha; { Specifies the pixel color. Does range checking. } property Pixel[X, Y: Integer]: TKColorRec read GetPixel write SetPixel; { Returns the pointer to bitmap pixels. } property Pixels: PKColorRecs read FPixels; { Set this property to True if you have modified the bitmap pixels. } property PixelsChanged: Boolean read FPixelsChanged write FPixelsChanged; { Returns the pointer to a bitmap scan line. } property ScanLine[Index: Integer]: PKColorRecs read GetScanLine; end; {$IFDEF MSWINDOWS} { A simple encapsulation for a Windows or Enhanced metafile. It runs only under Windows and does not use shared images. However, it is possible to release metafile handles on assigning to another TKMetafile. } TKMetafile = class(TGraphic) private FCopyOnAssign: Boolean; FEmfHandle: HENHMETAFILE; FEnhanced: Boolean; FWmfHandle: HMETAFILE; procedure SetEMFHandle(const Value: HENHMETAFILE); procedure SetEnhanced(const Value: Boolean); procedure SetWMFHandle(const Value: HMETAFILE); protected FRequiredHeight, FRequiredWidth: Integer; procedure Draw(ACanvas: TCanvas; const Rect: TRect); override; function GetEmpty: Boolean; override; function GetHeight: Integer; override; function GetTransparent: Boolean; override; function GetWidth: Integer; override; procedure SetHeight(Value: Integer); override; procedure SetWidth(Value: Integer); override; public constructor Create; override; destructor Destroy; override; procedure Assign(Source: TPersistent); override; procedure Clear; virtual; procedure LoadFromStream(Stream: TStream); override; procedure Release(out AWmfHandle: HMETAFILE; out AEmfHandle: HENHMETAFILE); procedure SaveToStream(Stream: TStream); override; property CopyOnAssign: Boolean read FCopyOnAssign write FCopyOnAssign; property EMFHandle: HENHMETAFILE read FEMFHandle write SetEMFHandle; property Enhanced: Boolean read FEnhanced write SetEnhanced; property WMFHandle: HMETAFILE read FWMFHandle write SetWMFHandle; end; {$ENDIF} { Declares possible values for the AFunction parameter in the @link(TKTextBox.Process) function. } TKTextBoxFunction = ( { Measure text box contents. } tbfMeasure, { Get text index for coordinates stored in FPoint. } tbfGetIndex, { Get boundary rectangle for index stored in FIndex. } tbfGetRect, { Draw text box contents. } tbfDraw ); { Implements advanced text block rendering. Formerly implemented as @link(DrawAlignedText) function. } TKTextBox = class(TObject) private FAttributes: TKTextAttributes; FBackColor: TColor; FHAlign: TKHAlign; FHPadding: Integer; FSelBkgnd: TColor; FSelColor: TColor; FSelEnd: Integer; FSelStart: Integer; FSpacesForTab: Integer; FText: TKString; FVAlign: TKVAlign; FVPadding: Integer; procedure SetText(const AText: TKString); protected FCanvas: TCanvas; FClipRect: TRect; FFontHeight: Integer; FHasTabs: Boolean; FIndex: Integer; FCalcRect: TRect; function GetHorzPos(ATextWidth: Integer): Integer; function GetVertPos: Integer; virtual; procedure Initialize(ACanvas: TCanvas; const ARect: TRect); virtual; procedure Process(Y: Integer; AFunction: TKTextBoxFunction); procedure TextTrim(const AText: TKString; var AStart, ALen: Integer); virtual; public constructor Create; procedure Draw(ACanvas: TCanvas; const ARect: TRect); virtual; function IndexToRect(ACanvas: TCanvas; const ARect: TRect; AIndex: Integer): TRect; virtual; procedure Measure(ACanvas: TCanvas; const ARect: TRect; var AWidth, AHeight: Integer); virtual; function PointToIndex(ACanvas: TCanvas; const ARect: TRect; APoint: TPoint): Integer; virtual; class function TextExtent(ACanvas: TCanvas; const AText: TKString; AStart, ALen: Integer; AExpandTabs: Boolean = False; ASpacesForTab: Integer = 2): TSize; class procedure TextOutput(ACanvas: TCanvas; X, Y: Integer; const AText: TKString; AStart, ALen: Integer; AExpandTabs: Boolean = False; ASpacesForTab: Integer = 2); property Attributes: TKTextAttributes read FAttributes write FAttributes; property BackColor: TColor read FBackColor write FBackColor; property HAlign: TKHAlign read FHAlign write FHAlign; property HPadding: Integer read FHPadding write FHPadding; property SelBkgnd: TColor read FSelBkgnd write FSelBkgnd; property SelColor: TColor read FSelColor write FSelColor; property SelEnd: Integer read FSelEnd write FSelEnd; property SelStart: Integer read FSelStart write FSelStart; property SpacesForTab: Integer read FSpacesForTab write FSpacesForTab; property Text: TKString read FText write SetText; property VAlign: TKVAlign read FVAlign write FVAlign; property VPadding: Integer read FVPadding write FVPadding; end; {$IFDEF MSWINDOWS} TUpdateLayeredWindowProc = function(Handle: THandle; hdcDest: HDC; pptDst: PPoint; _psize: PSize; hdcSrc: HDC; pptSrc: PPoint; crKey: COLORREF; pblend: PBLENDFUNCTION; dwFlags: DWORD): Boolean; stdcall; {$ENDIF} { @abstract(Encapsulates the drag window) Drag window is top level window used for dragging with mouse. It displays some portion of associated control. It can be translucent under Windows. } TKDragWindow = class(TObject) private FActive: Boolean; FAlphaEffects: Boolean; FBitmap: TKAlphaBitmap; FBitmapFilled: Boolean; FControl: TCustomControl; FGradient: Boolean; FInitialPos: TPoint; FLayered: Boolean; FMasterAlpha: Byte; FRect: TRect; {$IFDEF MSWINDOWS} FBlend: TBlendFunction; FUpdateLayeredWindow: TUpdateLayeredWindowProc; FWindow: HWND; {$ELSE} FDragForm: TCustomForm; {$ENDIF} public { Creates the instance. } constructor Create; { Destroys the instance. } destructor Destroy; override; { Shows the drag window on screen. Takes a rectangular part as set by ARect from IniCtrl's Canvas and displays it at position InitialPos. MasterAlpha and Gradient are used to premaster the copied image with a specific fading effect. } procedure Init(IniCtrl: TCustomControl; const ARect: TRect; const AInitialPos: TPoint; AMasterAlpha: Byte; AGradient: Boolean); { Moves the drag window to a new location. } procedure Move(ARect: PRect; const ACurrentPos: TPoint; AShowAlways: Boolean); { Hides the drag window. } procedure Hide; { Returns True if the drag window is shown. } property Active: Boolean read FActive; { Returns the pointer to the bitmap that holds the copied control image. } property Bitmap: TKAlphaBitmap read FBitmap; { Returns True if the control already copied itself to the bitmap. } property BitmapFilled: Boolean read FBitmapFilled; end; { @abstract(Base class for KControls hints) This class extends the standard THintWindow class. It adds functionality common to all hints used in KControls. } { TKHintWindow } TKHintWindow = class(THintWindow) private FExtent: TPoint; procedure WMEraseBkGnd(var Msg: TLMessage); message LM_ERASEBKGND; public { Creates the instance. } constructor Create(AOwner: TComponent); override; { Shows the hint at given position. This is an IDE independent implementation. } procedure ShowAt(const Origin: TPoint); { Hides the hint. } procedure Hide; { Returns the extent of the hint. } property Extent: TPoint read FExtent; end; { @abstract(Hint window to display formatted text) This class implements the textual hint window. The text is displayed . } TKTextHint = class(TKHintWindow) private FText: TKString; procedure SetText(const Value: TKString); protected { Overriden method. Paints the hint. } procedure Paint; override; public { Creates the instance. } constructor Create(AOwner: TComponent); override; { Text to show in the hint. } property Text: TKString read FText write SetText; end; { @abstract(Hint window to display graphic) This class implements the hint window to show an image. } TKGraphicHint = class(TKHintWindow) private FGraphic: TGraphic; procedure SetGraphic(const Value: TGraphic); protected { Overriden method. Paints the hint. } procedure Paint; override; public { Creates the instance. } constructor Create(AOwner: TComponent); override; { Image to show in the hint. } property Graphic: TGraphic read FGraphic write SetGraphic; end; TKSizingGripPosition = ( sgpNone, sgpLeft, sgpRight, sgpTop, sgpBottom, sgpTopLeft, sgpTopRight, sgpBottomLeft, sgpBottomRight ); TKSizingGrips = class private FBoundsRect: TRect; FGripColor: TColor; FGripSize: Integer; FMidGripConstraint: Integer; protected function GripRect(APosition: TKSizingGripPosition): TRect; public constructor Create; class procedure ClsAffectRect(APosition: TKSizingGripPosition; ADX, ADY: Integer; var ARect: TRect); procedure DrawTo(ACanvas: TCanvas); function HitTest(const APoint: TPoint): TKSizingGripPosition; function CursorAt(const APoint: TPoint): TCursor; function CursorFor(APosition: TKSizingGripPosition): TCursor; property BoundsRect: TRect read FBoundsRect write FBoundsRect; property GripColor: TColor read FGripColor write FGripColor default cSizingGripColor; property GripSize: Integer read FGripSize write FGripSize default cSizingGripSize; property MidGripConstraint: Integer read FMidGripConstraint write FMidGripConstraint default cSizingMidGripConstraint; end; { Draws Src to Dest with per pixel weighting by alpha channel saved in Src. } procedure BlendLine(Src, Dest: PKColorRecs; Count: Integer); { Calculates a brighter color of given color based on the HSL color space.
    Parameters:
  • Color - input color.
  • Percent - percentage of luminosity to bright the color (0 to 1).
  • Mode - identifies how the Percent parameter should be interpreted.
} function BrightColor(Color: TColor; Percent: Single; Mode: TKBrightMode = bsAbsolute): TColor; { Returns current canvas window/wiewport scaling. } procedure CanvasGetScale(ACanvas: TCanvas; out MulX, MulY, DivX, DivY: Integer); { Selects the default window/wiewport scaling to given canvas for both axes. } procedure CanvasResetScale(ACanvas: TCanvas); { Returns True if the ACanvas's device context has been mapped to anything else than MM_TEXT. } function CanvasScaled(ACanvas: TCanvas): Boolean; { Selects the window/wiewport scaling to given canvas for both axes. } procedure CanvasSetScale(ACanvas: TCanvas; MulX, MulY, DivX, DivY: Integer); { Selects the wiewport offset to given canvas for both axes. } procedure CanvasSetOffset(ACanvas: TCanvas; OfsX, OfsY: Integer); { Converts TKColorRec to TColor. } function ColorRecToColor(Color: TKColorRec): TColor; { Converts TColor to TKColorRec. } function ColorToColorRec(Color: TColor): TKColorRec; {$IFDEF FPC} { Converts TKColorRec to TFPColor. } function ColorRecToFPColor(Color: TKColorRec): TFPColor; { Converts TFPColor to TKColorRec. } function FPColorToColorRec(Color: TFPColor): TKColorRec; {$ENDIF} { Makes a grayscale representation of the given color. } function ColorToGrayScale(Color: TColor): TColor; { Returns True if properties of the two brushes are equal. } function CompareBrushes(ABrush1, ABrush2: TBrush): Boolean; { Returns True if properties of the two fonts are equal. } function CompareFonts(AFont1, AFont2: TFont): Boolean; { Calls BitBlt. } procedure CopyBitmap(DestDC: HDC; DestRect: TRect; SrcDC: HDC; SrcX, SrcY: Integer); { Creates an empty point. } function CreateEmptyPoint: TPoint; { Creates an empty point. } function CreateEmptyPoint64: TKPoint64; { Creates an empty rectangle. } function CreateEmptyRect: TRect; { Creates an empty rectangle. } function CreateEmptyRect64: TKRect64; { Creates an empty rectangular region. } function CreateEmptyRgn: HRGN; { Draws Text to the Canvas at location given by ARect. This function is here for backward compatibility. HAlign and VAlign specify horizontal resp. vertical alignment of the text within ARect. HPadding and VPadding specify horizontal (both on left and right side) and vertical (both on top and bottom side) padding of the Text from ARect. BackColor specifies the fill color for brush gaps if a non solid Brush is defined in Canvas. Attributes specift various text output attributes. } procedure DrawAlignedText(Canvas: TCanvas; var ARect: TRect; HAlign: TKHAlign; VAlign: TKVAlign; HPadding, VPadding: Integer; const AText: TKString; BackColor: TColor = clWhite; Attributes: TKTextAttributes = []); { Draws standard button frame } procedure DrawButtonFrame(ACanvas: TCanvas; const ARect: TRect; AStates: TKButtonDrawStates); { Simulates WinAPI DrawEdge with customizable colors. } procedure DrawEdges(Canvas: TCanvas; const R: TRect; HighlightColor, ShadowColor: TColor; Flags: Cardinal); { Draws a rectangle to Canvas. The rectangle coordinates are given by Rect. The rectangle is filled by Brush. If Brush is not solid, its gaps are filled with BackColor. If BackColor is clNone these gaps are not filled and the Brush appears transparent. } procedure DrawFilledRectangle(Canvas: TCanvas; const ARect: TRect; BackColor: TColor); { Fills rectangle with linear gradient. Parameters should be self explaining. } procedure DrawGradientRect(Canvas: TCanvas; const ARect: TRect; AStartColor, AEndColor: TColor; AColorStep: Integer; AHorizontal: Boolean); { This helper function excludes a rectangular area occupied by a shape from BaseRect and calculates the shape area rectangles Bounds and Interior. The shape area is specified by the shape extent (ShapeWidth and ShapeHeight), padding (HPadding and VPadding) and stretching mode (StretchMode). The returned Bounds includes (possibly stretched) shape + padding, and Interior includes only the (possibly stretched) shape. HAlign specifies the horizontal alignment of shape area within BaseRect. VAlign specifies the vertical alignment of shape area within BaseRect. The shape area is always excluded horizontally from BaseRect, as needed by cell data calculations in KGrid. } procedure ExcludeShapeFromBaseRect(var BaseRect: TRect; ShapeWidth, ShapeHeight: Integer; HAlign: TKHAlign; VAlign: TKVAlign; HPadding, VPadding: Integer; StretchMode: TKStretchMode; out Bounds, Interior: TRect); { Selects ARect into device context. Returns previous clipping region. } function ExtSelectClipRect(DC: HDC; ARect: TRect; Mode: Integer; var PrevRgn: HRGN): Boolean; { Selects ARect into device context. Combines with CurRgn and returns previous clipping region. Both regions have to be created first. } function ExtSelectClipRectEx(DC: HDC; ARect: TRect; Mode: Integer; CurRgn, PrevRgn: HRGN): Boolean; { Fills the area specified by the difference Boundary - Interior on ACanvas with current Brush. If Brush is not solid, its gaps are filled with BackColor. If BackColor is clNone these gaps are not filled and the Brush appears transparent. } procedure FillAroundRect(ACanvas: TCanvas; const Boundary, Interior: TRect; BackColor: TColor); { Determine the height (ascent + descent) of the font currently selected into given DC. } function GetFontHeight(DC: HDC): Integer; { Determine the ascent of the font currently selected into given DC. } function GetFontAscent(DC: HDC): Integer; { Determine the descent of the font currently selected into given DC. } function GetFontDescent(DC: HDC): Integer; { Determine average character size for given DC. } function GetAveCharSize(DC: HDC): TSize; { Determine checkbox frame size. } function GetCheckBoxSize: TSize; { Try to determine image DPI. } function GetImageDPI(AGraphic: Tgraphic): TPoint; { Raises an exception if GDI resource has not been created. } function GDICheck(Value: Integer): Integer; { Returns horizontal position of shape within ABoundary according to AAlignment. Shape has size defined by AShapeSize. } function HorizontalShapePosition(AAlignment: TKHAlign; const ABoundary: TRect; const AShapeSize: TPoint): Integer; { Creates a TGraphic instance according to the image file header. Currently supported images are BMP, PNG, MNG, JPG, ICO. } function ImageByType(const Header: TKImageHeaderString): TGraphic; { Calls the IntersectClipRect function. } function IntersectClipRectIndirect(DC: HDC; ARect: TRect): Boolean; { Determines if given color has lightness > 0.5. } function IsBrightColor(Color: TColor): Boolean; { Loads a custom mouse cursor. } procedure LoadCustomCursor(Cursor: TCursor; const ResName: string); { Loads graphic from resource. } procedure LoadGraphicFromResource(Graphic: TGraphic; const ResName: string; ResType: PChar); { Loads picture from clipboard. Clipboard should have CF_PICTURE format. } procedure LoadPictureFromClipboard(APicture: TPicture; APreferredFormat: TKClipboardFormat); { Builds a TKColorRec structure. } function MakeColorRec(R, G, B, A: Byte): TKColorRec; overload; { Builds a TKColorRec structure. } function MakeColorRec(Value: LongWord): TKColorRec; overload; { Returns a pixel format that matches Bpp. } function PixelFormatFromBpp(Bpp: Cardinal): TPixelFormat; { In Lazarus this WinAPI function is missing. } function RectInRegion(Rgn: HRGN; ARect: TRect): Boolean; { Creates the region and copies the device context's current region into it. } function RgnCreateAndGet(DC: HDC): HRGN; { Selects the region into given device context and deletes the region. } procedure RgnSelectAndDelete(DC: HDC; Rgn: HRGN); { Paints rectangle with rounded corners. } procedure RoundRectangle(ACanvas: TCanvas; const ARect: TRect; AXRadius, AYRadius: Integer); { Paints an image so that it fits in ARect. Performs double buffering and fills the background with current brush for mapped device contexts. } procedure SafeStretchDraw(ACanvas: TCanvas; ARect: TRect; AGraphic: TGraphic; ABackColor: TColor = clWhite); { Selects ARect as new clipping region into the device context. } procedure SelectClipRect(DC: HDC; const ARect: TRect); { Calls StretchBlt. } procedure StretchBitmap(DestDC: HDC; DestRect: TRect; SrcDC: HDC; SrcRect: TRect); { Swaps the color format from RGB to BGR and vice versa. } function SwitchRGBToBGR(Value: TColor): TColor; { Subtracts the current device context offset from ARect. } procedure TranslateRectToDevice(DC: HDC; var ARect: TRect); { Returns vertical position of shape within ABoundary according to AAlignment. Shape has size defined by AShapeSize. } function VerticalShapePosition(AAlignment: TKVAlign; const ABoundary: TRect; const AShapeSize: TPoint): Integer; implementation uses ClipBrd, Math, SysUtils, KRes; procedure BlendLine(Src, Dest: PKColorRecs; Count: Integer); var I: Integer; R, G, B, A1, A2: Integer; begin // without assembler for I := 0 to Count - 1 do begin A1 := Src[I].A; A2 := 255 - A1; Inc(A1); Inc(A2); R := Src[I].R * A1 + Dest[I].R * A2; G := Src[I].G * A1 + Dest[I].G * A2; B := Src[I].B * A1 + Dest[I].B * A2; Dest[I].R := R shr 8; Dest[I].G := G shr 8; Dest[I].B := B shr 8; end; end; function CalcLightness(Color: TColor): Single; var X: TKColorRec; begin X := ColorToColorRec(Color); Result := (X.R + X.G + X.B) / (3 * 256); end; function BrightColor(Color: TColor; Percent: Single; Mode: TKBrightMode): TColor; var L, Tmp: Single; function Func1(Value: Single): Single; begin Result := Value * (L + Percent) / L; end; function Func2(Value: Single): Single; begin Result := 1 - (0.5 - Tmp) * (1 - Value) / (1 - L); { this is the shorter form of Value := 1 - 0.5 * (1 - Value) / (1 - L) ; // get color with L = 0.5 Result := 1 - (0.5 - Tmp) * (1 - Value) / 0.5; // get corresponding color } end; function Rd(Value: Single): Byte; begin Result := Min(Integer(Round(Value * 255)), 512); end; var R, G, B, Cmax, Cmin: Single; X: TKColorRec; begin X := ColorToColorRec(Color); R := X.R / 255; G := X.G / 255; B := X.B / 255; Cmax := Max(R, Max(G, B)); Cmin := Min(R, Min(G, B)); L := (Cmax + Cmin) / 2; if L < 1 then begin case Mode of bsOfBottom: Percent := L * Percent; bsOfTop: Percent := (1 - L) * Percent; end; Percent := Min(Percent, 1 - L); if L = 0 then begin // zero length singularity R := R + Percent; G := G + Percent; B := B + Percent; end else begin Tmp := L + Percent - 0.5; // lumination below 0.5 if L < 0.5 then begin // if L + Percent is >= 0.5, get color with L = 0.5 Percent := Min(Percent, 0.5 - L); R := Func1(R); G := Func1(G); B := Func1(B); L := 0.5; end; // lumination above 0.5 if Tmp > 0 then begin R := Func2(R); G := Func2(G); B := Func2(B); end; end; X.R := Rd(R); X.G := Rd(G); X.B := Rd(B); end; Result := X.Value; end; procedure CanvasGetScale(ACanvas: TCanvas; out MulX, MulY, DivX, DivY: Integer); {$IFDEF USE_DC_MAPPING} var WindowExt, ViewPortExt: TSize; {$ENDIF} begin {$IFDEF USE_DC_MAPPING} if Boolean(GetWindowExtEx(ACanvas.Handle, {$IFDEF FPC}@{$ENDIF}WindowExt)) and Boolean(GetViewPortExtEx(ACanvas.Handle, {$IFDEF FPC}@{$ENDIF}ViewPortExt)) then begin DivX := WindowExt.cx; DivY := WindowExt.cy; MulX := ViewPortExt.cx; MulY := ViewPortExt.cy; end else {$ENDIF} begin MulX := 1; DivX := 1; MulY := 1; DivY := 1; end; end; procedure CanvasResetScale(ACanvas: TCanvas); begin {$IFDEF USE_DC_MAPPING} SetMapMode(ACanvas.Handle, MM_TEXT); {$ENDIF} end; function CanvasScaled(ACanvas: TCanvas): Boolean; begin {$IFDEF USE_DC_MAPPING} Result := not (GetMapMode(ACanvas.Handle) in [0, MM_TEXT]); {$ELSE} Result := False; {$ENDIF} end; procedure CanvasSetScale(ACanvas: TCanvas; MulX, MulY, DivX, DivY: Integer); begin {$IFDEF USE_DC_MAPPING} SetMapMode(ACanvas.Handle, MM_ANISOTROPIC); SetWindowExtEx(ACanvas.Handle, DivX, DivY, nil); SetViewPortExtEx(ACanvas.Handle, MulX, MulY, nil); {$ELSE} {$WARNING 'Device context window/viewport transformations not working!'} {$ENDIF} end; procedure CanvasSetOffset(ACanvas: TCanvas; OfsX, OfsY: Integer); begin {$IFDEF USE_DC_MAPPING} SetMapMode(ACanvas.Handle, MM_ANISOTROPIC); SetViewPortOrgEx(ACanvas.Handle, OfsX, OfsY, nil); {$ENDIF} end; function ColorToGrayScale(Color: TColor): TColor; var GreyValue: Integer; X: TKColorRec; begin X := ColorToColorRec(Color); GreyValue := (Integer(21) * X.R + Integer(72) * X.G + Integer(7) * X.B) div 100; X.R := GreyValue; X.G := GreyValue; X.B := GreyValue; Result := X.Value; end; function ColorRecToColor(Color: TKColorRec): TColor; begin Result := Color.Value and $FFFFFF; end; function ColorToColorRec(Color: TColor): TKColorRec; begin Result.Value := ColorToRGB(Color); end; {$IFDEF FPC} function ColorRecToFPColor(Color: TKColorRec): TFPColor; begin Result.Red := Color.R; Result.Red := Result.Red + (Result.Red shl 8); Result.Green := Color.G; Result.Green := Result.Green + (Result.Green shl 8); Result.Blue := Color.B; Result.Blue := Result.Blue + (Result.Blue shl 8); Result.Alpha := Color.A; Result.Alpha := Result.Alpha + (Result.Alpha shl 8); end; function FPColorToColorRec(Color: TFPColor): TKColorRec; begin Result.R := Color.Red shr 8; Result.G := Color.Green shr 8; Result.B := Color.Blue shr 8; Result.A := Color.Alpha shr 8; end; {$ENDIF} function CompareBrushes(ABrush1, ABrush2: TBrush): Boolean; begin Result := (ABrush1.Color = ABrush2.Color) and (ABrush1.Style = ABrush2.Style); end; function CompareFonts(AFont1, AFont2: TFont): Boolean; begin Result := (AFont1.Charset = AFont2.Charset) and (AFont1.Color = AFont2.Color) and (AFont1.Name = AFont2.Name) and (AFont1.Pitch = AFont2.Pitch) and (AFont1.Size = AFont2.Size) and (AFont1.Style = AFont2.Style); end; procedure CopyBitmap(DestDC: HDC; DestRect: TRect; SrcDC: HDC; SrcX, SrcY: Integer); begin {$IFDEF MSWINDOWS}Windows.{$ENDIF}BitBlt(DestDC, DestRect.Left, DestRect.Top, DestRect.Right - DestRect.Left, DestRect.Bottom - DestRect.Top, SrcDC, 0, 0, SRCCOPY); end; function CreateEmptyPoint: TPoint; begin Result := Point(0,0); end; function CreateEmptyPoint64: TKPoint64; begin Result := Point64(0,0); end; function CreateEmptyRect: TRect; begin Result := Rect(0,0,0,0); end; function CreateEmptyRect64: TKRect64; begin Result := Rect64(0,0,0,0); end; function CreateEmptyRgn: HRGN; begin Result := CreateRectRgn(0,0,0,0); end; procedure DrawAlignedText(Canvas: TCanvas; var ARect: TRect; HAlign: TKHAlign; VAlign: TKVAlign; HPadding, VPadding: Integer; const AText: TKString; BackColor: TColor; Attributes: TKTextAttributes); var TextBox: TKTextBox; Width, Height: Integer; begin TextBox := TKTextBox.Create; try TextBox.Attributes := Attributes; TextBox.BackColor := BackColor; TextBox.HAlign := HAlign; TextBox.HPadding := HPadding; TextBox.Text := AText; TextBox.VAlign := VAlign; TextBox.VPadding := VPadding; if taCalcRect in Attributes then begin TextBox.Measure(Canvas, ARect, Width, Height); ARect.Right := ARect.Left + Width; ARect.Bottom := ARect.Top + Height; end else TextBox.Draw(Canvas, ARect); finally TextBox.Free; end; end; procedure DrawButtonFrame(ACanvas: TCanvas; const ARect: TRect; AStates: TKButtonDrawStates); var BM: TBitmap; TmpCanvas: TCanvas; TmpRect: TRect; ButtonState: Integer; {$IFDEF USE_THEMES} ButtonTheme: TThemedButton; {$ENDIF} begin // a LOT of tweaking here... {$IF DEFINED(MSWINDOWS) OR DEFINED(LCLQT) } // GTK2 cannot strech and paint on bitmap canvas, grrr.. if CanvasScaled(ACanvas) {$IFDEF MSWINDOWS}and (bsUseThemes in AStates){$ENDIF} then begin BM := TBitmap.Create; BM.Width := ARect.Right - ARect.Left; BM.Height := ARect.Bottom - ARect.Top; BM.Canvas.Brush.Assign(ACanvas.Brush); TmpRect := Rect(0, 0, BM.Width, BM.Height); BM.Canvas.FillRect(TmpRect); TmpCanvas := BM.Canvas; end else {$IFEND} begin BM := nil; TmpRect := ARect; TmpCanvas := ACanvas; end; try {$IFDEF USE_THEMES} if bsUseThemes in AStates then begin if bsDisabled in AStates then ButtonTheme := tbPushButtonDisabled else if bsPressed in AStates then ButtonTheme := tbPushButtonPressed else if bsHot in AStates then ButtonTheme := tbPushButtonHot else if bsFocused in AStates then ButtonTheme := tbPushButtonDefaulted else ButtonTheme := tbPushButtonNormal; ThemeServices.DrawElement(TmpCanvas.Handle, ThemeServices.GetElementDetails(ButtonTheme), TmpRect); end else {$ENDIF} begin ButtonState := DFCS_BUTTONPUSH; if bsDisabled in AStates then ButtonState := ButtonState or DFCS_INACTIVE else if bsPressed in AStates then ButtonState := ButtonState or DFCS_PUSHED else if bsHot in AStates then ButtonState := ButtonState or DFCS_HOT; DrawFrameControl(TmpCanvas.Handle, TmpRect, DFC_BUTTON, ButtonState); end; if BM <> nil then ACanvas.Draw(ARect.Left, ARect.Top, BM); finally BM.Free; end; end; procedure DrawEdges(Canvas: TCanvas; const R: TRect; HighlightColor, ShadowColor: TColor; Flags: Cardinal); begin with Canvas do begin Brush.Style := bsSolid; Brush.Color := HighlightColor; if Flags and BF_LEFT <> 0 then FillRect(Rect(R.Left, R.Top + 1, R.Left + 1, R.Bottom)); if Flags and BF_TOP <> 0 then FillRect(Rect(R.Left, R.Top, R.Right, R.Top + 1)); Brush.Color := ShadowColor; if Flags and BF_RIGHT <> 0 then FillRect(Rect(R.Right - 1, R.Top + 1, R.Right, R.Bottom)); if Flags and BF_BOTTOM <> 0 then FillRect(Rect(R.Left + 1, R.Bottom - 1, R.Right - 1, R.Bottom)); end; end; procedure DrawFilledRectangle(Canvas: TCanvas; const ARect: TRect; BackColor: TColor); var DC: HDC; begin DC := Canvas.Handle; if BackColor <> clNone then begin SetBkMode(DC, OPAQUE); SetBkColor(DC, ColorToRGB(BackColor)); end; FillRect(DC, ARect, Canvas.Brush.Handle); end; procedure DrawGradientRect(Canvas: TCanvas; const ARect: TRect; AStartColor, AEndColor: TColor; AColorStep: Integer; AHorizontal: Boolean); var J, OldJ, Extent, Num: Integer; L: Byte; CS, CE: TKColorRec; RCnt, GCnt, BCnt: Longint; RInc, GInc, BInc: Longint; B: Boolean; R: TRect; function NumToRGB(Num: Cardinal): TKColorRec; begin Result.R := Byte(Num shr 16); Result.G := Byte(Num shr 8); Result.B := Byte(Num); end; function RGBToNum(Col: TKColorRec): Cardinal; begin Result := Cardinal(Col.R) shl 16 + Cardinal(Col.G) shl 8 + Col.B; end; begin with Canvas do begin if AHorizontal then Extent := ARect.Right - ARect.Left - 1 else Extent := ARect.Bottom - ARect.Top - 1; Num := Max(Extent div AColorStep, 1); CS := NumToRGB(AStartColor); CE := NumToRGB(AEndColor); // colors per pixel RInc := (Integer(CE.R - CS.R) shl 16) div Extent; GInc := (Integer(CE.G - CS.G) shl 16) div Extent; Binc := (Integer(CE.B - CS.B) shl 16) div Extent; // start colors RCnt := CS.R shl 16; GCnt := CS.G shl 16; BCnt := CS.B shl 16; // drawing bar Brush.Color := RGBToNum(CS); OldJ := 0; B := False; for J := 0 to Extent do begin Inc(RCnt, RInc); L := Byte(RCnt shr 16); if L <> CS.R then begin CS.R := L; B := True; end; Inc(GCnt, GInc); L := Byte(GCnt shr 16); if L <> CS.G then begin CS.G := L; B := True; end; Inc(BCnt, BInc); L := Byte(BCnt shr 16); if L <> CS.B then begin CS.B := L; B := True; end; if B and (J mod Num = 0) then begin if AHorizontal then R := Rect(ARect.Left + OldJ, ARect.Top, ARect.Left + J, ARect.Bottom) else R := Rect(ARect.Left, ARect.Top + OldJ, ARect.Right, ARect.Top + J); FillRect(R); Brush.Color := RGBToNum(CS); OldJ := J; B := False; end; end; end; end; procedure ExcludeShapeFromBaseRect(var BaseRect: TRect; ShapeWidth, ShapeHeight: Integer; HAlign: TKHAlign; VAlign: TKVAlign; HPadding, VPadding: Integer; StretchMode: TKStretchMode; out Bounds, Interior: TRect); var MaxHeight, MaxWidth, StretchHeight, StretchWidth: Integer; RatioX, RatioY: Single; begin MaxHeight := BaseRect.Bottom - BaseRect.Top - 2 * VPadding; MaxWidth := BaseRect.Right - BaseRect.Left - HPadding; if ((MaxWidth <> ShapeWidth) or (MaxHeight <> ShapeHeight)) and ( (StretchMode = stmZoom) or (StretchMode = stmZoomInOnly) and (MaxWidth >= ShapeWidth) and (MaxHeight >= ShapeHeight) or (StretchMode = stmZoomOutOnly) and ((MaxWidth < ShapeWidth) or (MaxHeight < ShapeHeight)) ) then begin RatioX := MaxWidth / ShapeWidth; RatioY := MaxHeight / ShapeHeight; if RatioY >= RatioX then begin StretchWidth := MaxWidth; StretchHeight := ShapeHeight * StretchWidth div ShapeWidth; end else begin StretchHeight := MaxHeight; StretchWidth := ShapeWidth * StretchHeight div ShapeHeight; end; end else begin StretchHeight := ShapeHeight; StretchWidth := ShapeWidth; end; Bounds := BaseRect; Interior := BaseRect; case HAlign of halCenter: begin BaseRect.Right := BaseRect.Left; // BaseRect empty, no space for next item! // Bounds remains unchanged Inc(Interior.Left, HPadding + (MaxWidth - StretchWidth) div 2); end; halRight: begin Dec(BaseRect.Right, StretchWidth + HPadding); Bounds.Left := BaseRect.Right; // Bounds.Right remains unchanged Interior.Left := BaseRect.Right; end; else Inc(BaseRect.Left, StretchWidth + HPadding); // Bounds.Left remains unchanged Bounds.Right := BaseRect.Left; Inc(Interior.Left, HPadding); end; Interior.Right := Interior.Left + StretchWidth; case VAlign of valCenter: Inc(Interior.Top, VPadding + (MaxHeight - StretchHeight) div 2); valBottom: Interior.Top := BaseRect.Bottom - VPadding - StretchHeight; else Inc(Interior.Top, VPadding); end; Interior.Bottom := Interior.Top + StretchHeight; end; function ExtSelectClipRect(DC: HDC; ARect: TRect; Mode: Integer; var PrevRgn: HRGN): Boolean; var TmpRgn: HRGN; begin TmpRgn := CreateEmptyRgn; try Result := ExtSelectClipRectEx(DC, ARect, Mode, TmpRgn, PrevRgn) finally DeleteObject(TmpRgn); end; end; function ExtSelectClipRectEx(DC: HDC; ARect: TRect; Mode: Integer; CurRgn, PrevRgn: HRGN): Boolean; var RectRgn: HRGN; // R1, R2: TRect; begin RectRgn := CreateRectRgnIndirect(ARect); try // GetRgnBox(PrevRgn, R1); // debug line // GetRgnBox(RectRgn, R2); // debug line Result := CombineRgn(CurRgn, PrevRgn, RectRgn, Mode) <> NULLREGION; if Result then SelectClipRgn(DC, CurRgn) finally DeleteObject(RectRgn); end; end; procedure FillAroundRect(ACanvas: TCanvas; const Boundary, Interior: TRect; BackColor: TColor); var R: TRect; begin R := Rect(Boundary.Left, Boundary.Top, Boundary.Right, Interior.Top); if not IsRectEmpty(R) then DrawFilledRectangle(ACanvas, R, BackColor); R := Rect(Boundary.Left, Interior.Top, Interior.Left, Interior.Bottom); if not IsRectEmpty(R) then DrawFilledRectangle(ACanvas, R, BackColor); R := Rect(Interior.Right, Interior.Top, Boundary.Right, Interior.Bottom); if not IsRectEmpty(R) then DrawFilledRectangle(ACanvas, R, BackColor); R := Rect(Boundary.Left, Interior.Bottom, Boundary.Right, Boundary.Bottom); if not IsRectEmpty(R) then DrawFilledRectangle(ACanvas, R, BackColor); end; function GetFontHeight(DC: HDC): Integer; var TM: TTextMetric; begin FillChar(TM, SizeOf(TTextMetric), 0); GetTextMetrics(DC, TM); Result := TM.tmHeight; end; function GetFontAscent(DC: HDC): Integer; var TM: TTextMetric; begin FillChar(TM, SizeOf(TTextMetric), 0); GetTextMetrics(DC, TM); Result := TM.tmAscent; end; function GetFontDescent(DC: HDC): Integer; var TM: TTextMetric; begin FillChar(TM, SizeOf(TTextMetric), 0); GetTextMetrics(DC, TM); Result := TM.tmDescent; end; function GetAveCharSize(DC: HDC): TSize; var TM: TTextMetric; const Buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'; begin FillChar(TM, SizeOf(TTextMetric), 0); GetTextMetrics(DC, TM); GetTextExtentPoint32(DC, Buffer, 52, Result); Result.cx := (Result.cx div 26 + 1) div 2; //div uses trunc rounding; we want arithmetic rounding Result.cy := tm.tmHeight; end; function GetCheckBoxSize: TSize; {$IFDEF MSWINDOWS} var Bm: HBITMAP; BmSize: BITMAP; {$ENDIF} {$IFDEF FPC} {$ELSE} var Theme: HTHEME; {$ENDIF} begin Result.cx := 0; Result.cy := 0; {$IFDEF USE_THEMES} if ThemeServices.ThemesEnabled and ThemeServices.ThemesAvailable then begin {$IFDEF FPC} Result := ThemeServices.GetDetailSize(ThemeServices.GetElementDetails(tbCheckBoxCheckedNormal)); Exit; {$ELSE} Theme := ThemeServices.Theme[teButton]; if GetThemePartSize(Theme, 0, BP_CHECKBOX, CBS_CHECKEDNORMAL, nil, TS_TRUE, Result) = S_OK then Exit; {$ENDIF} end; {$ENDIF} {$IFDEF MSWINDOWS} Bm := LoadBitmap(0, PChar(OBM_CHECKBOXES)); if Bm <> 0 then try if GetObject(Bm, SizeOf(BmSize), @BmSize) = SizeOf(BmSize) then begin Result.cx := BmSize.bmWidth div 4; Result.cy := BmSize.bmHeight div 3; end; finally DeleteObject(Bm); end; {$ELSE} // just guessed here Result.cx := 13; Result.cy := 13; {$ENDIF} end; function GetImageDPI(AGraphic: Tgraphic): TPoint; procedure GetDPIFromJPeg(AJPeg: TJPegImage); const cInchesPerCM = (1 / 2.54); cBufferSize = 50; var MS: TMemoryStream; Index: Integer; Buffer: AnsiString; resUnits: Byte; xResolution: Word; yResolution: Word; begin // seek for XDensity and YDensity fields in JPEG header MS := TMemoryStream.Create; try AJPeg.SaveToStream(MS); MS.Seek(0, soFromBeginning); SetLength(Buffer, cBufferSize); MS.Read(Buffer[1], cBufferSize); Index := Pos(AnsiString('JFIF'+#$00), Buffer); if Index > 0 then begin MS.Seek(Index + 6, soFromBeginning); MS.Read(resUnits, 1); MS.Read(xResolution, 2); MS.Read(yResolution, 2); xResolution := Swap(xResolution); yResolution := Swap(yResolution); case resUnits of 1: // dots per inch begin Result.X := xResolution; Result.Y := yResolution; end; 2: // dots per cm begin Result.X := Round(xResolution / cInchesPerCM); Result.Y := Round(yResolution / cInchesPerCM); end; else Result.X := 96; Result.Y := MulDiv(96, yResolution, xResolution); end; end; finally MS.Free; end; end; {$IFDEF USE_PNG_SUPPORT} procedure GetDPIFromPng(APng: TKPngImage); const cInchesPerMeter = (100 / 2.54); {$IFDEF FPC} type TPngChunkCode = array[0..3] of AnsiChar; TPngChunkHdr = packed record clength: LongWord; ctype: TPngChunkCode; end; var MS: TMemoryStream; CLen, PPUnitX, PPUnitY: Cardinal; CHdr: TPngChunkHdr; CPHYsData: array[0..8] of Byte; {$ELSE} var Chunk: TChunk; {$ENDIF} begin {$IFDEF FPC} MS := TMemoryStream.Create; try APng.SaveToStream(MS); MS.Seek(8, soFromBeginning); // skip PNG header while MS.Position < MS.Size do begin // traverse the PNG chunks until pHYs chunk is found MS.Read(CHdr, SizeOf(CHdr)); CLen := SwapEndian(CHdr.clength); // suppose little endian if CHdr.ctype = 'pHYs' then begin MS.Read(CPHYsData, 9); // pHYs chunk is always 9 bytes long if CPHYsData[8] = 1 then // dots per meter begin PPUnitX := SwapEndian(PCardinal(@CPHYsData[0])^); // suppose little endian PPUnitY := SwapEndian(PCardinal(@CPHYsData[4])^); // suppose little endian Result.X := Round(PPUnitX / cInchesPerMeter); Result.Y := Round(PPUnitY / cInchesPerMeter); end; Exit; end else MS.Seek(CLen + SizeOf(LongWord), soFromCurrent); end; finally MS.Free; end; {$ELSE} // in Delphi we have the pHYs chunk directly accessible Chunk := APng.Chunks.FindChunk(TChunkpHYs); if Assigned(Chunk) then begin if (TChunkPhys(Chunk).UnitType = utMeter) then begin Result.X := Round(TChunkPhys(Chunk).PPUnitX / cInchesPerMeter); Result.Y := Round(TChunkPhys(Chunk).PPUnitY / cInchesPerMeter); end; end {$ENDIF} end; {$ENDIF} begin Result := Point(96, 96); // for unimplemented image types set screen dpi if AGraphic is TJPegImage then GetDPIFromJPeg(TJpegImage(AGraphic)) {$IFDEF USE_PNG_SUPPORT} else if AGraphic is TKPngImage then GetDPIFromPng(TKPngImage(AGraphic)); {$ENDIF} end; function GDICheck(Value: Integer): Integer; begin if Value = 0 then raise EOutOfResources.Create(sGDIError); Result := Value; end; function HorizontalShapePosition(AAlignment: TKHAlign; const ABoundary: TRect; const AShapeSize: TPoint): Integer; begin case AAlignment of halCenter: Result := ABoundary.Left + (ABoundary.Right - ABoundary.Left - AShapeSize.X) div 2; halRight: Result := ABoundary.Right - AShapeSize.X; else Result := ABoundary.Left; end; end; function ImageByType(const Header: TKImageHeaderString): TGraphic; begin if Pos('BM', {$IFDEF COMPILER12_UP}string{$ENDIF}(Header)) = 1 then Result := TBitmap.Create {$IFDEF USE_PNG_SUPPORT } else if (Pos(#$89'PNG', {$IFDEF COMPILER12_UP}string{$ENDIF}(Header)) = 1) or (Pos(#$8A'MNG', {$IFDEF COMPILER12_UP}string{$ENDIF}(Header)) = 1) then Result := TKPngImage.Create {$ENDIF } else if (Pos(#$FF#$D8, {$IFDEF COMPILER12_UP}string{$ENDIF}(Header)) = 1) then Result := TJPegImage.Create else if (Pos(#$00#$00, {$IFDEF COMPILER12_UP}string{$ENDIF}(Header)) = 1) then Result := TIcon.Create else Result := nil; end; function IntersectClipRectIndirect(DC: HDC; ARect: TRect): Boolean; begin with ARect do Result := IntersectClipRect(DC, Left, Top, Right, Bottom) <> NULLREGION; end; function IsBrightColor(Color: TColor): Boolean; begin Result := CalcLightness(Color) > 0.5; end; function MakeColorRec(R, G, B, A: Byte): TKColorRec; begin Result.R := R; Result.G := G; Result.B := B; Result.A := A; end; function MakeColorRec(Value: LongWord): TKColorRec; begin Result.Value := Value; end; procedure LoadCustomCursor(Cursor: TCursor; const ResName: string); begin Screen.Cursors[Cursor] := {$IFDEF FPC} LoadCursorFromLazarusResource(ResName); {$ELSE} LoadCursor(HInstance, PChar(ResName)); {$ENDIF} end; procedure LoadGraphicFromResource(Graphic: TGraphic; const ResName: string; ResType: PChar); {$IFNDEF FPC} var Stream: TResourceStream; {$ENDIF} begin if Graphic <> nil then try {$IFDEF FPC} try Graphic.LoadFromResourceName(HInstance, ResName); except Graphic.LoadFromLazarusResource(ResName); end; {$ELSE} Stream := TResourceStream.Create(HInstance, ResName, ResType); try Graphic.LoadFromStream(Stream); finally Stream.Free; end; {$ENDIF} except Error(sErrGraphicsLoadFromResource); end; end; procedure LoadPictureFromClipboard(APicture: TPicture; APreferredFormat: TKClipboardFormat); begin try {$IFDEF FPC} APicture.LoadFromClipboardFormat(APreferredFormat); {$ELSE} APicture.LoadFromClipboardFormat(APreferredFormat, Clipboard.GetAsHandle(APreferredFormat), 0); {$ENDIF} except APicture.Assign(ClipBoard); end; end; function PixelFormatFromBpp(Bpp: Cardinal): TPixelFormat; begin case Bpp of 1: Result := pf1bit; 2..4: Result := pf4bit; 5..8: Result := pf8bit; 9..16: Result := pf16bit; else Result := pf32bit; end; end; function RectInRegion(Rgn: HRGN; ARect: TRect): Boolean; {$IFDEF FPC} var RectRgn, TmpRgn: HRGN; {$ENDIF} begin {$IFDEF FPC} RectRgn := CreateRectRgnIndirect(ARect); try TmpRgn := CreateEmptyRgn; try Result := CombineRgn(TmpRgn, RectRgn, Rgn, RGN_AND) <> NULLREGION; finally DeleteObject(TmpRgn); end; finally DeleteObject(RectRgn); end; {$ELSE} Result := Windows.RectInRegion(Rgn, ARect); {$ENDIF} end; function RgnCreateAndGet(DC: HDC): HRGN; //var // R: TRect; begin Result := CreateEmptyRgn; GetClipRgn(DC, Result); // GetRgnBox(Result, R); // debug line end; procedure RgnSelectAndDelete(DC: HDC; Rgn: HRGN); begin SelectClipRgn(DC, Rgn); DeleteObject(Rgn); end; procedure RoundRectangle(ACanvas: TCanvas; const ARect: TRect; AXRadius, AYRadius: Integer); begin {$IF DEFINED(COMPILER12_UP) OR DEFINED(FPC)} ACanvas.RoundRect(ARect, AXRadius, AYRadius) {$ELSE} ACanvas.RoundRect(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom, AXRadius, AYRadius) {$IFEND} end; procedure SafeStretchDraw(ACanvas: TCanvas; ARect: TRect; AGraphic: TGraphic; ABackColor: TColor); {$IFDEF MSWINDOWS} {var BM: TBitmap; W, H, MulX, MulY, DivX, DivY: Integer; R: TRect;} {$ENDIF} begin {$IFDEF MSWINDOWS} // tk: I cannot see problem with StretchBlt anymore, perhaps it was in old Windows XP? // Even if so, following implementation is buggy: {if AGraphic.Transparent then begin // WinAPI StretchBlt function does not read properly from screen buffer // so we have to append double buffering CanvasGetScale(ACanvas, MulX, MulY, DivX, DivY); W := MulDiv(ARect.Right - ARect.Left, MulX, DivX); H := MulDiv(ARect.Bottom - ARect.Top, MulY, DivY); BM := TBitmap.Create; try BM.Width := W; BM.Height := H; BM.Canvas.Brush := ACanvas.Brush; R := Rect(0, 0, W, H); DrawFilledRectangle(BM.Canvas, R, ABackColor); BM.Canvas.StretchDraw(R, AGraphic); ACanvas.StretchDraw(ARect, BM); finally BM.Free; end; end else} {$ENDIF} ACanvas.StretchDraw(ARect, AGraphic); end; procedure SelectClipRect(DC: HDC; const ARect: TRect); var Rgn: HRGN; begin Rgn := CreateRectRgnIndirect(ARect); try SelectClipRgn(DC, Rgn); finally DeleteObject(Rgn); end; end; procedure StretchBitmap(DestDC: HDC; DestRect: TRect; SrcDC: HDC; SrcRect: TRect); begin {$IFDEF MSWINDOWS} SetStretchBltMode(DestDC, HALFTONE); {$ENDIF} {$IFDEF MSWINDOWS}Windows.{$ENDIF}StretchBlt(DestDC, DestRect.Left, DestRect.Top, DestRect.Right - DestRect.Left, DestRect.Bottom - DestRect.Top, SrcDC, SrcRect.Left, SrcRect.Top, SrcRect.Right - SrcRect.Left, SrcRect.Bottom - SrcRect.Top, SRCCOPY); end; procedure SwapBR(var ColorRec: TKColorRec); var Tmp: Byte; begin Tmp := ColorRec.R; ColorRec.R := ColorRec.B; ColorRec.B := Tmp; end; function SwitchRGBToBGR(Value: TColor): TColor; var B: Byte; begin Result := Value; B := PKColorRec(@Value).B; PKColorRec(@Result).B := PKColorRec(@Result).R; PKColorRec(@Result).R := B; end; procedure TranslateRectToDevice(DC: HDC; var ARect: TRect); var WindowOrg, ViewportOrg: TPoint; {$IFDEF USE_DC_MAPPING} {$IFNDEF LCLQT} WindowExt, ViewportExt: TSize; {$ENDIF} {$ENDIF} begin if Boolean(GetWindowOrgEx(DC, {$IFDEF FPC}@{$ENDIF}WindowOrg)) then KFunctions.OffsetRect(ARect, -WindowOrg.X, -WindowOrg.Y); {$IFDEF USE_DC_MAPPING} {$IFNDEF LCLQT} if not (GetMapMode(DC) in [0, MM_TEXT]) and Boolean(GetWindowExtEx(DC, {$IFDEF FPC}@{$ENDIF}WindowExt)) and Boolean(GetViewportExtEx(DC, {$IFDEF FPC}@{$ENDIF}ViewportExt)) then begin ARect.Left := MulDiv(ARect.Left, ViewportExt.cx, WindowExt.cx); ARect.Right := MulDiv(ARect.Right, ViewportExt.cx, WindowExt.cx); ARect.Top := MulDiv(ARect.Top, ViewportExt.cy, WindowExt.cy); ARect.Bottom := MulDiv(ARect.Bottom, ViewportExt.cy, WindowExt.cy); end; if Boolean(GetViewPortOrgEx(DC, {$IFDEF FPC}@{$ENDIF}ViewportOrg)) then KFunctions.OffsetRect(ARect, ViewportOrg); {$ENDIF} {$ENDIF} end; function VerticalShapePosition(AAlignment: TKVAlign; const ABoundary: TRect; const AShapeSize: TPoint): Integer; begin case AAlignment of valCenter: Result := ABoundary.Top + (ABoundary.Bottom - ABoundary.Top - AShapeSize.Y) div 2; valBottom: Result := ABoundary.Bottom - AShapeSize.Y; else Result := ABoundary.Top; end; end; { TKGraphic } constructor TKGraphic.Create; begin inherited; FDescription := ''; FFileFilter := ''; end; { TKAlphaBitmap } constructor TKAlphaBitmap.Create; begin inherited; FCanvas := TCanvas.Create; FCanvas.Handle := CreateCompatibleDC(0); FUpdateLock := 0; FAutoMirror := True; FDescription := 'KControls alpha bitmap'; FDirectCopy := False; FFileFilter := '*.bma;*.bmp;*.png;*.jpg'; FHandle := 0; {$IFNDEF MSWINDOWS} FImage := TLazIntfImage.Create(0, 0); {$ENDIF} FHeight := 0; FOldBitmap := 0; FPixels := nil; FPixelsChanged := False; FWidth := 0; end; constructor TKAlphaBitmap.CreateFromRes(const ResName: string); var Stream: {$IFDEF FPC}TLazarusResourceStream{$ELSE}TResourceStream{$ENDIF}; begin Create; try {$IFDEF FPC} Stream := TLazarusResourceStream.Create(LowerCase(ResName), 'BMP'); {$ELSE} Stream := TResourceStream.Create(HInstance, ResName, RT_RCDATA); {$ENDIF} try LoadFromStream(Stream); finally Stream.Free; end; except Error(sErrGraphicsLoadFromResource); end; end; destructor TKAlphaBitmap.Destroy; var DC: HDC; begin LockUpdate; SetSize(0, 0); {$IFNDEF MSWINDOWS} FImage.Free; {$ENDIF} DC := FCanvas.Handle; FCanvas.Handle := 0; DeleteDC(DC); FCanvas.Free; inherited; end; procedure TKAlphaBitmap.AlphaDrawTo(ACanvas: TCanvas; X, Y: Integer); begin AlphaStretchDrawTo(ACanvas, Rect(X, Y, X + FWidth, Y + FHeight)); end; procedure TKAlphaBitmap.AlphaFill(Alpha: Byte; IfEmpty: Boolean); var I: Integer; LocHasAlpha: Boolean; begin LocHasAlpha := False; if IfEmpty then LocHasAlpha := HasAlpha; if not LocHasAlpha then begin LockUpdate; try for I := 0 to FWidth * FHeight - 1 do FPixels[I].A := Alpha; finally UnlockUpdate; end; end; end; procedure TKAlphaBitmap.AlphaFillOnColorMatch(AColor: TColor; AAlpha: Byte); var I: Integer; CS: TKColorRec; begin LockUpdate; try CS := ColorToColorRec(AColor); SwapBR(CS); for I := 0 to FWidth * FHeight - 1 do if (FPixels[I].R = CS.R) and (FPixels[I].G = CS.G) and (FPixels[I].B = CS.B) then FPixels[I].A := AAlpha; finally UnlockUpdate; end; end; procedure TKAlphaBitmap.AlphaFillPercent(Percent: Integer; IfEmpty: Boolean); var I: Integer; begin LockUpdate; try for I := 0 to FWidth * FHeight - 1 do if FPixels[I].A <> 0 then FPixels[I].A := Percent * FPixels[I].A div 100 else if IfEmpty then FPixels[I].A := Percent * 255 div 100; finally UnlockUpdate; end; end; procedure TKAlphaBitmap.AlphaFill(Alpha: Byte; BlendColor: TColor; Gradient, Translucent: Boolean); var I, J, A1, A2, AR, AG, AB, HAlpha: Integer; HStep, HSum, VStep, VSum: Single; Scan: PKColorRecs; CS: TKColorRec; begin LockUpdate; try VSum := 0; VStep := 0; HSum := 0; HStep := 0; if Gradient then begin VStep := Alpha / FHeight; VSum := Alpha; end; CS := ColorToColorRec(BlendColor); {$IFNDEF MSWINDOWS} for I := 0 to FHeight - 1 do {$ELSE} for I := FHeight - 1 downto 0 do {$ENDIF} begin Scan := ScanLine[I]; HAlpha := Alpha; if Gradient then begin HStep := HAlpha / FWidth; HSum := HAlpha; end; for J := 0 to FWidth - 1 do with Scan[J] do begin A1 := HAlpha; A2 := 255 - HAlpha; AR := R * A1 + CS.R * A2; AG := G * A1 + CS.G * A2; AB := B * A1 + CS.B * A2; R := AR shr 8; G := AG shr 8; B := AB shr 8; if Translucent then A := HAlpha else A := 255; if Gradient then begin HAlpha := Round(HSum); HSum := HSum - HStep; end; end; if Gradient then begin Alpha := Round(VSum); VSum := VSum - VStep; end; end; finally UnlockUpdate; end; end; procedure TKAlphaBitmap.AlphaStretchDrawTo(ACanvas: TCanvas; const ARect: TRect); {$IF DEFINED(MSWINDOWS) OR DEFINED(LCLGTK) OR DEFINED(LCLGTK2)} var I: Integer; Tmp: TKAlphaBitmap; Ps, Pd: PKColorRecs; {$IFEND} begin {$IF DEFINED(MSWINDOWS) OR DEFINED(LCLGTK) OR DEFINED(LCLGTK2)} Tmp := TKAlphaBitmap.Create; try Tmp.SetSize(FWidth, FHeight); Tmp.Fill(MakeColorRec(255, 255, 255, 0)); Tmp.DrawFrom(ACanvas, ARect); for I := 0 to FHeight - 1 do begin Ps := ScanLine[I]; Pd := Tmp.ScanLine[I]; BlendLine(Ps, Pd, FWidth); end; Tmp.PixelsChanged := True; Tmp.DrawTo(ACanvas, ARect); finally Tmp.Free; end; {$ELSE} DrawTo(ACanvas, ARect); {$IFEND} end; procedure TKAlphaBitmap.Assign(Source: TPersistent); begin if Source = nil then SetSize(0, 0) else if Source is TKAlphaBitmap then TKAlphaBitmap(Source).AssignTo(Self) else if Source is TGraphic then LoadFromGraphic(TGraphic(Source)) else inherited; end; procedure TKAlphaBitmap.AssignTo(Dest: TPersistent); begin if Dest is TKAlphaBitmap then with TKAlphaBitmap(Dest) do begin AutoMirror := Self.AutoMirror; DirectCopy := Self.DirectCopy; CopyFrom(Self); end end; procedure TKAlphaBitmap.Clear; var I: Integer; begin LockUpdate; try for I := 0 to FWidth * FHeight - 1 do FPixels[I].Value := 0; finally UnlockUpdate; end; end; procedure TKAlphaBitmap.Changed(Sender: TObject); begin inherited; FPixelsChanged := True; end; procedure TKAlphaBitmap.CombinePixel(X, Y: Integer; Color: TKColorRec); var Index, A1, A2, AR, AG, AB: Integer; begin if (X >= 0) and (X < FWidth) and (Y >= 0) and (Y < FHeight) then begin LockUpdate; try SwapBR(Color); {$IFDEF MSWINDOWS} Index := (FHeight - Y - 1) * FWidth + X; {$ELSE} Index := Y * FWidth + X; {$ENDIF} A2 := Color.A; if A2 = 255 then FPixels[Index] := Color else if A2 <> 0 then begin A1 := 255 - Color.A; AR := FPixels[Index].R * A1 + Color.R * A2; AG := FPixels[Index].G * A1 + Color.G * A2; AB := FPixels[Index].B * A1 + Color.B * A2; FPixels[Index].R := AR shr 8; FPixels[Index].G := AG shr 8; FPixels[Index].B := AB shr 8; FPixels[Index].A := 255; end; finally UnlockUpdate; end; end; end; procedure TKAlphaBitmap.CopyFrom(AGraphic: TGraphic); begin if AGraphic is TKAlphaBitmap then CopyFromAlphaBitmap(AGraphic as TKAlphaBitmap) {$IFDEF USE_PNG_SUPPORT} else if AGraphic is TKPngImage then CopyFromPng(AGraphic as TKPngImage) {$ENDIF} else if AGraphic is TJpegImage then CopyFromJpeg(AGraphic as TJpegImage) else DrawFrom(AGraphic, 0, 0); end; procedure TKAlphaBitmap.CopyFromAlphaBitmap(ABitmap: TKAlphaBitmap); var I, Size: Integer; begin LockUpdate; try SetSize(ABitmap.Width, ABitmap.Height); Size := FWidth * SizeOf(TKColorRec); for I := 0 to FHeight - 1 do Move(ABitmap.ScanLine[I]^, ScanLine[I]^, Size); finally UnlockUpdate; end; end; procedure TKAlphaBitmap.CopyFromJpeg(AJpegImage: TJPEGImage); {$IFDEF FPC} var I, J: Integer; C: TKColorRec; IM: TLazIntfImage; FC: TFPColor; {$ENDIF} begin LockUpdate; try SetSize(AJpegImage.Width, AJpegImage.Height); {$IFDEF FPC} IM := AJpegImage.CreateIntfImage; try for I := 0 to AJpegImage.Width - 1 do begin for J := 0 to AJpegImage.Height - 1 do begin FC := IM.Colors[I, J]; C := FPColorToColorRec(FC); Pixel[I, J] := C; end; end; finally IM.Free; end; {$ELSE} // no access to JPEG pixels under Delphi DrawFrom(AJpegImage, 0, 0); DirectCopy := not HasAlpha; AlphaFill(255, True); {$ENDIF} finally UnlockUpdate; end; end; {$IFDEF USE_PNG_SUPPORT} procedure TKAlphaBitmap.CopyFromPng(APngImage: TKPngImage); var I, J: Integer; C: TKColorRec; {$IFDEF FPC} IM: TLazIntfImage; FC: TFPColor; {$ENDIF} begin LockUpdate; try SetSize(APngImage.Width, APngImage.Height); {$IFDEF FPC} IM := APngImage.CreateIntfImage; try {$ENDIF} for I := 0 to APngImage.Width - 1 do begin for J := 0 to APngImage.Height - 1 do begin {$IFDEF FPC} FC := IM.Colors[I, J]; C := FPColorToColorRec(FC); {$ELSE} C.Value := APngImage.Pixels[I, J]; if APngImage.AlphaScanline[J] <> nil then C.A := APngImage.AlphaScanline[J][I] else C.A := 255; {$ENDIF} Pixel[I, J] := C; end; end; {$IFDEF FPC} finally IM.Free; end; {$ENDIF} finally UnlockUpdate; end; end; {$ENDIF} procedure TKAlphaBitmap.CopyFromRotated(ABitmap: TKAlphaBitmap); var I, J: Integer; SrcScan, DstScan: PKColorRecs; begin LockUpdate; try SetSize(ABitmap.Height, ABitmap.Width); for J := 0 to ABitmap.Height - 1 do begin SrcScan := ABitmap.ScanLine[J]; for I := 0 to ABitmap.Width - 1 do begin DstScan := ScanLine[ABitmap.Width - I - 1]; DstScan[J] := SrcScan[I]; end; end; finally UnlockUpdate; end; end; procedure TKAlphaBitmap.CopyFromXY(X, Y: Integer; AGraphic: TGraphic); begin if AGraphic is TKAlphaBitmap then CopyFromXYAlphaBitmap(X, Y, AGraphic as TKAlphaBitmap) {$IFDEF USE_PNG_SUPPORT} else if AGraphic is TKPngImage then CopyFromXYPng(X, Y, AGraphic as TKPngImage) {$ENDIF} else if AGraphic is TJpegImage then CopyFromXYJpeg(X, Y, AGraphic as TJpegImage) else DrawFrom(AGraphic, X, Y); end; procedure TKAlphaBitmap.CopyFromXYAlphaBitmap(X, Y: Integer; ABitmap: TKAlphaBitmap); var I, J: Integer; begin LockUpdate; try for I := X to X + ABitmap.Width - 1 do for J := Y to Y + ABitmap.Height - 1 do if (I >= 0) and (I < FWidth) and (J >= 0) and (J < FHeight) then Pixels[J * FWidth + I] := ABitmap.Pixels[(J - Y) * ABitmap.Width + (I - X)]; finally UnlockUpdate; end; end; procedure TKAlphaBitmap.CopyFromXYJpeg(X, Y: Integer; AJpegImage: TJPEGImage); {$IFDEF FPC} var I, J: Integer; C: TKColorRec; IM: TLazIntfImage; FC: TFPColor; {$ENDIF} begin LockUpdate; try {$IFDEF FPC} IM := AJpegImage.CreateIntfImage; try for I := X to X + AJpegImage.Width - 1 do begin for J := Y to Y + AJpegImage.Height - 1 do begin if (I >= 0) and (I < FWidth) and (J >= 0) and (J < FHeight) then begin FC := IM.Colors[I - X, J - Y]; C := FPColorToColorRec(FC); Pixel[I, J] := C; end; end; end; finally IM.Free; end; {$ELSE} // no access to JPEG pixels under Delphi DrawFrom(AJpegImage, X, Y); DirectCopy := not HasAlpha; AlphaFill(255, True); {$ENDIF} finally UnlockUpdate; end; end; {$IFDEF USE_PNG_SUPPORT} procedure TKAlphaBitmap.CopyFromXYPng(X, Y: Integer; APngImage: TKPngImage); var I, J: Integer; C: TKColorRec; {$IFDEF FPC} IM: TLazIntfImage; FC: TFPColor; {$ENDIF} begin LockUpdate; try {$IFDEF FPC} IM := APngImage.CreateIntfImage; try {$ENDIF} for I := X to X + APngImage.Width - 1 do begin for J := Y to Y + APngImage.Height - 1 do begin if (I >= 0) and (I < FWidth) and (J >= 0) and (J < FHeight) then begin {$IFDEF FPC} FC := IM.Colors[I - X, J - Y]; C := FPColorToColorRec(FC); {$ELSE} C.Value := APngImage.Pixels[I - X, J - Y]; if APngImage.AlphaScanline[J - Y] <> nil then C.A := APngImage.AlphaScanline[J - Y][I - X] else C.A := 255; {$ENDIF} Pixel[I, J] := C; end; end; end; {$IFDEF FPC} finally IM.Free; end; {$ENDIF} finally UnlockUpdate; end; end; procedure TKAlphaBitmap.CopyToPng(APngImage: TKPngImage); var I, J: Integer; C: TKColorRec; {$IFDEF FPC} IM: TLazIntfImage; FC: TFPColor; {$ELSE} IM: TKPngImage; {$ENDIF} begin UpdatePixels; {$IFDEF FPC} IM := TLazIntfImage.Create(0, 0, [riqfRGB, riqfAlpha]); {$ELSE} IM := TKPngImage.CreateBlank(COLOR_RGBALPHA, 8, FWidth, FHeight); {$ENDIF} try {$IFDEF FPC} IM.SetSize(FWidth, FHeight); {$ENDIF} for I := 0 to FWidth - 1 do begin for J := 0 to FHeight - 1 do begin C := Pixel[I, J]; {$IFDEF FPC} FC := ColorRecToFPColor(C); IM.Colors[I, J] := FC; {$ELSE} IM.Pixels[I, J] := C.Value; if IM.AlphaScanline[J] <> nil then IM.AlphaScanline[J][I] := C.A; {$ENDIF} end; end; {$IFDEF FPC} APngImage.LoadFromIntfImage(IM); {$ELSE} APngImage.Assign(IM); {$ENDIF} finally IM.Free; end; end; {$ENDIF} procedure TKAlphaBitmap.Draw(ACanvas: TCanvas; const ARect: TRect); begin if FDirectCopy then DrawTo(ACanvas, ARect) else AlphaStretchDrawTo(ACanvas, ARect); end; procedure TKAlphaBitmap.DrawFrom(ACanvas: TCanvas; const ARect: TRect); begin if not Empty then begin if not CanvasScaled(ACanvas) then StretchBitmap(FCanvas.Handle, Rect(0, 0, FWidth, FHeight), ACanvas.Handle, ARect) else begin FCanvas.Brush := ACanvas.Brush; DrawFilledRectangle(FCanvas, Rect(0, 0, FWidth, FHeight), {$IFDEF MSWINDOWS}GetBkColor(ACanvas.Handle){$ELSE}clWindow{$ENDIF}); end; UpdatePixels; end; end; procedure TKAlphaBitmap.DrawFrom(AGraphic: TGraphic; X, Y: Integer); begin if not Empty then begin UpdateHandle; FCanvas.Draw(X, Y, AGraphic); UpdatePixels; end; end; procedure TKAlphaBitmap.DrawTo(ACanvas: TCanvas; const ARect: TRect); begin if not Empty then begin UpdateHandle; StretchBitmap(ACanvas.Handle, ARect, FCanvas.Handle, Rect(0, 0, FWidth, FHeight)) end; end; procedure TKAlphaBitmap.Fill(Color: TKColorRec); var I: Integer; begin LockUpdate; try for I := 0 to FWidth * FHeight - 1 do FPixels[I].Value := Color.Value; finally UnlockUpdate; end; end; function TKAlphaBitmap.GetEmpty: Boolean; begin Result := (FWidth = 0) and (FHeight = 0); end; function TKAlphaBitmap.GetHeight: Integer; begin Result := FHeight; end; function TKAlphaBitmap.GetPixel(X, Y: Integer): TKColorRec; begin if (X >= 0) and (X < FWidth) and (Y >= 0) and (Y < FHeight) then begin {$IFDEF MSWINDOWS} Result := FPixels[(FHeight - Y - 1) * FWidth + X]; {$ELSE} Result := FPixels[Y * FWidth + X]; {$ENDIF} SwapBR(Result); end else Result := MakeColorRec(0,0,0,0); end; function TKAlphaBitmap.GetTransparent: Boolean; begin Result := True; end; function TKAlphaBitmap.GetScanLine(Index: Integer): PKColorRecs; begin // no checks here Result := @FPixels[Index * FWidth]; end; function TKAlphaBitmap.GetHandle: HBITMAP; begin Result := FHandle; end; function TKAlphaBitmap.GetHasAlpha: Boolean; var I: Integer; begin Result := False; for I := 0 to FWidth * FHeight - 1 do if FPixels[I].A <> 0 then begin Result := True; Break; end; end; function TKAlphaBitmap.GetWidth: Integer; begin Result := FWidth; end; procedure TKAlphaBitmap.GrayScale; var I, Average: Integer; begin LockUpdate; try for I := 0 to FWidth * FHeight - 1 do begin // R and B are swapped Average := (Integer(7) * FPixels[I].R + Integer(72) * FPixels[I].G + Integer(21) * FPixels[I].B) div 100; FPixels[I].R := Average; FPixels[I].G := Average; FPixels[I].B := Average; end; finally UnlockUpdate; end; end; procedure TKAlphaBitmap.Brighten(APercent: Single; AMode: TKBrightMode); var I: Integer; X: TKColorRec; begin LockUpdate; try for I := 0 to FWidth * FHeight - 1 do begin X.Value := BrightColor(ColorRecToColor(FPixels[I]), APercent, AMode); FPixels[I].R := X.R; FPixels[I].G := X.G; FPixels[I].B := X.B; end; finally UnlockUpdate; end; end; {$IFNDEF FPC} procedure TKAlphaBitmap.LoadFromClipboardFormat(AFormat: Word; AData: THandle; APalette: HPALETTE); begin // does nothing end; {$ENDIF} procedure TKAlphaBitmap.LoadFromFile(const Filename: string); var IM: TPicture; begin IM := TPicture.Create; try IM.LoadFromFile(FileName); LoadFromGraphic(IM.Graphic); finally IM.Free; end; end; procedure TKAlphaBitmap.LoadFromHandles(ABitmap, AMask: HBITMAP); begin // todo end; procedure TKAlphaBitmap.LoadFromGraphic(Image: TGraphic); begin LockUpdate; try SetSize(Image.Width, Image.Height); {$IFDEF MSWINDOWS} Canvas.Draw(0, 0, Image); {$ELSE} if Image is TRasterImage then FImage.Assign(TRasterImage(Image).CreateIntfImage); {$ENDIF} // if bitmap has no alpha channel, create full opacity AlphaFill($FF, True); finally UnlockUpdate; end; end; procedure TKAlphaBitmap.LoadFromStream(Stream: TStream); var BF: TBitmapFileHeader; BI: TBitmapInfoHeader; begin Stream.Read(BF, SizeOf(TBitmapFileHeader)); if BF.bfType = $4D42 then begin Stream.Read(BI, SizeOf(TBitmapInfoHeader)); if BI.biBitCount = 32 then begin LockUpdate; try SetSize(BI.biWidth, BI.biHeight); Stream.Read(FPixels^, BI.biSizeImage); // if bitmap has no alpha channel, create full opacity AlphaFill($FF, True); {$IFnDEF MSWINDOWS} if FAutoMirror then MirrorVert; {$ENDIF} finally UnlockUpdate; end; end; end; end; procedure TKAlphaBitmap.LockUpdate; begin Inc(FUpdateLock); end; procedure TKAlphaBitmap.MirrorHorz; var I, J, Index: Integer; SrcScan: PKColorRecs; Buf: TKColorRec; begin LockUpdate; try for I := 0 to FHeight - 1 do begin SrcScan := ScanLine[I]; Index := FWidth - 1; for J := 0 to (FWidth shr 1) - 1 do begin Buf := SrcScan[Index]; SrcScan[Index] := SrcScan[J]; SrcScan[J] := Buf; Dec(Index); end; end; finally UnlockUpdate; end; end; procedure TKAlphaBitmap.MirrorVert; var I, Size, Index: Integer; SrcScan, DstScan: PKColorRecs; Buf: PKColorRec; begin LockUpdate; try Size:= FWidth * SizeOf(TKColorRec); Index := FHeight - 1; GetMem(Buf, Size); try for I := 0 to (FHeight shr 1) - 1 do begin SrcScan := ScanLine[I]; DstScan := ScanLine[Index]; Move(SrcScan^, Buf^, Size); Move(DstScan^, SrcScan^, Size); Move(Buf^, DstScan^, Size); Dec(Index); end; finally FreeMem(Buf); end; finally UnlockUpdate; end; end; {$IFNDEF FPC} procedure TKAlphaBitmap.SaveToClipboardFormat(var AFormat: Word; var AData: THandle; var APalette: HPALETTE); begin // does nothing end; {$ENDIF} procedure TKAlphaBitmap.SaveToStream(Stream: TStream); var Size: Integer; BF: TBitmapFileHeader; BI: TBitmapInfoHeader; begin {$IFnDEF MSWINDOWS} if FAutoMirror then MirrorVert; {$ENDIF} Size := FWidth * FHeight * 4; FillChar(BF, SizeOf(TBitmapFileHeader), 0); BF.bfType := $4D42; BF.bfSize := SizeOf(TBitmapFileHeader) + SizeOf(TBitmapInfoHeader) + Size; BF.bfOffBits := SizeOf(TBitmapFileHeader) + SizeOf(TBitmapInfoHeader); Stream.Write(BF, SizeOf(TBitmapFileHeader)); FillChar(BI, SizeOf(TBitmapInfoHeader), 0); BI.biSize := SizeOf(TBitmapInfoHeader); BI.biWidth := FWidth; BI.biHeight := FHeight; BI.biPlanes := 1; BI.biBitCount := 32; BI.biCompression := BI_RGB; BI.biSizeImage := Size; Stream.Write(BI, SizeOf(TBitmapInfoHeader)); Stream.Write(FPixels^, Size); {$IFnDEF MSWINDOWS} if FAutoMirror then MirrorVert; {$ENDIF} end; procedure TKAlphaBitmap.SetHeight(Value: Integer); begin SetSize(FWidth, Value); end; procedure TKAlphaBitmap.SetPixel(X, Y: Integer; Value: TKColorRec); begin if (X >= 0) and (X < FWidth) and (Y >= 0) and (Y < FHeight) then begin LockUpdate; try SwapBR(Value); {$IFDEF MSWINDOWS} FPixels[(FHeight - Y - 1) * FWidth + X] := Value; {$ELSE} FPixels[Y * FWidth + X] := Value; {$ENDIF} finally UnlockUpdate; end; end; end; procedure TKAlphaBitmap.SetSize(AWidth, AHeight: Integer); var {$IFNDEF MSWINDOWS} ImgFormatDescription: TRawImageDescription; {$ELSE} BI: TBitmapInfoHeader; {$ENDIF} begin AWidth := Max(AWidth, 0); AHeight := Max(AHeight, 0); if (AWidth <> FWidth) or (AHeight <> FHeight) then begin LockUpdate; try FWidth := AWidth; FHeight := AHeight; if FHandle <> 0 then begin SelectObject(FCanvas.Handle, FOldBitmap); DeleteObject(FHandle); FHandle := 0; {$IFNDEF MSWINDOWS} DeleteObject(FMaskHandle); FMaskHandle := 0; {$ENDIF} end; {$IFNDEF MSWINDOWS} FImage.SetSize(0, 0); {$ENDIF} FPixels := nil; if (FWidth <> 0) and (FHeight <> 0) then begin {$IFNDEF MSWINDOWS} ImgFormatDescription.Init_BPP32_B8G8R8A8_BIO_TTB(FWidth,FHeight); FImage.DataDescription := ImgFormatDescription; FPixelsChanged := True; UpdateHandle; {$ELSE} FillChar(BI, SizeOf(TBitmapInfoHeader), 0); BI.biSize := SizeOf(TBitmapInfoHeader); BI.biWidth := FWidth; BI.biHeight := FHeight; BI.biPlanes := 1; BI.biBitCount := 32; BI.biCompression := BI_RGB; FHandle := GDICheck(CreateDIBSection(FCanvas.Handle, PBitmapInfo(@BI)^, DIB_RGB_COLORS, Pointer(FPixels), 0, 0)); FOldBitmap := SelectObject(FCanvas.Handle, FHandle); {$ENDIF} end; finally UnlockUpdate; end; end; end; procedure TKAlphaBitmap.SetWidth(Value: Integer); begin SetSize(Value, FWidth); end; procedure TKAlphaBitmap.SetTransparent(Value: Boolean); begin // does nothing end; procedure TKAlphaBitmap.UnlockUpdate; begin if FUpdateLock > 0 then begin Dec(FUpdateLock); if FUpdateLock = 0 then Changed(Self); end; end; procedure TKAlphaBitmap.UpdateHandle; begin {$IFNDEF MSWINDOWS} if FPixelsChanged then begin PixelsChanged := False; if FHandle <> 0 then begin DeleteObject(FMaskHandle); DeleteObject(SelectObject(FCanvas.Handle, FOldBitmap)); end; FImage.CreateBitmaps(FHandle, FMaskHandle, False); FOldBitmap := SelectObject(FCanvas.Handle, FHandle); FPixels := PKColorRecs(FImage.PixelData); end; {$ENDIF} end; procedure TKAlphaBitmap.UpdatePixels; begin {$IFNDEF MSWINDOWS} FImage.LoadFromDevice(FCanvas.Handle); FPixelsChanged := True; UpdateHandle; {$ENDIF} end; { TKMetafile } {$IFDEF MSWINDOWS} constructor TKMetafile.Create; begin inherited; FCopyOnAssign := True; FEmfHandle := 0; FRequiredHeight := 0; FRequiredWidth := 0; FWmfHandle := 0; end; destructor TKMetafile.Destroy; begin Clear; inherited; end; procedure TKMetafile.Assign(Source: TPersistent); var Stream: TMemoryStream; begin if Source is TKMetafile then begin Clear; FEnhanced := TKMetafile(Source).Enhanced; if TKMetafile(Source).CopyOnAssign then begin Stream := TMemoryStream.Create; try TKMetafile(Source).SaveToStream(Stream); Stream.Seek(0, soFromBeginning); LoadFromStream(Stream); finally Stream.Free; end; end else begin // here, the source loses the images! TKMetafile(Source).Release(FWmfHandle, FEmfHandle); end; FRequiredHeight := TKMetafile(Source).Height; FRequiredWidth := TKMetafile(Source).Width; end; end; procedure TKMetafile.Clear; begin if FWmfHandle <> 0 then begin DeleteMetafile(FWmfHandle); FWmfHandle := 0; end; if FEmfHandle <> 0 then begin DeleteEnhMetafile(FEmfHandle); FEmfHandle := 0; end; end; procedure TKMetafile.Draw(ACanvas: TCanvas; const Rect: TRect); var BM: TKAlphaBitmap; begin inherited; if FWMfHandle <> 0 then begin if FRequiredWidth * FRequiredHeight > 0 then begin BM := TKAlphaBitmap.Create; try BM.DirectCopy := True; BM.SetSize(FRequiredWidth, FRequiredHeight); BM.Fill(MakeColorRec(255,255,255,255)); PlayMetafile(BM.Canvas.Handle, FWmfHandle); BM.DirectCopy := False; BM.DrawTo(ACanvas, Rect); finally BM.Free; end; end; end else if FEMFHandle <> 0 then begin PlayEnhMetafile(ACanvas.Handle, FEmfHandle, Rect); end; end; function TKMetafile.GetEmpty: Boolean; begin Result := (FWmfHandle = 0) and (FEmfHandle = 0); end; function TKMetafile.GetHeight: Integer; begin Result := FRequiredHeight; end; function TKMetafile.GetTransparent: Boolean; begin Result := False; end; function TKMetafile.GetWidth: Integer; begin Result := FRequiredWidth; end; procedure TKMetafile.LoadFromStream(Stream: TStream); var S: AnsiString; EHDR: TEnhMetaheader; MFP: TMetaFilePict; begin SetLength(S, Stream.Size - Stream.Position); if S <> '' then begin Stream.Read(EHDR, SizeOf(TEnhMetaHeader)); Stream.Seek(-SizeOf(TEnhMetaHeader), soFromCurrent); Stream.Read(S[1], Length(S)); if FEnhanced and (EHDR.iType = EMR_HEADER) then begin FEmfHandle := SetEnhMetafileBits(Length(S), @S[1]); FRequiredWidth := EHDR.rclBounds.Right - EHDR.rclBounds.Left; FRequiredHeight := EHDR.rclBounds.Bottom - EHDR.rclBounds.Top; end else begin FWmfHandle := SetMetafileBitsEx(Length(S), @S[1]); if FWmfHandle <> 0 then begin // obtain width and height with MFP do begin MM := MM_ANISOTROPIC; xExt := 0; yExt := 0; hmf := 0; end; FEmfHandle := SetWinMetaFileBits(Length(S), @S[1], 0, MFP); if FEmfHandle <> 0 then begin if GetEnhMetaFileHeader(FEmfHandle, SizeOf(TEnhMetaHeader), @EHDR) > 0 then begin FRequiredWidth := EHDR.rclBounds.Right - EHDR.rclBounds.Left; FRequiredHeight := EHDR.rclBounds.Bottom - EHDR.rclBounds.Top; end; DeleteEnhMetafile(FEmfHandle); FEmfHandle := 0; end; end; end; end; end; procedure TKMetafile.Release(out AWmfHandle: HMETAFILE; out AEmfHandle: HENHMETAFILE); begin AWmfHandle := FWmfHandle; FWmfHandle := 0; AEmfHandle := FEmfHandle; FEmfHandle := 0; end; procedure TKMetafile.SaveToStream(Stream: TStream); var S: AnsiString; Size: Integer; begin S := ''; if FWmfHandle <> 0 then begin Size := GetMetaFileBitsEx(FWmfHandle, 0, nil); if Size > 0 then begin SetLength(S, Size); GetMetafileBitsEx(FWmfHandle, Size, @S[1]); end; end else if FEmfHandle <> 0 then begin Size := GetEnhMetaFileBits(FEmfHandle, 0, nil); if Size > 0 then begin SetLength(S, Size); GetEnhMetafileBits(FEmfHandle, Size, @S[1]); end; end; if S <> '' then Stream.Write(S[1], Length(S)); end; procedure TKMetafile.SetEMFHandle(const Value: HENHMETAFILE); begin Clear; FEMFHandle := Value; end; procedure TKMetafile.SetEnhanced(const Value: Boolean); begin FEnhanced := Value; end; procedure TKMetafile.SetHeight(Value: Integer); begin FRequiredHeight := Value; end; procedure TKMetafile.SetWidth(Value: Integer); begin FRequiredWidth := Value; end; procedure TKMetafile.SetWMFHandle(const Value: HMETAFILE); begin Clear; FWMFHandle := Value; end; {$ENDIF} { TKTextBox } constructor TKTextBox.Create; begin inherited; FAttributes := []; FBackColor := clWhite; FHAlign := halLeft; FHasTabs := False; FHPadding := 0; FSelBkgnd := clHighlight; FSelColor := clHighlightText; FSelEnd := 0; FSelStart := 0; FSpacesForTab := 8; FText := ''; FVAlign := valCenter; FVPadding := 0; end; procedure TKTextBox.Draw(ACanvas: TCanvas; const ARect: TRect); var Y: Integer; TmpRect: TRect; PrevRgn: HRGN; begin if not IsRectEmpty(ARect) then begin if taFillRect in Attributes then DrawFilledRectangle(ACanvas, ARect, BackColor); if FText <> '' then begin Initialize(ACanvas, ARect); if not IsRectEmpty(FClipRect) then begin Y := GetVertPos; TmpRect := FClipRect; if taClip in Attributes then begin TranslateRectToDevice(ACanvas.Handle, TmpRect); PrevRgn := RgnCreateAndGet(ACanvas.Handle); try if ExtSelectClipRect(ACanvas.Handle, TmpRect, RGN_AND, PrevRgn) then begin if not (taFillText in Attributes) then SetBkMode(ACanvas.Handle, TRANSPARENT); Process(Y, tbfDraw); end; finally RgnSelectAndDelete(ACanvas.Handle, PrevRgn); end; end else begin if not (taFillText in Attributes) then SetBkMode(ACanvas.Handle, TRANSPARENT); Process(Y, tbfDraw); end; end; end; end; end; function TKTextBox.GetHorzPos(ATextWidth: Integer): Integer; begin case HAlign of halCenter: Result := Max(FClipRect.Left, (FClipRect.Left + FClipRect.Right - ATextWidth) div 2); halRight: Result := FClipRect.Right - ATextWidth; else Result := FClipRect.Left; end; end; function TKTextBox.GetVertPos: Integer; begin case VAlign of valCenter: begin Process(0, tbfMeasure); Result := Max(FClipRect.Top, (FClipRect.Bottom + FClipRect.Top - FCalcRect.Top) div 2); end; valBottom: begin Process(0, tbfMeasure); Result := FClipRect.Bottom - FCalcRect.Top; end else Result := FClipRect.Top; end; end; function TKTextBox.IndexToRect(ACanvas: TCanvas; const ARect: TRect; AIndex: Integer): TRect; var Y: Integer; begin Initialize(ACanvas, ARect); Y := GetVertPos; FIndex := AIndex; Process(Y, tbfGetRect); Result := FCalcRect; end; procedure TKTextBox.Initialize(ACanvas: TCanvas; const ARect: TRect); begin FCanvas := ACanvas; FClipRect := ARect; InflateRect(FClipRect, -HPadding, -VPadding); FFontHeight := GetFontHeight(FCanvas.Handle); end; procedure TKTextBox.Measure(ACanvas: TCanvas; const ARect: TRect; var AWidth, AHeight: Integer); begin Initialize(ACanvas, ARect); Process(0, tbfMeasure); AWidth := FCalcRect.Left; AHeight := FCalcRect.Top; end; procedure TKTextBox.Process(Y: Integer; AFunction: TKTextBoxFunction); var StartEllipsis, EndEllipsis, PathEllipsis: Boolean; Width, EllipsisWidth: Integer; NormalColor, NormalBkgnd: TColor; procedure Measure(AStart, ALen: Integer); begin FCalcRect.Left := Max(FCalcRect.Left, TextExtent(FCanvas, FText, AStart, ALen, FHasTabs, FSpacesForTab).cx); end; procedure GetIndex(Y: Integer; AStart, ALen: Integer); var Index, NewIndex, X, Width: Integer; begin if FIndex < 0 then begin if not (taIncludePadding in Attributes) and (Y <= FCalcRect.Top) and (FCalcRect.Top < Y + FFontHeight) or (taIncludePadding in Attributes) and ( (AStart = 1) and (FClipRect.Top <= FCalcRect.Top) and (FCalcRect.Top < Y + FFontHeight) or (AStart + ALen = Length(FText) + 1) and (Y <= FCalcRect.Top) and (FCalcRect.Top < FClipRect.Bottom) ) then begin Width := TextExtent(FCanvas, FText, AStart, ALen, FHasTabs, FSpacesForTab).cx; X := GetHorzPos(Width); if not (taIncludePadding in Attributes) and (X <= FCalcRect.Left) and (FCalcRect.Left < X + Width) or (taIncludePadding in Attributes) and (FClipRect.Left <= FCalcRect.Left) and (FCalcRect.Left < FClipRect.Right) then begin Index := AStart; while (FIndex < 0) and (Index <= AStart + ALen - 1) do begin NewIndex := StrNextCharIndex(FText, Index); Inc(X, TextExtent(FCanvas, FText, Index, NewIndex - Index, FHasTabs, FSpacesForTab).cx); if FCalcRect.Left < X then FIndex := Index; Index := NewIndex; end; if (taIncludePadding in Attributes) and (FIndex < 0) and (FCalcRect.Left < FClipRect.Right) then FIndex := Index; end; end; end; end; procedure GetRect(Y: Integer; AStart, ALen: Integer); var Index, NewIndex, X, Width: Integer; begin if (FIndex >= AStart) and (FIndex <= ALen) then begin Index := AStart; Width := TextExtent(FCanvas, FText, AStart, ALen, FHasTabs, FSpacesForTab).cx; X := GetHorzPos(Width); while Index < FIndex do begin NewIndex := StrNextCharIndex(FText, Index); Inc(X, TextExtent(FCanvas, FText, Index, NewIndex - Index, FHasTabs, FSpacesForTab).cx); Index := NewIndex; end; NewIndex := StrNextCharIndex(FText, Index); FCalcRect := Rect(X, Y, X + TextExtent(FCanvas, FText, Index, NewIndex - Index, FHasTabs, FSpacesForTab).cx, Y + FFontHeight); end end; procedure Draw(Y: Integer; AStart, ALen: Integer); var DrawEllipsis, DrawFileName, SetNormalColors, SetSelectionColors: Boolean; AWidth, Index, NewIndex, SlashPos, FileNameLen, EllipsisMaxX, X: Integer; S: TKString; begin if (Y >= FClipRect.Top - FFontHeight) and (Y <= FClipRect.Bottom) then begin DrawEllipsis := False; DrawFileName := False; SlashPos := 0; FileNameLen := 0; if (StartEllipsis or EndEllipsis or PathEllipsis) and (ALen > 1) then begin AWidth := TextExtent(FCanvas, FText, AStart, ALen, FHasTabs, FSpacesForTab).cx; if AWidth > Width then begin AWidth := 0; Index := AStart; if EndEllipsis or StartEllipsis then begin EllipsisMaxX := Width - EllipsisWidth; if EndEllipsis then begin while Index <= AStart + ALen - 1 do begin NewIndex := StrNextCharIndex(FText, Index); Inc(AWidth, TextExtent(FCanvas, FText, Index, NewIndex - Index, FHasTabs, FSpacesForTab).cx); if (AWidth >= EllipsisMaxX) and (Index > AStart) then Break else Index := NewIndex; end; ALen := Index - AStart; end else begin Index := AStart + ALen - 1; while Index > AStart do begin NewIndex := StrPreviousCharIndex(FText, Index); Inc(AWidth, TextExtent(FCanvas, FText, Index, Index - NewIndex, FHasTabs, FSpacesForTab).cx); if AWidth >= EllipsisMaxX then Break else Index := NewIndex; end; if Index = AStart + ALen - 1 then begin AStart := Index; ALen := 1; end else begin Dec(ALen, Index - AStart); AStart := Index + 1; end; end; DrawEllipsis := True; end else if PathEllipsis then begin SlashPos := AStart + ALen - 1; while (SlashPos > 0) and not CharInSetEx(FText[SlashPos], ['/', '\']) do Dec(SlashPos); Dec(SlashPos); if SlashPos > 0 then begin DrawEllipsis := True; DrawFileName := True; FileNameLen := AStart + ALen - SlashPos; EllipsisMaxX := Width - TextExtent(FCanvas, FText, SlashPos, FileNameLen, FHasTabs, FSpacesForTab).cx - EllipsisWidth; while (Index <= SlashPos) do begin NewIndex := StrNextCharIndex(FText, Index); Inc(AWidth, TextExtent(FCanvas, FText, Index, NewIndex - Index, FHasTabs, FSpacesForTab).cx); if AWidth >= EllipsisMaxX then Break else Index := NewIndex; end; ALen := Index - AStart; end; end; end; end; if DrawEllipsis then begin if DrawFileName then S := Copy(FText, AStart, ALen) + cEllipsis + Copy(FText, AStart + SlashPos, FileNameLen) else if EndEllipsis then S := Copy(FText, AStart, ALen) + cEllipsis else S := cEllipsis + Copy(FText, AStart, ALen); AStart := 1; ALen := Length(S); end else S := FText; X := GetHorzPos(TextExtent(FCanvas, S, AStart, ALen, FHasTabs, FSpacesForTab).cx); if DrawEllipsis or (SelStart = SelEnd) then TextOutput(FCanvas, X, Y, S, AStart, ALen, FHasTabs, FSpacesForTab) else begin AWidth := 0; Index := AStart; SlashPos := Index; // reuse while (Index <= AStart + ALen) do begin DrawFileName := False; // reuse SetNormalColors := False; SetSelectionColors := False; if Index = SelStart then begin DrawFileName := True; SetSelectionColors := True; end else if Index = SelEnd then begin DrawFileName := True; SetNormalColors := True; end else if Index = AStart + ALen then begin DrawFileName := True; end; if DrawFileName then begin if Index > SlashPos then begin if SetNormalColors then DrawFilledRectangle(FCanvas, Rect(X, Y, X + AWidth, Y + FFontHeight), FBackColor); if not (taFillText in Attributes) then SetBkMode(FCanvas.Handle, TRANSPARENT); TextOutput(FCanvas, X, Y, S, SlashPos, Index - SlashPos, FHasTabs, FSpacesForTab); end; Inc(X, AWidth); AWidth := 0; SlashPos := Index; end; if Index < AStart + ALen then begin NewIndex := StrNextCharIndex(FText, Index); Inc(AWidth, TextExtent(FCanvas, FText, Index, NewIndex - Index, FHasTabs, FSpacesForTab).cx); Index := NewIndex; end else Inc(Index); if SetNormalColors then begin FCanvas.Font.Color := NormalColor; FCanvas.Brush.Color := NormalBkgnd; end else if SetSelectionColors then begin FCanvas.Font.Color := SelColor; FCanvas.Brush.Color := SelBkgnd; end; end; end; end; end; var I, Index, TextLen, LineBegin, LineBreaks, Vert, TrimStart, TrimLen: Integer; WordBreak, LineBreak, WhiteSpace, PrevWhiteSpace, FirstWord, WasLineBreak, WrapText: Boolean; Size: TSize; begin case AFunction of tbfMeasure: FCalcRect := CreateEmptyRect; tbfGetIndex: FIndex := -1; tbfGetRect: FCalcRect := CreateEmptyRect; tbfDraw: ; end; Vert := Y; if FText <> '' then begin LineBegin := 1; LineBreaks := 0; TextLen := Length(FText); Width := FClipRect.Right - FClipRect.Left; WordBreak := taWordBreak in Attributes; LineBreak := taLineBreak in Attributes; WrapText := taWrapText in Attributes; //JR:20091229 if AFunction = tbfDraw then begin StartEllipsis := taStartEllipsis in Attributes; EndEllipsis := taEndEllipsis in Attributes; PathEllipsis := taPathEllipsis in Attributes; EllipsisWidth := TextExtent(FCanvas, cEllipsis, 1, Length(cEllipsis)).cx; NormalColor := FCanvas.Font.Color; NormalBkgnd := FCanvas.Brush.Color; end; if WordBreak or LineBreak then begin I := LineBegin; Index := LineBegin; WhiteSpace := True; FirstWord := True; WasLineBreak := False; while I <= TextLen + 1 do begin PrevWhiteSpace := WhiteSpace; WhiteSpace := CharInSetEx(FText[I], cWordBreaks + cLineBreaks); if (not PrevWhiteSpace and WhiteSpace and (I > LineBegin)) or (not PrevWhiteSpace and WrapText and (I > LineBegin)) then //JR:20091229 begin if (WordBreak or WrapText) and (LineBreaks = 0) and not FirstWord then begin TrimStart := LineBegin; TrimLen := I - LineBegin; TextTrim(FText, TrimStart, TrimLen); Size := TextExtent(FCanvas, FText, TrimStart, TrimLen, FHasTabs, FSpacesForTab); if Size.cx > Width then Inc(LineBreaks); end; if LineBreaks > 0 then begin if Index > LineBegin then begin TrimStart := LineBegin; TrimLen := Index - LineBegin; TextTrim(FText, TrimStart, TrimLen); case AFunction of tbfMeasure: Measure(TrimStart, TrimLen); tbfGetIndex: GetIndex(Vert, TrimStart, TrimLen); tbfGetRect: GetRect(Vert, TrimStart, TrimLen); tbfDraw: Draw(Vert, TrimStart, TrimLen); end; LineBegin := Index; end; Inc(Vert, FFontHeight * LineBreaks); LineBreaks := 0; end; Index := I; FirstWord := False; end; if LineBreak then if CharInSetEx(FText[I], cLineBreaks) then begin if not WasLineBreak then begin Inc(LineBreaks); WasLineBreak := True; end; end else WasLineBreak := False; Inc(I); end; end; if LineBegin <= TextLen then begin TrimStart := LineBegin; TrimLen := TextLen - LineBegin + 1; TextTrim(FText, TrimStart, TrimLen); case AFunction of tbfMeasure: Measure(TrimStart, TrimLen); tbfGetIndex: GetIndex(Vert, TrimStart, TrimLen); tbfGetRect: GetRect(Vert, TrimStart, TrimLen); tbfDraw: Draw(Vert, TrimStart, TrimLen) end; Inc(Vert, FFontHeight * (1 + LineBreaks)); end; end; case AFunction of tbfMeasure: begin if FText = '' then FCalcRect.Top := FFontHeight else FCalcRect.Top := Vert - Y; end; tbfGetIndex: ; tbfGetRect: if FText = '' then begin I := GetHorzPos(0); FCalcRect := Rect(I, Y, I, Y + FFontHeight); end; tbfDraw: ; end; end; procedure TKTextBox.SetText(const AText: TKString); begin if AText <> FText then begin FText := AText; FHasTabs := Pos(cTAB, FText) > 0; end; end; function TKTextBox.PointToIndex(ACanvas: TCanvas; const ARect: TRect; APoint: TPoint): Integer; var Y: Integer; begin Initialize(ACanvas, ARect); Y := GetVertPos; FCalcRect.TopLeft := APoint; Process(Y, tbfGetIndex); Result := FIndex; end; class function TKTextBox.TextExtent(ACanvas: TCanvas; const AText: TKString; AStart, ALen: Integer; AExpandTabs: Boolean; ASpacesForTab: Integer): TSize; var S: TKString; TextPtr: PKText; begin S := ''; if AExpandTabs then begin S := Copy(AText, AStart, ALen); ConvertTabsToSpaces(S, ASpacesForTab); TextPtr := @S[1]; ALen := Length(S); end else TextPtr := @AText[AStart]; {$IFDEF STRING_IS_UNICODE} {$IFDEF FPC} {$IFDEF USE_CANVAS_METHODS} if not AExpandTabs then S := Copy(AText, AStart, ALen); Result := ACanvas.TextExtent(S); // little slower but more secure in Lazarus {$ELSE} GetTextExtentPoint32(ACanvas.Handle, TextPtr, ALen, Result); {$ENDIF} {$ELSE} GetTextExtentPoint32(ACanvas.Handle, TextPtr, ALen, Result); {$ENDIF} {$ELSE} GetTextExtentPoint32W(ACanvas.Handle, TextPtr, ALen, Result); {$ENDIF} end; class procedure TKTextBox.TextOutput(ACanvas: TCanvas; X, Y: Integer; const AText: TKString; AStart, ALen: Integer; AExpandTabs: Boolean; ASpacesForTab: Integer); var S: TKString; TextPtr: PKText; begin if AExpandTabs then begin S := Copy(AText, AStart, ALen); ConvertTabsToSpaces(S, ASpacesForTab); TextPtr := @S[1]; ALen := Length(S); end else begin TextPtr := @AText[AStart]; S := AText; end; {$IFDEF STRING_IS_UNICODE} {$IFDEF FPC} {$IFDEF USE_CANVAS_METHODS} if not AExpandTabs then S := Copy(S, AStart, ALen); ACanvas.TextOut(X, Y, S); // little slower but more secure in Lazarus {$ELSE} TextOut(ACanvas.Handle, X, Y, TextPtr, ALen); {$ENDIF} {$ELSE} TextOut(ACanvas.Handle, X, Y, TextPtr, ALen); {$ENDIF} {$ELSE} TextOutW(ACanvas.Handle, X, Y, TextPtr, ALen); {$ENDIF} end; procedure TKTextBox.TextTrim(const AText: TKString; var AStart, ALen: Integer); begin if taLineBreak in Attributes then TrimWhiteSpaces(AText, AStart, ALen, cLineBreaks); if taTrimWhiteSpaces in Attributes then TrimWhiteSpaces(AText, AStart, ALen, cWordBreaks); end; { TKDragWindow } {$IFDEF MSWINDOWS} const cLayeredWndClass = 'KControls drag window'; function DragWndProc(Window: HWnd; Msg, WParam, LParam: Longint): Longint; stdcall; var DC: HDC; PS: TPaintStruct; AWindow: TKDragWindow; begin case Msg of WM_PAINT: begin AWindow := TKDragWindow(GetWindowLong(Window, GWL_USERDATA)); if (AWindow <> nil) and AWindow.BitmapFilled then begin if wParam = 0 then DC := BeginPaint(Window, PS) else DC := wParam; try BitBlt(DC, 0, 0, AWindow.Bitmap.Width, AWindow.Bitmap.Height, AWindow.Bitmap.Canvas.Handle, 0, 0, SRCCOPY); finally if wParam = 0 then EndPaint(Window, PS); end; end; Result := 1; end; else Result := DefWindowProc(Window, Msg, WParam, LParam); end; end; {$ELSE} type { TKDragForm } TKDragForm = class(THintWindow) private FWindow: TKDragWindow; procedure WMEraseBkGnd(var Msg: TLMessage); message LM_ERASEBKGND; protected procedure Paint; override; public constructor CreateDragForm(AWindow: TKDragWindow); end; { TKDragForm } constructor TKDragForm.CreateDragForm(AWindow: TKDragWindow); begin inherited Create(nil); FWindow := AWindow; ShowInTaskBar := stNever; end; procedure TKDragForm.Paint; begin if FWindow.Active and FWindow.BitmapFilled then Canvas.Draw(0, 0, FWindow.FBitmap); end; procedure TKDragForm.WMEraseBkGnd(var Msg: TLMessage); begin Msg.Result := 1; end; {$ENDIF} constructor TKDragWindow.Create; {$IFDEF MSWINDOWS} var Cls: Windows.TWndClass; ExStyle: Cardinal; {$ENDIF} begin inherited; FActive := False; FBitmap := TKAlphaBitmap.Create; FInitialPos := CreateEmptyPoint; {$IFDEF MSWINDOWS} FUpdateLayeredWindow := GetProcAddress(GetModuleHandle('user32.dll'), 'UpdateLayeredWindow'); FLayered := Assigned(FUpdateLayeredWindow); Cls.style := CS_SAVEBITS; Cls.lpfnWndProc := @DragWndProc; Cls.cbClsExtra := 0; Cls.cbWndExtra := 0; Cls.hInstance := HInstance; Cls.hIcon := 0; Cls.hCursor := 0; Cls.hbrBackground := 0; Cls.lpszMenuName := nil; Cls.lpszClassName := cLayeredWndClass; Windows.RegisterClass(Cls); ExStyle := WS_EX_TOOLWINDOW or WS_EX_TOPMOST; if FLayered then ExStyle := ExStyle or WS_EX_LAYERED or WS_EX_TRANSPARENT; FWindow := CreateWindowEx(ExStyle, cLayeredWndClass, '', WS_POPUP, Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT), 0, 0, HInstance, nil); Windows.SetWindowLong(FWindow, GWL_USERDATA, Integer(Self)); {$ELSE} FDragForm := TKDragForm.CreateDragForm(Self); FLayered := False; {$ENDIF} end; destructor TKDragWindow.Destroy; begin inherited; Hide; {$IFDEF MSWINDOWS} DestroyWindow(FWindow); Windows.UnregisterClass(cLayeredWndClass, HInstance); {$ELSE} FDragForm.Free; {$ENDIF} FBitmap.Free; end; procedure TKDragWindow.Hide; begin if FActive then begin {$IFDEF MSWINDOWS} ShowWindow(FWindow, SW_HIDE); {$ELSE} FDragForm.Hide; {$ENDIF} FActive := False; end; end; procedure TKDragWindow.Init(IniCtrl: TCustomControl; const ARect: TRect; const AInitialPos: TPoint; AMasterAlpha: Byte; AGradient: Boolean); var Org: TPoint; W, H: Integer; ScreenDC: HDC; begin if not FActive and ((IniCtrl = nil) or (IniCtrl is TKCustomControl)) then begin FActive := True; FBitmapFilled := False; FControl := IniCtrl; FMasterAlpha := AMasterAlpha; FGradient := AGradient; FInitialPos := AInitialPos; FRect := ARect; W := ARect.Right - ARect.Left; H := ARect.Bottom - ARect.Top; FBitmap.SetSize(W, H); ScreenDC := GetDC(0); try FAlphaEffects := GetDeviceCaps(ScreenDC, BITSPIXEL) >= 15; // because alpha blending is not nice elsewhere finally ReleaseDC(0, ScreenDC); end; if FControl <> nil then begin Org := FControl.ClientToScreen(ARect.TopLeft); // to be compatible with all LCL widgetsets we must copy the control's part // while painting in TKCustomControl.Paint! TKCustomControl(FControl).MemoryCanvas := FBitmap.Canvas; TKCustomControl(FControl).MemoryCanvasRect := ARect; TKCustomControl(FControl).Repaint; end else Org := ARect.TopLeft; {$IFDEF MSWINDOWS} if FLayered then with FBlend do begin BlendOp := AC_SRC_OVER; BlendFlags := 0; SourceConstantAlpha := 255; if FAlphaEffects then AlphaFormat := AC_SRC_ALPHA else AlphaFormat := 0; end; SetWindowPos(FWindow, HWND_TOP, Org.X, Org.Y, W, H, SWP_NOACTIVATE); {$ELSE} FDragForm.SetBounds(Org.X, Org.Y, W, H); {$ENDIF} end; end; procedure TKDragWindow.Move(ARect: PRect; const ACurrentPos: TPoint; AShowAlways: Boolean); var R: TRect; DX, DY: Integer; BlendColor: TColor; ChangedPos: Boolean; {$IFDEF MSWINDOWS} ScreenDC: HDC; CanvasOrigin: TPoint; {$ENDIF} begin if FActive then begin ChangedPos := False; DX := ACurrentPos.X - FInitialPos.X; DY := ACurrentPos.Y - FInitialPos.Y; if (DX <> 0) or (DY <> 0) then begin FInitialPos := ACurrentPos; ChangedPos := True; end; if ARect <> nil then ChangedPos := ChangedPos or not EqualRect(ARect^, FRect); if ((FControl = nil) or (TKCustomControl(FControl).MemoryCanvas = nil)) and not FBitmapFilled or (ARect <> nil) then begin FBitmapFilled := True; if ARect <> nil then FBitmap.SetSize(ARect.Right - ARect.Left, ARect.Bottom - ARect.Top); FBitmap.UpdatePixels; if FAlphaEffects then begin if FLayered then BlendColor := clBlack else BlendColor := clWhite; FBitmap.AlphaFill(FMasterAlpha, BlendColor, FGradient, FLayered); FBitmap.UpdateHandle; end; end; if ChangedPos or AShowAlways then begin {$IFDEF MSWINDOWS} if ARect <> nil then R := ARect^ else GetWindowRect(FWindow, R); KFunctions.OffsetRect(R, DX, DY); if FLayered then begin R.Right := FBitmap.Width; R.Bottom := FBitmap.Height; CanvasOrigin := CreateEmptyPoint; ScreenDC := GetDC(0); try if FUpdateLayeredWindow(FWindow, ScreenDC, @R.TopLeft, PSize(@R.BottomRight), FBitmap.Canvas.Handle, @CanvasOrigin, clNone, @FBlend, ULW_ALPHA) then if FBitmapFilled then ShowWindow(FWindow, SW_SHOWNOACTIVATE); finally ReleaseDC(0, ScreenDC); end; end else if FBitmapFilled then SetWindowPos(FWindow, 0, R.Left, R.Top, 0, 0, SWP_NOACTIVATE or SWP_NOSIZE or SWP_NOZORDER or SWP_SHOWWINDOW); {$ELSE} if ARect <> nil then R := ARect^ else R := FDragForm.BoundsRect; OffsetRect(R, DX, DY); FDragForm.BoundsRect := R; if FBitmapFilled then begin FDragForm.Visible := True; if FControl <> nil then SetCaptureControl(FControl); end; {$ENDIF} end; end; end; { TKHintWindow } constructor TKHintWindow.Create(AOwner: TComponent); begin inherited; {$IFDEF FPC} ShowInTaskBar := stNever; {$ENDIF} DoubleBuffered := True; end; procedure TKHintWindow.ShowAt(const Origin: TPoint); begin ActivateHint(Rect(Origin.X, Origin.Y, Origin.X + FExtent.X + 10, Origin.Y + FExtent.Y + 10), ''); // ActivateWithBounds(Rect(Origin.X, Origin.Y, Origin.X + FExtent.X + 10, Origin.Y + FExtent.Y + 10), ''); end; procedure TKHintWindow.Hide; begin {$IFDEF FPC} inherited Hide; {$ELSE} Self.DestroyHandle; {$ENDIF} end; procedure TKHintWindow.WMEraseBkGnd(var Msg: TLMessage); begin Msg.Result := 1; end; { TKTextHint } constructor TKTextHint.Create(AOwner: TComponent); begin inherited; FText := ''; {$IFDEF FPC} Font := Screen.HintFont; {$ENDIF} end; procedure TKTextHint.Paint; var TextBox: TKTextBox; begin Canvas.Font := Font; Canvas.Brush.Style := bsSolid; Canvas.Brush.Color := clInfoBk; Canvas.FillRect(ClientRect); Canvas.Brush.Style := bsClear; TextBox := TKTextBox.Create; try TextBox.Attributes := [taEndEllipsis, taWordBreak, taLineBreak]; TextBox.HPadding := 5; TextBox.VPadding := 5; TextBox.Text := FText; TextBox.Draw(Canvas, Rect(0, 0, FExtent.X + 10, FExtent.Y + 10)); finally TextBox.Free; end; end; procedure TKTextHint.SetText(const Value: TKString); var R: TRect; TextBox: TKTextBox; begin if Value <> FText then begin FText := Value; R := Rect(0, 0, 300, 0); TextBox := TKTextBox.Create; try TextBox.Attributes := [taWordBreak, taLineBreak]; TextBox.Text := FText; TextBox.Measure(Canvas, R, FExtent.X, FExtent.Y); finally TextBox.Free; end; end; end; { TKGraphicHint } constructor TKGraphicHint.Create(AOwner: TComponent); begin inherited; FGraphic := nil; {$IFDEF FPC} ShowInTaskBar := stNever; {$ENDIF} DoubleBuffered := True; end; procedure TKGraphicHint.Paint; begin Canvas.Brush.Style := bsSolid; Canvas.Brush.Color := clInfoBk; Canvas.FillRect(ClientRect); if Assigned(FGraphic) then Canvas.Draw(5, 5, FGraphic) end; procedure TKGraphicHint.SetGraphic(const Value: TGraphic); begin if Value <> FGraphic then begin FGraphic := Value; FExtent.X := FGraphic.Width; FExtent.Y := FGraphic.Height; end; end; { TKSizingGrips } constructor TKSizingGrips.Create; begin FBoundsRect := CreateEmptyRect; FGripColor := cSizingGripColor; FGripSize := cSizingGripSize; FMidGripConstraint := cSizingMidGripConstraint; end; class procedure TKSizingGrips.ClsAffectRect(APosition: TKSizingGripPosition; ADX, ADY: Integer; var ARect: TRect); begin case APosition of sgpLeft: Inc(ARect.Left, ADX); sgpRight: Inc(ARect.Right, ADX); sgpTop: Inc(ARect.Top, ADY); sgpBottom: Inc(ARect.Bottom, ADY); sgpTopLeft: begin Inc(ARect.Left, ADX); Inc(ARect.Top, ADY); end; sgpTopRight: begin Inc(ARect.Right, ADX); Inc(ARect.Top, ADY); end; sgpBottomLeft: begin Inc(ARect.Left, ADX); Inc(ARect.Bottom, ADY); end; sgpBottomRight: begin Inc(ARect.Right, ADX); Inc(ARect.Bottom, ADY); end; else KFunctions.OffsetRect(ARect, ADX, ADY); end; end; function TKSizingGrips.CursorAt(const APoint: TPoint): TCursor; begin Result := CursorFor(HitTest(APoint)); end; function TKSizingGrips.CursorFor(APosition: TKSizingGripPosition): TCursor; begin case APosition of sgpLeft, sgpRight: Result := crSizeWE; sgpTop, sgpBottom: Result := crSizeNS; sgpTopLeft, sgpBottomRight: Result := crSizeNWSE; sgpTopRight, sgpBottomLeft: Result := crSizeNESW; else Result := crDefault; end; end; procedure TKSizingGrips.DrawTo(ACanvas: TCanvas); begin with ACanvas do begin Brush.Style := bsSolid; Brush.Color := FGripColor; // take the corners first ACanvas.FillRect(GripRect(sgpTopLeft)); ACanvas.FillRect(GripRect(sgpTopRight)); ACanvas.FillRect(GripRect(sgpBottomLeft)); ACanvas.FillRect(GripRect(sgpBottomRight)); // take middle grips if FBoundsRect.Right - FBoundsRect.Left >= FMidGripConstraint then begin ACanvas.FillRect(GripRect(sgpTop)); ACanvas.FillRect(GripRect(sgpBottom)); end; if FBoundsRect.Bottom - FBoundsRect.Top >= FMidGripConstraint then begin ACanvas.FillRect(GripRect(sgpLeft)); ACanvas.FillRect(GripRect(sgpRight)); end; end; end; function TKSizingGrips.GripRect(APosition: TKSizingGripPosition): TRect; begin case APosition of sgpLeft: begin Result.Left := FBoundsRect.Left; Result.Top := FBoundsRect.Top + (FBoundsRect.Bottom - FBoundsRect.Top - FGripSize) div 2; end; sgpRight: begin Result.Left := FBoundsRect.Right - FGripSize; Result.Top := FBoundsRect.Top + (FBoundsRect.Bottom - FBoundsRect.Top - FGripSize) div 2; end; sgpTop: begin Result.Left := FBoundsRect.Left + (FBoundsRect.Right - FBoundsRect.Left - FGripSize) div 2; Result.Top := FBoundsRect.Top; end; sgpBottom: begin Result.Left := FBoundsRect.Left + (FBoundsRect.Right - FBoundsRect.Left - FGripSize) div 2; Result.Top := FBoundsRect.Bottom - FGripSize; end; sgpTopLeft: begin Result.Left := FBoundsRect.Left; Result.Top := FBoundsRect.Top; end; sgpTopRight: begin Result.Left := FBoundsRect.Right - FGripSize; Result.Top := FBoundsRect.Top; end; sgpBottomLeft: begin Result.Left := FBoundsRect.Left; Result.Top := FBoundsRect.Bottom - FGripSize; end; sgpBottomRight: begin Result.Left := FBoundsRect.Right - FGripSize; Result.Top := FBoundsRect.Bottom - FGripSize; end else Result := CreateEmptyRect; end; if APosition <> sgpNone then begin Result.Right := Result.Left + FGripSize; Result.Bottom := Result.Top + FGripSize; end; end; function TKSizingGrips.HitTest(const APoint: TPoint): TKSizingGripPosition; var I: TKSizingGripPosition; R: TRect; begin Result := sgpNone; for I := Low(TKSizingGripPosition) to High(TKSizingGripPosition) do if I <> sgpNone then begin R := GripRect(I); if PtInRect(R, APoint) then begin Result := I; Break; end; end; end; procedure RegisterAlphaBitmap; begin TPicture.RegisterFileFormat('BMA', sGrAlphaBitmap, TKAlphaBitmap); end; procedure UnregisterAlphaBitmap; begin TPicture.UnregisterGraphicClass(TKAlphaBitmap); end; {$IFDEF REGISTER_PICTURE_FORMATS} initialization RegisterAlphaBitmap; finalization //not necessary, but... UnregisterAlphaBitmap; {$ENDIF} end. tomboy-ng_0.39-1/kcontrols/source/kprintsetup.lfm0000644000175000017500000002070014346341266022036 0ustar dbannondbannonobject KPrintSetupForm: TKPrintSetupForm Left = 798 Height = 386 Top = 397 Width = 464 ActiveControl = EDTitle BorderStyle = bsDialog Caption = 'Page setup' ClientHeight = 386 ClientWidth = 464 Font.Height = -11 Font.Name = 'Tahoma' OnCloseQuery = FormCloseQuery OnCreate = FormCreate OnDestroy = FormDestroy OnShow = FormShow Position = poScreenCenter LCLVersion = '1.7' object GBFileToPrint: TGroupBox Left = 8 Height = 45 Top = 8 Width = 449 Caption = 'Title of printed document:' ClientHeight = 27 ClientWidth = 445 TabOrder = 0 object EDTitle: TEdit Left = 8 Height = 21 Top = 2 Width = 432 TabOrder = 0 Text = 'EDTitle' end end object GBPrintOptions: TGroupBox Left = 8 Height = 123 Top = 109 Width = 249 Caption = 'Print options:' ClientHeight = 105 ClientWidth = 245 TabOrder = 1 object Label1: TLabel Left = 162 Height = 13 Top = 4 Width = 29 Caption = 'Scale:' FocusControl = EDPrintScale ParentColor = False end object CBFitToPage: TCheckBox Left = 8 Height = 19 Top = 2 Width = 72 Caption = '&Fit to page' OnClick = EDTopExit TabOrder = 0 end object CBPageNumbers: TCheckBox Left = 8 Height = 19 Top = 21 Width = 88 Caption = 'Pa&ge numbers' OnClick = CBPageNumbersClick TabOrder = 1 end object CBUseColor: TCheckBox Left = 8 Height = 19 Top = 40 Width = 64 Caption = '&Use color' OnClick = CBPageNumbersClick TabOrder = 2 end object EDPrintScale: TEdit Left = 162 Height = 21 Top = 20 Width = 48 OnExit = EDTopExit TabOrder = 3 end object CBPaintSelection: TCheckBox Left = 8 Height = 19 Top = 59 Width = 89 Caption = 'Pa&int selection' OnClick = CBPageNumbersClick TabOrder = 4 end object CBPrintTitle: TCheckBox Left = 8 Height = 19 Top = 78 Width = 63 Caption = 'Print tit&le' OnClick = CBPageNumbersClick TabOrder = 5 end object CBLineNumbers: TCheckBox Left = 134 Height = 19 Top = 59 Width = 83 Caption = '&Line numbers' OnClick = CBPageNumbersClick TabOrder = 6 end object CBWrapLines: TCheckBox Left = 134 Height = 19 Top = 78 Width = 70 Caption = 'Wrap lines' OnClick = CBPageNumbersClick TabOrder = 7 end end object BUPrint: TButton Left = 89 Height = 25 Top = 350 Width = 74 Caption = '&Print' OnClick = BUPrintClick TabOrder = 4 end object BUCancel: TButton Left = 383 Height = 25 Top = 350 Width = 74 Cancel = True Caption = 'Cancel' ModalResult = 2 TabOrder = 5 end object GBMargins: TGroupBox Left = 264 Height = 236 Top = 109 Width = 193 Caption = 'Margins:' ClientHeight = 218 ClientWidth = 189 TabOrder = 3 object LBMarginUnits: TLabel Left = 8 Height = 13 Top = 6 Width = 62 Caption = 'Margin u&nits:' FocusControl = CoBMarginUnits ParentColor = False end object LBLeft: TLabel Left = 8 Height = 13 Top = 67 Width = 23 Caption = 'Left:' FocusControl = EDLeft ParentColor = False end object LBRight: TLabel Left = 102 Height = 13 Top = 67 Width = 29 Caption = 'Right:' FocusControl = EDRight ParentColor = False end object LBTop: TLabel Left = 9 Height = 13 Top = 126 Width = 22 Caption = 'Top:' FocusControl = EDTop ParentColor = False end object LBBottom: TLabel Left = 102 Height = 13 Top = 112 Width = 38 Caption = 'Bottom:' FocusControl = EDBottom ParentColor = False end object LBUnitsLeft: TLabel Left = 58 Height = 13 Top = 86 Width = 7 Caption = 'A' ParentColor = False end object LBUnitsTop: TLabel Left = 58 Height = 13 Top = 131 Width = 7 Caption = 'A' ParentColor = False end object LBUnitsRight: TLabel Left = 152 Height = 13 Top = 86 Width = 7 Caption = 'A' ParentColor = False end object LBUnitsBottom: TLabel Left = 152 Height = 13 Top = 131 Width = 7 Caption = 'A' ParentColor = False end object CoBMarginUnits: TComboBox Left = 8 Height = 21 Top = 22 Width = 176 ItemHeight = 13 Items.Strings = ( 'milimeters' 'centimeters' 'inches' 'hundredths of inches' ) OnChange = CoBMarginUnitsChange Style = csDropDownList TabOrder = 0 end object CBMirrorMargins: TCheckBox Left = 8 Height = 19 Top = 162 Width = 88 Caption = '&Mirror margins' OnClick = CBPageNumbersClick TabOrder = 5 end object EDLeft: TEdit Left = 8 Height = 21 Top = 83 Width = 48 OnExit = EDTopExit TabOrder = 1 end object EDRight: TEdit Left = 102 Height = 21 Top = 83 Width = 48 OnExit = EDTopExit TabOrder = 2 end object EDTop: TEdit Left = 8 Height = 21 Top = 128 Width = 48 OnExit = EDTopExit TabOrder = 3 end object EDBottom: TEdit Left = 102 Height = 21 Top = 128 Width = 48 OnExit = EDTopExit TabOrder = 4 end end object GBPageSelection: TGroupBox Left = 8 Height = 105 Top = 240 Width = 249 Caption = 'Page selection:' ClientHeight = 87 ClientWidth = 245 TabOrder = 2 object LBRangeTo: TLabel Left = 163 Height = 13 Top = 32 Width = 14 Caption = 'to:' ParentColor = False end object LBCopies: TLabel Left = 8 Height = 13 Top = 59 Width = 87 Caption = 'Number of &copies:' FocusControl = EDCopies ParentColor = False end object RBAll: TRadioButton Left = 8 Height = 19 Top = 3 Width = 63 Caption = '&All pages' Checked = True OnClick = RBAllClick TabOrder = 0 TabStop = True end object RBRange: TRadioButton Left = 8 Height = 19 Top = 29 Width = 80 Caption = '&Range from:' OnClick = RBAllClick TabOrder = 1 end object RBSelectedOnly: TRadioButton Left = 128 Height = 19 Top = 3 Width = 84 Caption = 'Selected &only' OnClick = RBAllClick TabOrder = 2 end object EDRangeFrom: TEdit Left = 108 Height = 21 Top = 27 Width = 48 OnExit = EDTopExit TabOrder = 3 end object EDRangeTo: TEdit Left = 193 Height = 21 Top = 27 Width = 48 OnExit = EDTopExit TabOrder = 4 end object EDCopies: TEdit Left = 126 Height = 21 Top = 54 Width = 48 TabOrder = 5 end object CBCollate: TCheckBox Left = 179 Height = 19 Top = 56 Width = 53 Caption = 'Collate' OnClick = CBPageNumbersClick TabOrder = 6 end end object BUPreview: TButton Left = 8 Height = 25 Top = 350 Width = 75 Caption = 'Previe&w...' OnClick = BUPreviewClick TabOrder = 6 end object BUOk: TButton Left = 303 Height = 25 Top = 350 Width = 74 Caption = 'OK' Default = True ModalResult = 1 TabOrder = 7 end object GBPrinter: TGroupBox Left = 8 Height = 50 Top = 56 Width = 449 Caption = 'Printer settings' ClientHeight = 32 ClientWidth = 445 TabOrder = 8 object LBPrinterName: TLabel Left = 8 Height = 13 Top = 6 Width = 65 Caption = 'Printer name:' FocusControl = EDCopies ParentColor = False end object CoBPrinterName: TComboBox Left = 112 Height = 21 Top = 2 Width = 206 ItemHeight = 13 OnChange = EDTopExit TabOrder = 0 Text = 'CoBPrinterName' end object BUConfigure: TButton Left = 328 Height = 25 Top = 1 Width = 113 Caption = 'Configure...' OnClick = BUConfigureClick TabOrder = 1 end end end tomboy-ng_0.39-1/kcontrols/source/kres.pas0000644000175000017500000003116614346341266020427 0ustar dbannondbannon{ @abstract(This file is part of the KControls component suite for Delphi and Lazarus.) @author(Tomas Krysl) Copyright (c) 2020 Tomas Krysl

License:
This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html. } unit kres; // lowercase name because of Lazarus/Linux {$include kcontrols.inc} {$WEAKPACKAGEUNIT ON} interface { Because the resourcestring concept used in Delphi is not always the best way to localize an application, I decided to implement routines which allow to modify the resourcestrings dynamically at runtime. They allow for direct localization e.g. from XML file without the need of the standard localization scheme for resourcestrings. Especially if you need to translate only some of the strings it is much easier approach. } { Standard resourcestrings localized to english by default } resourcestring // KGraphics texts sGrAlphaBitmap = 'KControls alpha bitmap'; // KDialogs texts sBrowseDirectory = 'Choose directory:'; // KEdits texts sEDBadSubDirName = 'The invalid subdirectory "%s" has been replaced with "%s".'; sEDCurrentDirAdded = 'Current path added to path "%s".'; sEDBadDir = 'The directory "%s" can be invalid.'; sEDBadDirCorr = 'Invalid or incomplete directory "%s" has been replaced with "%s".'; sEDBadPath = 'The path or file name "%s" can be incomplete or invalid.'; sEDBadPathCorr = 'Invalid path or file name "%s" has been replaced with "%s".'; sEDMissingFileName = 'Missing file name.'; sEDNoExistingDir = 'The directory "%s" doesn''t exist.'; sEDNoExistingPath = 'The file "%s" doesn''t exist.'; sEDFormatNotAccepted = 'The text either doesn''t represent a numeral or the numeric format cannot be accepted.'; sEDBadFloatValueAsStr = 'The text is not a float value in the range from %s to %s. Value corrected to %s.'; sEDBadIntValueAsStr = 'The text is not a decimal value in the range from %s to %s. Value corrected to %s.'; sEDBadHexValueAsStr = 'The text is not a hexadecimal value in the range from %s to %s. Value corrected to %s.'; sEDClipboardFmtNotAccepted = 'The current clipboard text cannot be accepted.'; sEDBrowse = 'Browse ...'; sEDAllFiles = 'All files (*.*)|*.*'; // KGraphics texts sGDIError = 'GDI object could not be created.'; sErrGraphicsLoadFromResource = 'Graphics could not be loaded from resource.'; // KHexEditor texts sHEAddressText = 'Address area text'; sHEAddressBkGnd = 'Address area background'; sHEBkGnd = 'Editor background'; sHEDigitTextEven = 'Digit area even column'; sHEDigitTextOdd = 'Digit area odd column'; sHEDigitBkgnd = 'Digit area background'; sHEHorzLines = 'Horizontal lines'; sHEInactiveCaretBkGnd = 'Inactive caret background'; sHEInactiveCaretSelBkGnd = 'Selected inactive caret background'; sHEInactiveCaretSelText = 'Selected inactive caret text'; sHEInactiveCaretText = 'Inactive caret text'; sHELinesHighLight = 'Lines highlight'; sHESelBkGnd = 'Selection background'; sHESelBkGndFocused = 'Focused selection background'; sHESelText = 'Selection text'; sHESelTextFocused = 'Focused selection text'; sHESeparators = 'Area separating lines'; sHETextText = 'Text area text'; sHETextBkGnd = 'Text area background'; sHEVertLines = 'Vertical lines'; // KIcons texts sIconIcons = 'Icons'; sIconCursors = 'Cursors'; sIconAllocationError = 'Error while allocating icon data'; sIconBitmapError = 'Invalid icon bitmap handles'; sIconFormatError = 'Invalid icon format'; sIconResourceError = 'Invalid icon resource'; sIconIndexError = 'Invalid icon resource index'; sIconInvalidModule = 'Invalid module or no icon resources'; sIconResizingError = 'Error while resizing icon'; sIconAssocResolveError = 'Error while resolving associated icon'; // KLog texts sLogError = 'Error'; sLogWarning = 'Warning'; sLogNote = 'Note'; sLogHint = 'Hint'; sLogInfo = 'Info'; sLogInputError = 'Input error'; sLogIOError = 'IO error'; // KMessagebox texts sMsgBoxYes = '&Yes'; sMsgBoxNo = '&No'; sMsgBoxOK = '&OK'; sMsgBoxCancel = 'Cancel'; sMsgBoxClose = '&Close'; sMsgBoxAbort = 'A&bort'; sMsgBoxRetry = '&Retry'; sMsgBoxIgnore = '&Ignore'; sMsgBoxAll = '&All'; sMsgBoxNoToAll = 'Non&e'; sMsgBoxYesToAll = 'Ye&s to all'; sMsgBoxHelp = '&Help'; // KPrinterSetup texts sPSPrinterSetup = 'Printer setup'; sPSAllPages = 'All pages (%d)'; sPSErrPrintSetup = 'Print setup error'; sPSErrNoPrinterInstalled = 'No printer is installed on this computer.'; sPSErrNoDefaultPrinter = 'No default printer selected, cannot continue. Please select default printer.'; sPSErrPrinterUnknown = 'Unknown error in printer interface. Please restart application and try again.'; sPSErrPrinterConfiguration = 'Printer configuration not supported.'; // KControlsDesign texts sInvalidGraphicFormat = 'Invalid graphic format.'; // KDBGrids texts sDataSetUnidirectional = 'Cannot use KDBGrid with a unidirectional dataset.'; // KMemoRTF texts sErrMemoLoadFromRTF = 'Error while reading RTF file.'; sErrMemoLoadImageFromRTF = 'Error while loading image from RTF file.'; sErrMemoSaveToRTF = 'Error while saving RTF file.'; // KMemoFrame texts sAppError = 'Application error'; sAppQuery = 'Application query'; sMemoDefaultFileName = 'document'; sQueryFileSave = 'File "%s" has been changed. Do you want to save it?'; sErrMemoLoadFromFile = 'Error while loading file "%s".'; sErrMemoSaveToFile = 'Error while saving file "%s".'; sMemoSampleTextBox = 'Enter the text box contents. The textbox can be placed anywhere in the document.'; { Localize given resourcestring directly. Usage: ResMod(@sYourResourceString, 'New text'); Note: Text passed to NewValue must persist through the entire application lifetime under Delphi, as only its pointer is taken! } procedure ResMod(Res: PResStringRec; const NewValue: string); { Localize all resourcestrings to Czech language. } procedure LocalizeToCzech; implementation {$IFnDEF FPC} uses Windows, KFunctions; {$ENDIF} {$IFDEF FPC} type PResModRec = ^TResModRec; TResModRec = record DefStr: string; NewStr: string; end; function ResModIterator(Name, Value: AnsiString; Hash: Longint; arg:pointer): AnsiString; begin if Value = PResModRec(arg).DefStr then Result := PResModRec(arg).NewStr else Result := ''; end; procedure ResMod(Res: PResStringRec; const NewValue: string); var RM: TResModRec; begin if (Res <> nil) and (Res^ <> '') then begin RM.DefStr := Res^; RM.NewStr := NewValue; SetResourceStrings(ResModIterator, @RM); end; end; {$ELSE} procedure ResMod(Res: PResStringRec; const NewValue: string); var OldProtect: LongWord; OK: Boolean; begin if (Res <> nil) and (Res.Module <> nil) then begin OK := VirtualProtect(Res, Sizeof(TResStringRec), PAGE_EXECUTE_READWRITE, @oldProtect); if OK then begin {$IFDEF COMPILER16_UP} // new code for Delphi XE2 and later Res.Identifier := NativeUInt(NewValue); {$ELSE} Res.Identifier := LongInt(NewValue); {$ENDIF} VirtualProtect(Res, SizeOf(TResStringRec), oldProtect, @oldProtect); end; end; end; {$ENDIF} procedure LocalizeToCzech; begin // KGraphics texts ResMod(@sGrAlphaBitmap, 'Alpha bitmap KControls'); // KDialogs texts ResMod(@sBrowseDirectory, 'Vyberte sloku:'); // KEdits texts ResMod(@sEDBadSubDirName, 'Neplatn podsloka "%s" byla nahrazena "%s".'); ResMod(@sEDCurrentDirAdded, 'Aktuln cesta byla pidna k cest "%s".'); ResMod(@sEDBadDir, 'Sloka "%s" me bt neplatn.'); ResMod(@sEDBadDirCorr, 'Neplatn nebo nekompletn sloka "%s" byla nahrazena "%s".'); ResMod(@sEDBadPath, 'Cesta nebo soubor "%s" nemus bt kompletn nebo platn.'); ResMod(@sEDBadPathCorr, 'Neplatn cesta nebo soubor "%s" byl(a) nahrazen(a) "%s".'); ResMod(@sEDMissingFileName, 'Chyb nzev souboru.'); ResMod(@sEDNoExistingDir, 'Sloka "%s" neexistuje.'); ResMod(@sEDNoExistingPath, 'Soubor "%s" neexistuje.'); ResMod(@sEDFormatNotAccepted, 'Text nen slem nebo seln formt nelze pijmout.'); ResMod(@sEDBadFloatValueAsStr, 'Text nen relnm slem v rozsahu od %s do %s. Hodnota opravena na %s.'); ResMod(@sEDBadIntValueAsStr, 'Text nen celm slem v rozsahu od %s do %s. Hodnota opravena na %s.'); ResMod(@sEDBadHexValueAsStr, 'Text nen hexadecimlnm slem od %s do %s. Hodnota opravena na %s.'); ResMod(@sEDClipboardFmtNotAccepted, 'Text ze schrnky nelze pijmout.'); ResMod(@sEDBrowse, 'Prochzet...'); ResMod(@sEDAllFiles, 'Vechny soubory (*.*)|*.*'); // KGraphics texts ResMod(@sGDIError, 'Objekt GDI nelze vytvoit.'); // KHexEditor texts ResMod(@sHEAddressText, 'Ps adresy - text'); ResMod(@sHEAddressBkGnd, 'Ps adresy - pozad'); ResMod(@sHEBkGnd, 'Pozad editoru'); ResMod(@sHEDigitTextEven, 'Ps slic sud sloupec - text'); ResMod(@sHEDigitTextOdd, 'Ps slic lich sloupec - text'); ResMod(@sHEDigitBkgnd, 'Ps slic - pozad'); ResMod(@sHEHorzLines, 'Vodorovn linky'); ResMod(@sHEInactiveCaretBkGnd, 'Neaktivn kurzor - pozad'); ResMod(@sHEInactiveCaretSelBkGnd, 'Neaktivn kurzor pozad vbru'); ResMod(@sHEInactiveCaretSelText, 'Neaktivn kurzor text vbru'); ResMod(@sHEInactiveCaretText, 'Neaktivn kurzor - text'); ResMod(@sHELinesHighLight, 'Zvraznn dk'); ResMod(@sHESelBkGnd, 'Pozad vbru'); ResMod(@sHESelBkGndFocused, 'Pozad aktivnho vbru'); ResMod(@sHESelText, 'Text vbru'); ResMod(@sHESelTextFocused, 'Text aktivnho vbru'); ResMod(@sHESeparators, 'Oddlovac linky ps'); ResMod(@sHETextText, 'Ps textu - text'); ResMod(@sHETextBkGnd, 'Ps textu - pozad'); ResMod(@sHEVertLines, 'Svisl linky'); // KIcons texts ResMod(@sIconIcons, 'Ikony'); ResMod(@sIconCursors, 'Kurzory'); ResMod(@sIconAllocationError, 'Chyba pi alokovn dat ikony'); ResMod(@sIconBitmapError, 'Neplatn popisovae bitmap ikony'); ResMod(@sIconFormatError, 'Neplatn formt ikony'); ResMod(@sIconResourceError, 'Neplatn zdroj ikony'); ResMod(@sIconIndexError, 'Neplatn index zdroje ikony'); ResMod(@sIconInvalidModule, 'Neplatn modul nebo chyb zdroje ikon'); ResMod(@sIconResizingError, 'Chyba pi zmn velikosti ikony'); ResMod(@sIconAssocResolveError, 'Chyba pi nahrvn asociovan ikony'); // KLog texts ResMod(@sLogError, 'Chyba'); ResMod(@sLogWarning, 'Varovn'); ResMod(@sLogNote, 'Poznmka'); ResMod(@sLogHint, 'Npovda'); ResMod(@sLogInfo, 'Informace'); ResMod(@sLogInputError, 'Chyba zadn'); ResMod(@sLogIOError, 'Chyba IO operace'); // KMessagebox texts ResMod(@sMsgBoxYes, '&Ano'); ResMod(@sMsgBoxNo, '&Ne'); ResMod(@sMsgBoxOK, '&OK'); ResMod(@sMsgBoxCancel, 'Storno'); ResMod(@sMsgBoxClose, 'Za&vt'); ResMod(@sMsgBoxAbort, '&Peruit'); ResMod(@sMsgBoxRetry, '&Znovu'); ResMod(@sMsgBoxIgnore, '&Ignorovat'); ResMod(@sMsgBoxAll, 'V&e'); ResMod(@sMsgBoxNoToAll, 'Ni&c'); ResMod(@sMsgBoxYesToAll, 'Ano pro ve'); ResMod(@sMsgBoxHelp, 'Npovda'); // KPrinterSetup texts ResMod(@sPSPrinterSetup, 'Nasteven tiskrny'); ResMod(@sPSAllPages, 'Vechny strnky (%d)'); ResMod(@sPSErrPrintSetup, 'Chybn nastaven tisku'); ResMod(@sPSErrNoPrinterInstalled, 'Na potai nen instalovna dn tiskrna.'); ResMod(@sPSErrNoDefaultPrinter, 'Nen zvolena vchoz tiskrna, nelze pokraovat. Zvolte vchoz tiskrnu.'); ResMod(@sPSErrPrinterUnknown, 'Neznm chyba v tiskovm rozhran. Prosm restartujte aplikaci a zkuste to znovu.'); ResMod(@sPSErrPrinterConfiguration, 'Konfigurace tiskrny nen podporovna.'); // KControlsDesign texts ResMod(@sInvalidGraphicFormat, 'Neplatn grafick formt.'); // KDBGrids texts ResMod(@sDataSetUnidirectional, 'Nelze pout KDBGrid s jednosmrnm datasetem.'); // KMemoRTF texts ResMod(@sErrMemoLoadFromRTF, 'Chyba pi ten souboru RTF.'); ResMod(@sErrMemoLoadImageFromRTF, 'Chyba pi ten obrzku z RTF souboru.'); ResMod(@sErrMemoSaveToRTF, 'Chyba pi zpisu souboru RTF.'); // KMemoFrame texts ResMod(@sAppError, 'Chyba aplikace'); ResMod(@sAppQuery, 'Dotaz aplikace'); ResMod(@sMemoDefaultFileName, 'dokument'); ResMod(@sQueryFileSave, 'Soubor "%s" byl zmnn. Pejete si jej uloit?'); ResMod(@sErrMemoLoadFromFile, 'Chyba pi ten souboru "%s".'); ResMod(@sErrMemoSaveToFile, 'Chyba pi zpisu souboru "%s".'); ResMod(@sMemoSampleTextBox, 'Vyplte obsah textovho pole. Pole lze umstit kdekoli v dokumentu.'); end; end. tomboy-ng_0.39-1/kcontrols/source/kedits.lrs0000644000175000017500000000632614346341266020763 0ustar dbannondbannonLazarusResources.Add('opendir','BMP',[ 'BM8'#3#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#16#0#0#0#16#0#0#0#1#0#24#0#0#0#0#0#2#3#0 +#0#195#14#0#0#195#14#0#0#0#0#0#0#0#0#0#0#255#255#255#255#255#255#255#255#255 +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 +#255#255#255#255'r'#138#143'p'#136#140'n'#133#138'n'#133#138'n'#133#138'n' +#133#138'n'#133#138'n'#133#138'n'#133#138'o'#135#139'}'#152#157#149#180#186 +#255#255#255#255#255#255#255#255#255')'#173#214')'#173#214')'#173#214')'#173 +#214')'#173#214')'#173#214')'#173#214')'#173#214')'#173#214')'#173#214'8'#160 +#193'X'#145#160'~'#153#158#255#255#255#255#255#255#255#255#255')'#173#214')' +#173#214'`'#234#254#142#240#254#149#241#254#154#241#254#156#242#254#154#241 +#254#149#241#254#142#240#254#131#238#254'7'#160#192'o'#134#138#147#178#184 +#255#255#255#255#255#255')'#173#214')'#173#214'`'#234#254#134#239#254#142#240 +#254#146#240#254#148#241#254#146#240#254#142#240#254#134#239#254'|'#238#254 +')'#173#214'W'#143#158'}'#151#156#255#255#255#255#255#255')'#173#214'h'#235 +#254')'#173#214'`'#234#254#129#238#254#134#239#254#135#239#254#134#239#254 +#129#238#254'{'#237#254'r'#236#254'h'#235#254'7'#160#192'o'#134#138#146#176 +#182#255#255#255')'#173#214'['#233#254')'#173#214'`'#234#254'q'#236#254'u' +#237#254'v'#237#254'u'#237#254'q'#236#254'k'#235#254'd'#234#254'['#233#254')' +#173#214'X'#145#160'}'#152#157#255#255#255')'#173#214'K'#231#254'R'#232#254 +')'#173#214'`'#234#254'`'#234#254'a'#234#254'`'#234#254']'#234#254'Y'#233#254 +'R'#232#254'K'#231#254'K'#231#254':'#164#196'u'#141#146#150#181#187')'#173 +#214'`'#233#253'e'#234#253')'#173#214')'#173#214')'#173#214')'#173#214')'#173 +#214')'#173#214')'#173#214')'#173#214')'#173#214')'#173#214')'#173#214'~'#191 +#208#255#255#255')'#173#214#127#237#253#129#238#254#131#238#253#133#238#253 +#133#238#254#134#238#253#133#238#254#133#238#253#131#238#253')'#173#214'u' +#142#147#162#196#202#255#255#255#255#255#255#255#255#255')'#173#214#164#242 +#253#165#242#254#166#242#253#167#243#254#167#243#254')'#173#214')'#173#214')' +#173#214')'#173#214')'#173#214#164#198#205#255#255#255#255#255#255#255#255 +#255#255#255#255#255#255#255')'#173#214#208#248#254#208#248#254#208#248#254 +')'#173#214#161#195#201#255#255#255#255#255#255#255#255#255#255#255#255#255 +#255#255#255#255#255'x'#145#150't'#140#145'o'#135#139#255#255#255#255#255#255 +')'#173#214')'#173#214')'#173#214#164#199#206#255#255#255#255#255#255#255#255 +#255'}'#151#156#255#255#255#255#255#255#0#162#0#0#163#0#0#158#0'n'#133#138 +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 +#255#255#255#255#255#0#127#0#255#255#255'{'#149#154'z'#148#153'y'#147#152#0 +#167#0#0#162#0'q'#136#141#255#255#255#255#255#255#255#255#255#255#255#255#255 +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#0#139#0#0#149#0#0 +#161#0#0#164#0#255#255#255#0#161#0#255#255#255#255#255#255#255#255#255#255 +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 +#255#255#255#0#0 ]); tomboy-ng_0.39-1/kcontrols/source/kprintpreview.dfm0000644000175000017500000014330114346341266022352 0ustar dbannondbannonobject KCustomPrintPreviewForm: TKCustomPrintPreviewForm Left = 324 Top = 212 Caption = 'Print Preview' ClientHeight = 614 ClientWidth = 812 Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'Tahoma' Font.Style = [] Icon.Data = { 0000010001001010000001002000680400001600000028000000100000002000 000001002000000000000004000000000000000000000000000000000000FFFF FF005F5E5FFF5F5E5FFF5F5E5FFF5F5E5FFF5F5E5FFF5F5E5FFF5F5E5FFF5F5E 5FFF5F5E5FFF5F5E5FFF5F5E5F9F00000000B779329FB779329F00000000FFFF FF005F5E5FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFB779329FB77932FFB77932FFB779329FFFFF FF005F5E5FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFE8D5BEFFC089 4BFFB77932FFB77932FFBB813EFFB77932FFB77932FFB77932FFB779329FFFFF FF005F5E5FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFE8D5BEFFB77932FFBE88 49FFD5B591FFD5B591FFBE8849FFB77932FFB77932FFB779329F00000000FFFF FF005F5E5FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFC0894BFFBE8849FFF0EA E4FFF4F2F0FFF4F2F0FFF0EAE4FFBE8849FFB77932EF0000000000000000FFFF FF005F5E5FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFB77932FFD5B591FFF4F2 F0FFF4F2F0FFF4F2F0FFF4F2F0FFD5B591FFB77932FF0000000000000000FFFF FF005F5E5FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFB77932FFD5B591FFF4F2 F0FFF4F2F0FFF4F2F0FFF4F2F0FFD5B591FFB77932FF0000000000000000FFFF FF005F5E5FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFC0894BFFBE8849FFF0EA E4FFF4F2F0FFF4F2F0FFF0EAE4FFBE8849FFB77932DF0000000000000000FFFF FF005F5E5FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFE8D5BEFFB77932FFBE88 49FFD5B591FFD5B591FFBE8849FFB77932FFB779324F0000000000000000FFFF FF005F5E5FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFE8D5BEFFC089 4BFFB77932FFB77932FFC0894BFFB779324FFFFFFF00FFFFFF00FFFFFF00FFFF FF005F5E5FFF5F5E5FFF5F5E5FFF5F5E5FFF5F5E5FFFC3C2C3FFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFF5F5E5F9FFFFFFF00FFFFFF00FFFFFF00FFFF FF005F5E5F9F5F5E5FFF5F5E5FFF5F5E5FFF5F5E5FFF5F5E5FFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFF5F5E5FFFFFFFFF00FFFFFF00FFFFFF00FFFF FF00000000005F5E5F9F5F5E5FFF5F5E5FFF5F5E5FFF5F5E5FFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFF5F5E5FFFFFFFFF00FFFFFF00FFFFFF00FFFF FF0000000000000000005F5E5F9F5F5E5FFF5F5E5FFF5F5E5FFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFF5F5E5FFF000000000000000000000000FFFF FF000000000000000000000000005F5E5F9F5F5E5FFF5F5E5FFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFF5F5E5FFF000000000000000000000000FFFF FF00000000000000000000000000000000005F5E5F9F5F5E5FFF5F5E5FFF5F5E 5FFF5F5E5FFF5F5E5FFF5F5E5FFF5F5E5FFF0000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000000000000000000000} KeyPreview = True OldCreateOrder = False Position = poScreenCenter OnCreate = FormCreate OnKeyDown = FormKeyDown OnShow = FormShow PixelsPerInch = 96 TextHeight = 13 object ToBMain: TToolBar Left = 0 Top = 0 Width = 812 Height = 30 AutoSize = True ButtonHeight = 30 ButtonWidth = 31 Caption = 'TBMain' Images = ILMain TabOrder = 0 Wrapable = False object TBPageFirst: TToolButton Left = 0 Top = 0 Action = ACPageFirst Grouped = True ParentShowHint = False ShowHint = True end object TBPagePrevious: TToolButton Left = 31 Top = 0 Action = ACPagePrevious Grouped = True ParentShowHint = False ShowHint = True end object TBPageNext: TToolButton Left = 62 Top = 0 Action = ACPageNext Grouped = True ParentShowHint = False ShowHint = True end object TBPageLast: TToolButton Left = 93 Top = 0 Action = ACPageLast Grouped = True ParentShowHint = False ShowHint = True end object ToolButton3: TToolButton Left = 124 Top = 0 Width = 8 Caption = 'ToolButton3' ImageIndex = 2 Style = tbsSeparator end object PNPage: TPanel Left = 132 Top = 0 Width = 71 Height = 30 BevelOuter = bvNone ParentBackground = False TabOrder = 0 object EDPage: TEdit Left = 7 Top = 4 Width = 43 Height = 21 TabOrder = 0 Text = '1' OnExit = EDPageExit OnKeyDown = EDPageKeyDown end object UDPage: TUpDown Left = 50 Top = 4 Width = 15 Height = 21 Associate = EDPage Min = 1 Position = 1 TabOrder = 1 OnClick = UDPageClick end end object ToolButton6: TToolButton Left = 203 Top = 0 Width = 8 Caption = 'ToolButton6' ImageIndex = 3 Style = tbsSeparator end object PNScale: TPanel Left = 211 Top = 0 Width = 112 Height = 30 BevelOuter = bvNone ParentBackground = False ParentColor = True TabOrder = 1 object CoBScale: TComboBox Left = 9 Top = 4 Width = 95 Height = 21 AutoComplete = False DropDownCount = 16 TabOrder = 0 OnExit = CoBScaleExit OnSelect = CoBScaleExit Items.Strings = ( '25 %' '50 %' '75 %' '100 %' '125 %' '150 %' '200 %' '500 %' 'whole page' 'page width') end end object ToolButton1: TToolButton Left = 323 Top = 0 Width = 8 Caption = 'ToolButton1' ImageIndex = 4 Style = tbsSeparator end object TBPrint: TToolButton Left = 331 Top = 0 Action = ACPrint ParentShowHint = False ShowHint = True end object ToolButton4: TToolButton Left = 362 Top = 0 Width = 8 Caption = 'ToolButton4' ImageIndex = 5 Style = tbsSeparator end object TBClose: TToolButton Left = 370 Top = 0 Action = ACClose ParentShowHint = False ShowHint = True end end object ILMain: TImageList ColorDepth = cd32Bit DrawingStyle = dsTransparent Height = 24 Width = 24 Left = 16 Top = 54 Bitmap = { 494C010106002000340018001800FFFFFFFF2110FFFFFFFFFFFFFFFF424D3600 0000000000003600000028000000600000003000000001002000000000000048 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000E0E0E0F2424242C393939543C3B3B5A3B3B3B593B3B3B593B3B 3B593B3B3B593B3B3B593B3B3B593B3B3B593C3B3B5A3737374F1D1D1D220808 0809000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000303030404040405000000000000 0000000000000000000033333243FEEFC3FFFEE5BBFFFEE5BBFFFEE5BCFFFEE6 BDFFFEE7BEFFFEE9C2FFFEE9C2FFFEEAC4FFFEEEC9FFFCE0BEFE0B0B0B0C0000 0000000000000000000004040405030303040000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000161616191F1F1F25393939515E5E 5EB35E5E5EB6646566B979726CD1FED3A3FFFECFA2FFFED0A3FFFED0A6FFFED3 A8FFFED4ADFFFED7B0FFFED8B2FFFED9B5FFFEDEBBFFEECDB2FB62615FC25C5D 5DB45E5E5EB43B3B3B571E1E1E24161616190000000000000000000000000000 0000000000000000000055565780555657800000000000000000000000000000 0000000000000000000000000000000000005556578055565780000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000606060733333346949494E0D2D2 D2FFD6D6D6FFBABDBFFF6A5F54FFEEBE90FFE9BB90FFE9BC93FFE9BD95FFE9C0 99FFE9C29EFFE9C4A1FFE9C5A4FFE9C7A9FFECCDAFFFD4B89EFF676563FFD4D5 D6FFD1D1D1FF9F9F9FE939393952040404050000000000000000000000000000 000000000000555657804343C0FF4343C0FF5556578000000000000000000000 0000000000000000000000000000555657804343C0FF4343C0FF555657800000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000004D4D4D82D3D3D3FFD3D3 D3FFD4D4D4FFBDBFC1FF524840FFB9936FFFB59270FFB59272FFB59474FFB596 78FFB59779FFB5977BFFB6997DFFB69984FFB99E88FFA28A74FF555453FFD7D3 D6FFD1CFD0FFCFCFCFFF4D4D4D82000000000000000000000000000000000000 0000555657804343C0FF7272DAFF7171DAFF4343C0FF55565780000000000000 00000000000000000000555657804343C0FF7171DAFF7272DAFF4343C0FF5556 5780000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000057575780CACACAFFD7D7 D7FFD5D5D5FFCCCCCDFF95908FFFB6A8A2FFB5A7A1FFB5A7A1FFB5A7A1FFB4A7 A0FFB4A7A1FFB4A7A1FFB4A6A0FFB4A6A1FFB4A7A1FFAB9E99FF9D9799FF9BC0 B0FFADC5BBFFCAC6C8FF57575780000000000000000000000000000000000000 00004343C0FF7272DAFF9797FEFF8D8DFEFF6767DAFF4343C0FF555657800000 000000000000555657804343C0FF6767DAFF8D8DFEFF9797FEFF7272DAFF4343 C0FF000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000055555580CCCCCCFFE0DF DFFFEAE9EAFFE2E7E5FFE9EFEDFFE3EBEAFFE3EBEAFFE3EBEAFFE3EBE9FFE3EB E9FFE3EBE9FFE3EBE9FFE3EAE9FFE3EAE9FFE2EAE8FFE3EBE9FFEEEFEEFFCDDF D8FFC7D3CEFFCAC8C9FF55555580000000000000000000000000000000000000 00004343C0FF7171DAFF8D8DFEFF7777FEFF7D7DFEFF6464DAFF4343C0FF5556 5780555657804343C0FF6464DAFF7D7DFEFF7777FEFF8D8DFEFF7171DAFF4343 C0FF000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000005454547FD5D1D3FFE6ED EAFF6ABE9CFF2DA372FF37A878FF37A877FF37A777FF37A777FF37A677FF37A7 76FF37A776FF37A676FF38A677FF38A677FF38A677FF38A677FF2DA16FFF7AC3 A5FFECEEEDFFD0CDCEFF5454547F000000000000000000000000000000000000 0000000000004343C0FF6767DAFF7D7DFEFF7272FEFF7878FEFF5E5EDAFF4343 C0FF4343C0FF5E5EDAFF7878FEFF7272FEFF7D7DFEFF6767DAFF4343C0FF0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000004F4F4F74E4DDE0FFBFE1 D2FF28B17CFF44C79BFF3DBF91FF3EBF91FF3EBF91FF3EBF91FF3EBF91FF3EBF 92FF3EBF92FF3EBF92FF3EBF92FF3EBF92FF3EBF92FF3DBE91FF44C89BFF29AD 7AFFC4E1D3FFE1DADDFF50505076000000000000000000000000000000000000 000000000000000000004343C0FF6464DAFF7878FEFF6D6DFEFF6B6BFEFF6F6F FEFF6F6FFEFF6B6BFEFF6D6DFEFF7878FEFF6464DAFF4343C0FF000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000004E4E4E71EEE7EAFFBFE4 D6FF28B382FF27B180FF18AA73FF1AAC76FF1AAC76FF1AAC76FF1AAC76FF1AAC 76FF1AAC76FF1AAC76FF1AAC76FF1AAC76FF1AAC76FF18AA73FF27B180FF29AE 7CFFC8E5D9FFEDE6EAFF50505075000000000000000000000000000000000000 00000000000000000000000000004343C0FF5E5EDAFF6B6BFEFF5F5FFEFF5C5C FEFF5C5CFEFF5F5FFEFF6B6BFEFF5E5EDAFF4343C0FF00000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000004E4E4E70F8F1F4FFBBE6 D6FF30C190FF35CA9BFF21C591FF23C794FF23C794FF23C794FF23C794FF23C7 94FF23C794FF23C794FF23C794FF23C794FF23C794FF20C491FF36CC9EFF35BE 8FFFC6E6D8FFFBF3F6FF52525276000000000000000000000000000000000000 0000000000000000000000000000000000004343C0FF6F6FFEFF5C5CFEFF5555 FEFF5555FEFF5C5CFEFF6F6FFEFF4343C0FF0000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000004D4D4D6DFAF3F5FFB0E5 D3FF37CA9CFF71F3CEFF6BF0CBFF6BF1CBFF6BF0CBFF6BF0CBFF6BF1CBFF6BF1 CBFF6BF1CBFF6BF0CBFF6BF0CBFF6BF0CBFF6BF1CBFF6CF0CBFF73F3CFFF39C7 98FFC4E6D9FFFEF5F9FF52525276000000000000000000000000000000000000 0000000000000000000000000000555657804343C0FFB4B4FEFFAAAAFEFFA7A7 FEFFA7A7FEFFAAAAFEFFB4B4FEFF4343C0FF5556578000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000049494967FAF3F5FFACE6 D3FF38CEA0FF67EEC7FF4DD6ACFF4DD4ABFF4DD5ABFF4DD5ABFF4DD4ABFF4DD4 ABFF4DD4ABFF4DD5ABFF4DD5ACFF4DD5ABFF4ED4ABFF4AD6ACFF5EEBC2FF39CA 9BFFC3E9DBFFFEF5F9FF4F4F4F71000000000000000000000000000000000000 00000000000000000000555657804343C0FF7979DAFFBEBEFEFFB8B8FEFFB7B7 FEFFB7B7FEFFB8B8FEFFBEBEFEFF7979DAFF4343C0FF55565780000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000004242425AF3EAEDFEBAEB DBFF2ED1A0FF44D4A5FFA8B489FFB7B48BFFB4B58BFFB4B58BFFB4B58BFFB4B5 8BFFB4B58BFFB4B58BFFB4B58CFFB4B58BFFB7B48BFFA7B68BFF2FC998FF17C1 8CFFC8EEE0FFFAF0F3FF48484865000000000000000000000000000000000000 000000000000555657804343C0FF8282DAFFCECEFEFFCACAFEFFCACAFEFFCBCB FEFFCBCBFEFFCACAFEFFCACAFEFFCECEFEFF8282DAFF4343C0FF555657800000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00000000000000000000000000000000000000000000060606076B68699D92BB ADF337AE8AF153A78AEFE8C49DFEFECCA4FFF9CBA3FFF9CBA3FFF9CBA3FFF9CB A3FFF9CBA3FFF9CBA3FFF9CBA3FFF9CBA3FFFDCCA4FFECC69EFE58A98BF233A9 85F191B0A6EB716E70A50F0F0F10000000000000000000000000000000000000 0000555657804343C0FF8686DAFFDBDBFEFFD8D8FEFFDADAFEFF8484DAFF4343 C0FF4343C0FF8484DAFFDADAFEFFD8D8FEFFDBDBFEFF8686DAFF4343C0FF5556 5780000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000001818 181B0F0F0F100F0F0F10CAB899EDFBD8B3FFF7D8B3FFF8D8B3FFF7D8B2FFF8D8 B3FFF8D8B3FFF7D8B2FFF8D8B2FFF8D8B3FFFAD9B3FFD4BCA0F01E1E1E230F0F 0F100C0C0C0D0000000000000000000000000000000000000000000000000000 00004343C0FF8B8BDAFFE8E8FEFFE5E5FEFFE6E6FEFF8989DAFF4343C0FF0000 0000000000004343C0FF8989DAFFE6E6FEFFE5E5FEFFE8E8FEFF8B8BDAFF4343 C0FF000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000E0E0E0FDCBB9DEFF8D9B6FFF9D9B5FFF8D8B5FFF9D9B6FFF8DA B6FFF8DAB6FFF8D9B6FFF8D9B6FFF9D9B6FFFAD9B5FFD7BC9FEF0C0C0C0D0000 0000000000000000000000000000000000000000000000000000000000000000 00004343C0FF8E8EDAFFF2F2FEFFF1F1FEFF8D8DDAFF4343C0FF000000000000 000000000000000000004343C0FF8D8DDAFFF1F1FEFFF2F2FEFF8E8EDAFF4343 C0FF000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000F0F0F10D6B99CEFF9DCBAFFF9DBB9FFF9DBB9FFF9DCB9FFF8DB B9FFF9DCB9FFF9DBBAFFF8DAB9FFF9DBB9FFF9DCB9FFD9BB9FEF0F0F0F100000 0000000000000000000000000000000000000000000000000000000000000000 0000000000004343C0FF9090DAFF9090DAFF4343C0FF00000000000000000000 00000000000000000000000000004343C0FF9090DAFF9090DAFF4343C0FF0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000F0F0F10D4B99CEFF9DEBEFFF9DDBDFFF9DCBCFFF9DCBCFFF9DD BDFFF9DDBDFFF9DCBCFFF9DDBCFFF9DDBDFFF9DDBEFFD6BA9FEF0F0F0F100000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000004343C0FF4343C0FF0000000000000000000000000000 0000000000000000000000000000000000004343C0FF4343C0FF000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000F0F0F10D3B79DEFFAE0C2FFF9DEC0FFF9DEC0FFFADEC0FFFADE C0FFF9DEC1FFFADEC0FFF9DEC0FFF9DEC0FFFADFC1FFD5B99FEF0F0F0F100000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000F0F0F10D3B89DEFFCE4C7FFFAE2C6FFFBE2C5FFFAE2C5FFFAE2 C6FFFAE2C6FFFAE2C6FFFBE2C5FFFBE2C5FFFBE3C7FFD4B89FEF0F0F0F100000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000F0F0F10CBAD93EBE8C6A5FBE8C5A5FBE8C5A4FBE8C6A4FBE8C5 A5FBE8C5A5FBE8C5A5FBE8C5A4FBE8C5A4FBE8C6A5FBCBAD94EB0F0F0F100000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000555657805556578055565780555657800000000000000000000000000000 0000000000000000000000000000000000000000000055565780555657800000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000005556578055565780555657800000 0000000000000000000000000000000000000000000000000000000000000000 0000000000005556578055565780555657800000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000005556578055565780000000000000000000000000000000000000 0000000000000000000000000000000000005556578055565780555657805556 5780000000000000000000000000000000000000000000000000000000000000 000068AD93FF68AD93FF68AD93FF68AD93FF0000000000000000000000000000 0000000000000000000000000000555657805556578068AD93FF68AD93FF5556 5780000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00000000000000000000555657805556578068AD93FF68AD93FF68AD93FF5556 5780000000000000000000000000000000000000000000000000000000000000 00005556578068AD93FF68AD93FF68AD93FF5556578055565780000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00005556578068AD93FF68AD93FF555657805556578000000000000000000000 00000000000000000000000000000000000068AD93FF68AD93FF68AD93FF68AD 93FF000000000000000000000000000000000000000000000000000000000000 000068AD93FFBEF1E4FFBEF1E4FF68AD93FF0000000000000000000000000000 000000000000555657805556578068AD93FF68AD93FF89C9B3FF8FC9B5FF68AD 93FF000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000555657805556578068AD93FF68AD93FF83C7B1FFA9EDDCFF8DC9B4FF68AD 93FF000000000000000000000000000000000000000000000000000000000000 000068AD93FF8DC9B4FFA9EDDCFF83C7B1FF68AD93FF68AD93FF555657805556 5780000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000068AD93FF8FC9B5FF89C9B3FF68AD93FF68AD93FF55565780555657800000 00000000000000000000000000000000000068AD93FFBEF1E4FFBEF1E4FF68AD 93FF000000000000000000000000000000000000000000000000000000000000 000068AD93FFA9EDDCFFA9EDDCFF68AD93FF0000000000000000000000005556 57805556578068AD93FF68AD93FF80C7AFFF90E8D2FF92E9D3FFA7EDDBFF68AD 93FF000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000555657805556 578068AD93FF68AD93FF80C7AFFF8EE8D1FF83E6CDFF8AE7D0FFA3ECDAFF68AD 93FF000000000000000000000000000000000000000000000000000000000000 000068AD93FFA3ECDAFF8AE7D0FF83E6CDFF8EE8D1FF80C7AFFF68AD93FF68AD 93FF555657805556578000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000068AD93FFA7EDDBFF92E9D3FF90E8D2FF80C7AFFF68AD93FF68AD93FF5556 57805556578000000000000000000000000068AD93FFA9EDDCFFA9EDDCFF68AD 93FF000000000000000000000000000000000000000000000000000000000000 000068AD93FF9FEBD8FF9FEBD8FF68AD93FF00000000555657805556578068AD 93FF68AD93FF80C7AFFF8DE8D1FF7DE5CBFF73E3C7FF7BE5CAFF96E9D4FF68AD 93FF000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000555657805556578068AD93FF68AD 93FF80C7AFFF8DE8D1FF7DE5CBFF72E3C7FF6CE2C4FF76E4C8FF94E9D3FF68AD 93FF000000000000000000000000000000000000000000000000000000000000 000068AD93FF94E9D3FF76E4C8FF6CE2C4FF72E3C7FF7DE5CBFF8DE8D1FF80C7 AFFF68AD93FF68AD93FF55565780555657800000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000068AD93FF96E9D4FF7BE5CAFF73E3C7FF7DE5CBFF8DE8D1FF80C7AFFF68AD 93FF68AD93FF55565780555657800000000068AD93FF9FEBD8FF9FEBD8FF68AD 93FF000000000000000000000000000000000000000000000000000000000000 000068AD93FF9FEBD8FF9FEBD8FF68AD93FF5556578068AD93FF68AD93FF80C7 AFFF8DE8D1FF7DE5CBFF72E3C7FF6BE1C4FF66E0C2FF73E3C7FF90E8D2FF68AD 93FF000000000000000000000000000000000000000000000000000000000000 00000000000000000000555657805556578068AD93FF68AD93FF80C7AFFF8DE8 D1FF7DE5CBFF72E3C7FF6BE1C4FF66E0C2FF65E0C1FF72E3C7FF90E8D2FF68AD 93FF000000000000000000000000000000000000000000000000000000000000 000068AD93FF90E8D2FF72E3C7FF65E0C1FF66E0C2FF6BE1C4FF72E3C7FF7DE5 CBFF8DE8D1FF80C7AFFF68AD93FF68AD93FF5556578055565780000000000000 0000000000000000000000000000000000000000000000000000000000000000 000068AD93FF90E8D2FF73E3C7FF66E0C2FF6BE1C4FF72E3C7FF7DE5CBFF8DE8 D1FF80C7AFFF68AD93FF68AD93FF5556578068AD93FF9FEBD8FF9FEBD8FF68AD 93FF000000000000000000000000000000000000000000000000000000000000 000068AD93FF9FEBD8FF9FEBD8FF68AD93FF68AD93FF80C7AFFF8DE8D1FF7DE5 CBFF72E3C7FF6BE1C4FF66E0C2FF65E0C1FF64E0C1FF72E3C7FF90E8D2FF68AD 93FF000000000000000000000000000000000000000000000000000000000000 0000000000005556578068AD93FF68AD93FF80C7AFFF8DE8D1FF7DE5CBFF72E3 C7FF6BE1C4FF66E0C2FF65E0C1FF64E0C1FF64E0C1FF72E3C7FF90E8D2FF68AD 93FF000000000000000000000000000000000000000000000000000000000000 000068AD93FF90E8D2FF72E3C7FF64E0C1FF64E0C1FF65E0C1FF66E0C2FF6BE1 C4FF72E3C7FF7DE5CBFF8DE8D1FF80C7AFFF68AD93FF68AD93FF555657800000 0000000000000000000000000000000000000000000000000000000000000000 000068AD93FF90E8D2FF72E3C7FF64E0C1FF65E0C1FF66E0C2FF6BE1C4FF72E3 C7FF7DE5CBFF8DE8D1FF80C7AFFF68AD93FF68AD93FF9FEBD8FF9FEBD8FF68AD 93FF000000000000000000000000000000000000000000000000000000000000 000068AD93FF9FEBD8FF9FEBD8FF68AD93FF92E9D2FF7DE5CBFF72E3C7FF6BE1 C4FF66E0C2FF65E0C1FF64E0C1FF64E0C1FF64E0C1FF72E3C7FF90E8D2FF68AD 93FF000000000000000000000000000000000000000000000000000000000000 00005556578068AD93FF86C8B1FF92E9D2FF7DE5CBFF72E3C7FF6BE1C4FF66E0 C2FF65E0C1FF64E0C1FF64E0C1FF64E0C1FF64E0C1FF72E3C7FF90E8D2FF68AD 93FF000000000000000000000000000000000000000000000000000000000000 000068AD93FF90E8D2FF72E3C7FF64E0C1FF64E0C1FF64E0C1FF64E0C1FF65E0 C1FF66E0C2FF6BE1C4FF72E3C7FF7DE5CBFF92E9D2FF86C8B1FF68AD93FF5556 5780000000000000000000000000000000000000000000000000000000000000 000068AD93FF90E8D2FF72E3C7FF64E0C1FF64E0C1FF64E0C1FF65E0C1FF66E0 C2FF6BE1C4FF72E3C7FF7DE5CBFF92E9D2FF68AD93FF9FEBD8FF9FEBD8FF68AD 93FF000000000000000000000000000000000000000000000000000000000000 000068AD93FF9FEBD8FF9FEBD8FF68AD93FF79E4CAFF6CE2C4FF66E0C2FF65E0 C1FF64E0C1FF64E0C1FF64E0C1FF64E0C1FF64E0C1FF72E3C7FF90E8D2FF68AD 93FF000000000000000000000000000000000000000000000000000000000000 000068AD93FF8BC9B4FF95E9D4FF79E4CAFF6CE2C4FF66E0C2FF65E0C1FF64E0 C1FF64E0C1FF64E0C1FF64E0C1FF64E0C1FF64E0C1FF72E3C7FF90E8D2FF68AD 93FF000000000000000000000000000000000000000000000000000000000000 000068AD93FF90E8D2FF72E3C7FF64E0C1FF64E0C1FF64E0C1FF64E0C1FF64E0 C1FF64E0C1FF65E0C1FF66E0C2FF6CE2C4FF79E4CAFF95E9D4FF8BC9B4FF68AD 93FF000000000000000000000000000000000000000000000000000000000000 000068AD93FF90E8D2FF72E3C7FF64E0C1FF64E0C1FF64E0C1FF64E0C1FF64E0 C1FF65E0C1FF66E0C2FF6CE2C4FF79E4CAFF68AD93FF9FEBD8FF9FEBD8FF68AD 93FF000000000000000000000000000000000000000000000000000000000000 000068AD93FFD5F0E9FFD5F0E9FF68AD93FFC5EAE1FFBFE8DEFFBDE7DDFFBCE7 DCFFBCE7DCFFBCE7DCFFBCE7DCFFBCE7DCFFBCE7DCFFC2E9DFFFCEEDE5FF68AD 93FF000000000000000000000000000000000000000000000000000000000000 000068AD93FF9BCAB9FFD0EEE7FFC5EAE1FFBFE8DEFFBDE7DDFFBCE7DCFFBCE7 DCFFBCE7DCFFBCE7DCFFBCE7DCFFBCE7DCFFBCE7DCFFC2E9DFFFCEEDE5FF68AD 93FF000000000000000000000000000000000000000000000000000000000000 000068AD93FFCEEDE5FFC2E9DFFFBCE7DCFFBCE7DCFFBCE7DCFFBCE7DCFFBCE7 DCFFBCE7DCFFBCE7DCFFBDE7DDFFBFE8DEFFC5EAE1FFD0EEE7FF9BCAB9FF68AD 93FF000000000000000000000000000000000000000000000000000000000000 000068AD93FFCEEDE5FFC2E9DFFFBCE7DCFFBCE7DCFFBCE7DCFFBCE7DCFFBCE7 DCFFBCE7DCFFBDE7DDFFBFE8DEFFC5EAE1FF68AD93FFD5F0E9FFD5F0E9FF68AD 93FF000000000000000000000000000000000000000000000000000000000000 000068AD93FFDBF1ECFFDBF1ECFF68AD93FFD7F0E9FFD0EDE6FFCCECE4FFCAEB E2FFC8EAE1FFC7EAE1FFC7EAE1FFC7EAE1FFC7EAE1FFCCECE4FFD6F0E9FF68AD 93FF000000000000000000000000000000000000000000000000000000000000 00000000000068AD93FF9BCAB9FFD7F0E9FFD0EDE6FFCCECE4FFCAEBE2FFC8EA E1FFC7EAE1FFC7EAE1FFC7EAE1FFC7EAE1FFC7EAE1FFCCECE4FFD6F0E9FF68AD 93FF000000000000000000000000000000000000000000000000000000000000 000068AD93FFD6F0E9FFCCECE4FFC7EAE1FFC7EAE1FFC7EAE1FFC7EAE1FFC7EA E1FFC8EAE1FFCAEBE2FFCCECE4FFD0EDE6FFD7F0E9FF9BCAB9FF68AD93FF0000 0000000000000000000000000000000000000000000000000000000000000000 000068AD93FFD6F0E9FFCCECE4FFC7EAE1FFC7EAE1FFC7EAE1FFC7EAE1FFC8EA E1FFCAEBE2FFCCECE4FFD0EDE6FFD7F0E9FF68AD93FFDBF1ECFFDBF1ECFF68AD 93FF000000000000000000000000000000000000000000000000000000000000 000068AD93FFE2F4EFFFE2F4EFFF68AD93FF68AD93FF9BCAB9FFDDF2ECFFD9F1 EAFFD6F0E8FFD4EFE7FFD3EEE6FFD2EEE6FFD2EEE6FFD6F0E8FFDEF2EDFF68AD 93FF000000000000000000000000000000000000000000000000000000000000 0000000000000000000068AD93FF68AD93FF9BCAB9FFDDF2ECFFD9F1EAFFD6F0 E8FFD4EFE7FFD3EEE6FFD2EEE6FFD2EEE6FFD2EEE6FFD6F0E8FFDEF2EDFF68AD 93FF000000000000000000000000000000000000000000000000000000000000 000068AD93FFDEF2EDFFD6F0E8FFD2EEE6FFD2EEE6FFD2EEE6FFD3EEE6FFD4EF E7FFD6F0E8FFD9F1EAFFDDF2ECFF9BCAB9FF68AD93FF68AD93FF000000000000 0000000000000000000000000000000000000000000000000000000000000000 000068AD93FFDEF2EDFFD6F0E8FFD2EEE6FFD2EEE6FFD3EEE6FFD4EFE7FFD6F0 E8FFD9F1EAFFDDF2ECFF9BCAB9FF68AD93FF68AD93FFE2F4EFFFE2F4EFFF68AD 93FF000000000000000000000000000000000000000000000000000000000000 000068AD93FFE9F6F3FFE9F6F3FF68AD93FF0000000068AD93FF68AD93FF9ECB BBFFE5F4F1FFE2F3EFFFE0F2EEFFDFF2EDFFDEF1ECFFE0F2EEFFE6F5F1FF68AD 93FF000000000000000000000000000000000000000000000000000000000000 00000000000000000000000000000000000068AD93FF68AD93FF9ECBBBFFE5F4 F1FFE2F3EFFFE0F2EEFFDFF2EDFFDEF1ECFFDDF1ECFFE0F2EEFFE6F5F1FF68AD 93FF000000000000000000000000000000000000000000000000000000000000 000068AD93FFE6F5F1FFE0F2EEFFDDF1ECFFDEF1ECFFDFF2EDFFE0F2EEFFE2F3 EFFFE5F4F1FF9ECBBBFF68AD93FF68AD93FF0000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000068AD93FFE6F5F1FFE0F2EEFFDEF1ECFFDFF2EDFFE0F2EEFFE2F3EFFFE5F4 F1FF9ECBBBFF68AD93FF68AD93FF0000000068AD93FFE9F6F3FFE9F6F3FF68AD 93FF000000000000000000000000000000000000000000000000000000000000 000068AD93FFF0F8F6FFF0F8F6FF68AD93FF00000000000000000000000068AD 93FF68AD93FFA1CCBCFFEDF7F5FFEBF6F4FFE9F6F3FFEBF6F4FFEEF8F6FF68AD 93FF000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000000000000068AD93FF68AD 93FFA1CCBCFFEDF7F5FFEBF6F4FFE9F6F3FFE8F5F3FFEAF6F3FFEEF8F6FF68AD 93FF000000000000000000000000000000000000000000000000000000000000 000068AD93FFEEF8F6FFEAF6F3FFE8F5F3FFE9F6F3FFEBF6F4FFEDF7F5FFA1CC BCFF68AD93FF68AD93FF00000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000068AD93FFEEF8F6FFEBF6F4FFE9F6F3FFEBF6F4FFEDF7F5FFA1CCBCFF68AD 93FF68AD93FF00000000000000000000000068AD93FFF0F8F6FFF0F8F6FF68AD 93FF000000000000000000000000000000000000000000000000000000000000 000068AD93FFF6FBFAFFF6FBFAFF68AD93FF0000000000000000000000000000 00000000000068AD93FF68AD93FFA3CDBDFFF4FAF9FFF4FAF9FFF6FBFAFF68AD 93FF000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000068AD93FF68AD93FFA3CDBDFFF4FAF9FFF3FAF8FFF3FAF9FFF6FBFAFF68AD 93FF000000000000000000000000000000000000000000000000000000000000 000068AD93FFF6FBFAFFF3FAF9FFF3FAF8FFF4FAF9FFA3CDBDFF68AD93FF68AD 93FF000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000068AD93FFF6FBFAFFF4FAF9FFF4FAF9FFA3CDBDFF68AD93FF68AD93FF0000 00000000000000000000000000000000000068AD93FFF6FBFAFFF6FBFAFF68AD 93FF000000000000000000000000000000000000000000000000000000000000 000068AD93FFFBFDFDFFFBFDFDFF68AD93FF0000000000000000000000000000 000000000000000000000000000068AD93FF68AD93FFA6CEBFFFA6CEBFFF68AD 93FF000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000068AD93FF68AD93FFA6CEBEFFFBFDFCFFA6CEBFFF68AD 93FF000000000000000000000000000000000000000000000000000000000000 000068AD93FFA6CEBFFFFBFDFCFFA6CEBEFF68AD93FF68AD93FF000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000068AD93FFA6CEBFFFA6CEBFFF68AD93FF68AD93FF00000000000000000000 00000000000000000000000000000000000068AD93FFFBFDFDFFFBFDFDFF68AD 93FF000000000000000000000000000000000000000000000000000000000000 000068AD93FF68AD93FF68AD93FF68AD93FF0000000000000000000000000000 0000000000000000000000000000000000000000000068AD93FF68AD93FF0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00000000000000000000000000000000000068AD93FF68AD93FF68AD93FF0000 0000000000000000000000000000000000000000000000000000000000000000 00000000000068AD93FF68AD93FF68AD93FF0000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00000000000068AD93FF68AD93FF000000000000000000000000000000000000 00000000000000000000000000000000000068AD93FF68AD93FF68AD93FF68AD 93FF000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000424D3E000000000000003E000000 2800000060000000300000000100010000000000400200000000000000000000 000000000000000000000000FFFFFF0000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000} end object ALMain: TActionList Images = ILMain Left = 56 Top = 54 object ACPageFirst: TAction Hint = 'First page' ImageIndex = 0 OnExecute = ACPageFirstExecute OnUpdate = ACPageFirstUpdate end object ACPagePrevious: TAction Caption = 'Previous page' Hint = 'Previous page' ImageIndex = 1 OnExecute = ACPagePreviousExecute OnUpdate = ACPageFirstUpdate end object ACPageNext: TAction Caption = 'Next page' Hint = 'Next page' ImageIndex = 2 OnExecute = ACPageNextExecute OnUpdate = ACPageNextUpdate end object ACPageLast: TAction Caption = 'Last page' Hint = 'Last page' ImageIndex = 3 OnExecute = ACPageLastExecute OnUpdate = ACPageNextUpdate end object ACPrint: TAction Caption = 'Print' Hint = 'Print' ImageIndex = 4 OnExecute = ACPrintExecute OnUpdate = ACPrintUpdate end object ACClose: TAction Caption = 'Close' Hint = 'Close preview' ImageIndex = 5 OnExecute = ACCloseExecute OnUpdate = ACCloseUpdate end end end tomboy-ng_0.39-1/kcontrols/source/kcontrols.res0000644000175000017500000000162014346341266021477 0ustar dbannondbannon 4 ( @?wg P KPREVIEW_CURSOR_HAND_FREE0 @44 ( @??`P KPREVIEW_CURSOR_HAND_GRIP0 @4tomboy-ng_0.39-1/kcontrols/source/khexeditor.pas0000644000175000017500000051752114346341266021635 0ustar dbannondbannon{ @abstract(This file is part of the KControls component suite for Delphi and Lazarus.) @author(Tomas Krysl) Copyright (c) 2020 Tomas Krysl

License:
This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html. } unit khexeditor; // lowercase name because of Lazarus/Linux {$include kcontrols.inc} {$WEAKPACKAGEUNIT ON} interface uses {$IFDEF FPC} LCLType, LCLIntf, LMessages, LCLProc, LResources, {$ELSE} Windows, Messages, {$ENDIF} SysUtils, Classes, Graphics, Controls, ExtCtrls, StdCtrls, Forms, KFunctions, KGraphics, KControls, KEditCommon; type { Declares possible values for the @link(TKCustomHexEditor.AddressMode) property } TKHexEditorAddressMode = ( { Address will be shown in decimal format } eamDec, { Address will be shown in hexadecimal format } eamHex ); { Declares possible values e.g. for the @link(TKCustomHexEditor.EditArea) property } TKHexEditorArea = ( { No area is selected, e.g. when clicked outside of visible text } eaNone, { Address area selected/used } eaAddress, { Digits area selected/used } eaDigits, { Text area selected/used } eaText ); { @abstract(Contains dimensions of all areas in characters)
    Members:
  • Address - address area width
  • AddressOut - address area leadout
  • Digits - digits area width
  • DigitsIn - digits area leadin
  • DigitsOut - digits area leadout
  • Text - text area width
  • TextIn - text area leadin
  • TotalHorz - total width of all defined areas
  • TotalVert - total number of lines
} TKHexEditorAreaDimensions = record Address, AddressOut, Digits, DigitsIn, DigitsOut, Text, TextIn, TotalHorz: Integer; TotalVert: Int64; end; { Declared for backward compatibility only. } TKHexEditorColorIndex = TKColorIndex; { Declared for backward compatibility only. } TKHexEditorColorSpec = TKColorSpec; { Declared for backward compatibility only. } TKHexEditorDisabledDrawStyle = TKEditDisabledDrawStyle; { Declares drawing styles - possible values for the @link(TKCustomHexEditor.DrawStyles) property } TKHexEditorDrawStyle = ( { Show adress area } edAddress, { Show digits area } edDigits, { Show text area } edText, { Show horizontal leading lines } edHorzLines, { Show caret position when editor is inactive (has no input focus) } edInactiveCaret, { Show vertical area separating lines } edSeparators, { Show vertical leading lines (digits area only) } edVertLines, { @link(TKHexEditorColors.BkGnd) is used for all areas if included } edSingleBkGnd ); { Drawing styles can be arbitrary combined } TKHexEditorDrawStyles = set of TKHexEditorDrawStyle; { @abstract(Declares the paint data structure for the @link(TKCustomHexEditor.PaintLines) method)
    Members:
  • Canvas - destination canvas
  • PainRect - bounding rectangle for painted lines (no clipping necessary, this is performed by window/page client area)
  • TopLine - first line painted (vertical scroll offset)
  • BottomLine - last line painted
  • LeftChar - first character painted (horizontal scroll offset)
  • CharWidth - character width in pixels for supplied canvas
  • CharHeight - character height in pixels for supplied canvas
  • CharSpacing - inter-character spacing in pixels for supplied canvas
  • Printing - determines whether normal painting or page printing should be performed
  • PaintAll - when Printing is True, specifies whether all data or selection only should be painted, this applies only to the first and/or last painted line
  • PaintColors - when Printing is True, specifies whether to paint with colors or grayscale
  • PaintSelection - when Printing is True, specifies whether to indicate the selection
} TKHexEditorPaintData = record Canvas: TCanvas; PaintRect: TRect; TopLine, BottomLine: Int64; LeftChar, CharWidth, CharHeight, CharSpacing: Integer; Printing, PaintAll, PaintColors, PaintSelection, CaretShown: Boolean; end; TKHexEditorSelection = TKHexDigitPosition; { @abstract(Declares the structure for the @link(TKCustomHexEditor.SelText) property)
    Members:
  • AsBinaryRaw - selected data as binary characters not mapped
  • AsBinaryMapped - selected data as binary characters mapped
  • AsDigits - selected data as hexadecimal digits
  • AsDigitsByteAligned - selected data as hexadecimal digits without regarding cross-byte selections
} TKHexEditorSelText = record AsBinaryRaw, AsBinaryMapped, AsDigits, AsDigitsByteAligned: AnsiString; end; { Declares hex editor states - possible values for the @link(TKCustomHexEditor.States) property (protected) } TKHexEditorState = ( { Caret is visible } elCaretVisible, { Caret is being updated } elCaretUpdate, { Ignore following WM_CHAR message } elIgnoreNextChar, { Buffer modified } elModified, { Mouse captured } elMouseCapture, { Overwrite mode active } elOverwrite, { Read only editor } elReadOnly ); { Hex editor states can be arbitrary combined } TKHexEditorStates = set of TKHexEditorState; { Declared for backward compatibility only. } TKHexEditorColorData = TKColorData; { Declared for backward compatibility only. } TKHexEditorColorScheme = TKColorScheme; const { Minimum for the @link(TKCustomHexEditor.AddressSize) property } cAddressSizeMin = 2; { Maximum for the @link(TKCustomHexEditor.AddressSize) property } cAddressSizeMax = 10; { Default value for the @link(TKCustomHexEditor.AddressSize) property } cAddressSizeDef = 8; { Minimum for the @link(TKCustomHexEditor.AreaSpacing) property } cAreaSpacingMin = 1; { Maximum for the @link(TKCustomHexEditor.AreaSpacing) property } cAreaSpacingMax = 20; { Default value for the @link(TKCustomHexEditor.AreaSpacing) property } cAreaSpacingDef = 1; { Minimum for the @link(TKCustomHexEditor.CharSpacing) property } cCharSpacingMin = 0; { Maximum for the @link(TKCustomHexEditor.CharSpacing) property } cCharSpacingMax = 100; { Default value for the @link(TKCustomHexEditor.CharSpacing) property } cCharSpacingDef = 0; { Minimum for the @link(TKCustomHexEditor.DigitGrouping) property } cDigitGroupingMin = 1; { Maximum for the @link(TKCustomHexEditor.DigitGrouping) property } cDigitGroupingMax = 8; { Default value for the @link(TKCustomHexEditor.DigitGrouping) property } cDigitGroupingDef = 2; { Minimum for the @link(TKCustomHexEditor.LineHeightPercent) property } cLineHeightPercentMin = 10; { Maximum for the @link(TKCustomHexEditor.LineHeightPercent) property } cLineHeightPercentMax = 1000; { Default value for the @link(TKCustomHexEditor.LineHeightPercent) property } cLineHeightPercentDef = 130; { Minimum for the @link(TKCustomHexEditor.UndoLimit) property } cUndoLimitMin = 100; { Maximum for the @link(TKCustomHexEditor.UndoLimit) property } cUndoLimitMax = 10000; { Default value for the @link(TKCustomHexEditor.UndoLimit) property } cUndoLimitDef = 1000; { Minimum for the @link(TKCustomHexEditor.LineSize) property } cLineSizeMin = 1; { Maximum for the @link(TKCustomHexEditor.LineSize) property } cLineSizeMax = 128; { Default value for the @link(TKCustomHexEditor.LineSize) property } cLineSizeDef = 16; { Minimum for the @link(TKCustomHexEditor.ScrollSpeed) property } cScrollSpeedMin = 50; { Maximum for the @link(TKCustomHexEditor.ScrollSpeed) property } cScrollSpeedMax = 1000; { Default value for the @link(TKCustomHexEditor.ScrollSpeed) property } cScrollSpeedDef = 100; { Minimum for the @link(TKHexEditor.Font).Size property } cFontSizeMin = 8; { Maximum for the @link(TKHexEditor.Font).Size property } cFontSizeMax = 100; { Default value for the @link(TKHexEditor.Font).Size property } cFontSizeDef = 11; { Default value for the @link(TKHexEditorColors.AddressText) color property } cAddressTextDef = clWindowText; { Default value for the @link(TKHexEditorColors.AddressBkGnd) color property } cAddressBkgndDef = clWindow; { Default value for the @link(TKHexEditorColors.BkGnd) color property } cBkGndDef = clWindow; { Default value for the @link(TKHexEditorColors.DigitTextEven) color property } cDigitTextEvenDef = clMaroon; { Default value for the @link(TKHexEditorColors.DigitTextOdd) color property } cDigitTextOddDef = clRed; { Default value for the @link(TKHexEditorColors.DigitBkGnd) color property } cDigitBkGndDef = clWindow; { Default value for the @link(TKHexEditorColors.HorzLines) color property } cHorzLinesDef = clWindowText; { Default value for the @link(TKHexEditorColors.InactiveCaretBkGnd) color property } cInactiveCaretBkGndDef = clBlack; { Default value for the @link(TKHexEditorColors.InactiveCaretSelBkGnd) color property } cInactiveCaretSelBkGndDef = clBlack; { Default value for the @link(TKHexEditorColors.InactiveCaretSelText) color property } cInactiveCaretSelTextDef = clYellow; { Default value for the @link(TKHexEditorColors.InactiveCaretText) color property } cInactiveCaretTextDef = clYellow; { Default value for the @link(TKHexEditorColors.LinesHighLight) color property } cLinesHighLightDef = clHighLightText; { Default value for the @link(TKHexEditorColors.SelBkGnd) color property } cSelBkGndDef = clGrayText; { Default value for the @link(TKHexEditorColors.SelBkGndFocused) color property } cSelBkGndFocusedDef = clHighlight; { Default value for the @link(TKHexEditorColors.SelText) color property } cSelTextDef = clHighlightText; { Default value for the @link(TKHexEditorColors.SelTextFocused) color property } cSelTextFocusedDef = clHighlightText; { Default value for the @link(TKHexEditorColors.Separators) color property } cSeparatorsDef = clWindowText; { Default value for the @link(TKHexEditorColors.TextText) color property } cTextTextDef = clWindowText; { Default value for the @link(TKHexEditorColors.TextBkgnd) color property } cTextBkgndDef = clWindow; { Default value for the @link(TKHexEditorColors.VertLines) color property } cVertLinesDef = clWindowText; { Index for the @link(TKHexEditorColors.AddressText) color property } ciAddressText = TKColorIndex(0); { Index for the @link(TKHexEditorColors.AddressBkGnd) color property } ciAddressBkGnd = TKColorIndex(1); { Index for the @link(TKHexEditorColors.BkGnd) color property } ciBkGnd = TKColorIndex(2); { Index for the @link(TKHexEditorColors.DigitTextEven) color property } ciDigitTextEven = TKColorIndex(3); { Index for the @link(TKHexEditorColors.DigitTextOdd) color property } ciDigitTextOdd = TKColorIndex(4); { Index for the @link(TKHexEditorColors.DigitBkGnd) color property } ciDigitBkGnd = TKColorIndex(5); { Index for the @link(TKHexEditorColors.HorzLines) color property } ciHorzLines = TKColorIndex(6); { Index for the @link(TKHexEditorColors.InactiveCaretBkGnd) color property } ciInactiveCaretBkGnd = TKColorIndex(7); { Index for the @link(TKHexEditorColors.InactiveCaretSelBkGnd) color property } ciInactiveCaretSelBkGnd = TKColorIndex(8); { Index for the @link(TKHexEditorColors.InactiveCaretSelText) color property } ciInactiveCaretSelText = TKColorIndex(9); { Index for the @link(TKHexEditorColors.InactiveCaretText) color property } ciInactiveCaretText = TKColorIndex(10); { Index for the @link(TKHexEditorColors.LinesHighLight) color property } ciLinesHighLight = TKColorIndex(11); { Index for the @link(TKHexEditorColors.SelBkGnd) color property } ciSelBkGnd = TKColorIndex(12); { Index for the @link(TKHexEditorColors.SelBkGndFocused) color property } ciSelBkGndFocused = TKColorIndex(13); { Index for the @link(TKHexEditorColors.SelText) color property } ciSelText = TKColorIndex(14); { Index for the @link(TKHexEditorColors.SelTextFocused) color property } ciSelTextFocused = TKColorIndex(15); { Index for the @link(TKHexEditorColors.Separators) color property } ciSeparators = TKColorIndex(16); { Index for the @link(TKHexEditorColors.TextText) color property } ciTextText = TKColorIndex(17); { Index for the @link(TKHexEditorColors.TextBkgnd) color property } ciTextBkGnd = TKColorIndex(18); { Index for the @link(TKHexEditorColors.VertLines) color property } ciVertLines = TKColorIndex(19); { Maximum color array index } ciHexEditorColorsMax = ciVertLines; { Default value for the @link(TKCustomHexEditor.AddressMode) property } cAddressModeDef = eamHex; { Default value for the @link(TKCustomHexEditor.Addressoffset) property } cAddressOffsetDef = 0; { Default value for the @link(TKCustomHexEditor.DrawStyles) property } cDrawStylesDef = [edAddress, edDigits, edText, edInactiveCaret, edSeparators]; { Default value for the @link(TKCustomHexEditor.AddressPrefix) property } cAddressPrefixDef = '0x'; { Default value for the @link(TKHexEditor.Font).Name property } cFontNameDef = {$IFDEF MSWINDOWS}'Courier New'{$ELSE}'Courier'{$ENDIF}; { Default value for the @link(TKHexEditor.Font).Style property } cFontStyleDef = [fsBold]; { Declares the Index member of the @link(TKHexEditorSelection) record invalid} cInvalidIndex = -1; { Default value for the @link(TKCustomHexEditor.AddressCursor) property } cAddressCursorDef = crHandPoint; { Default value for the @link(TKHexEditor.Height) property } cHeight = 300; { Default value for the @link(TKHexEditor.Width) property } cWidth = 400; { Default max. chunk size for file IO operations } cIOChunkSize = $2000000; type TKCustomHexEditor = class; { @abstract(Container for all colors used by @link(TKCustomHexEditor) class) This container allows to group many colors into one item in object inspector. Colors are accessible via published properties or several public Color* properties. } TKHexEditorColors = class(TKCustomColors) private FSingleBkGnd: Boolean; protected { Returns the specific color according to ColorScheme. } function InternalGetColor(Index: TKColorIndex): TColor; override; { Returns color specification structure for given index. } function GetColorSpec(Index: TKColorIndex): TKColorSpec; override; { Returns maximum color index. } function GetMaxIndex: Integer; override; public { @link(TKHexEditorColors.BkGnd) is used for all areas if True - @link(edSingleBkGnd) forward } property SingleBkGnd: Boolean read FSingleBkGnd write FSingleBkGnd; published { Address area text color } property AddressText: TColor index ciAddressText read GetColor write SetColor default cAddressTextDef; { Address area background color } property AddressBkGnd: TColor index ciAddressBkgnd read GetColor write SetColor default cAddressBkGndDef; { Hex editor client area background } property BkGnd: TColor index ciBkGnd read GetColor write SetColor default cBkGndDef; { Digits area text color - even digit group } property DigitTextEven: TColor index ciDigitTextEven read GetColor write SetColor default cDigitTextEvenDef; { Digits area text color - odd digit group } property DigitTextOdd: TColor index ciDigitTextOdd read GetColor write SetColor default cDigitTextOddDef; { Digits area background color } property DigitBkGnd: TColor index ciDigitBkGnd read GetColor write SetColor default cDigitBkGndDef; { Color of the horizontal leading lines } property HorzLines: TColor index ciHorzLines read GetColor write SetColor default cHorzLinesDef; { Inactive (hex editor without focus) caret background color - caret mark is not part of a selection } property InactiveCaretBkGnd: TColor index ciInactiveCaretBkGnd read GetColor write SetColor default cInactiveCaretBkGndDef; { Inactive (hex editor without focus) caret background color - caret mark is part of a selection } property InactiveCaretSelBkGnd: TColor index ciInactiveCaretSelBkGnd read GetColor write SetColor default cInactiveCaretSelBkGndDef; { Inactive (hex editor without focus) caret text color - caret mark is part of a selection } property InactiveCaretSelText: TColor index ciInactiveCaretSelText read GetColor write SetColor default cInactiveCaretSelTextDef; { Inactive (hex editor without focus) caret text color - caret mark is not part of a selection } property InactiveCaretText: TColor index ciInactiveCaretText read GetColor write SetColor default cInactiveCaretTextDef; { Color of horizontal leading lines involved into a selection } property LinesHighLight: TColor index ciLinesHighLight read GetColor write SetColor default cLinesHighLightDef; { Selection background - inactive edit area } property SelBkGnd: TColor index ciSelBkGnd read GetColor write SetColor default cSelBkGndDef; { Selection background - active edit area } property SelBkGndFocused: TColor index ciSelBkGndFocused read GetColor write SetColor default cSelBkGndFocusedDef; { Selection text - inactive edit area } property SelText: TColor index ciSelText read GetColor write SetColor default cSelTextDef; { Selection text - active edit area } property SelTextFocused: TColor index ciSelTextFocused read GetColor write SetColor default cSelTextFocusedDef; { Color of the vertical area separating lines } property Separators: TColor index ciSeparators read GetColor write SetColor default cSeparatorsDef; { Text area text color } property TextText: TColor index ciTextText read GetColor write SetColor default cTextTextDef; { Text area background color } property TextBkgnd: TColor index ciTextBkgnd read GetColor write SetColor default cTextBkGndDef; { Color of the vertical leading lines } property VertLines: TColor index ciVertLines read GetColor write SetColor default cVertLinesDef; end; { Declares possible values for the ItemReason member of the @link(TKHexEditorChangeItem) structure } TKHexEditorChangeReason = ( { Save caret position only } crCaretPos, { Save inserted character to be able to delete it } crDeleteChar, { Save inserted hexadecimal digits to be able to delete them } crDeleteDigits, { Save inserted binary string to be able to delete it } crDeleteString, { Save deleted character to be able to insert it } crInsertChar, { Save deleted hexadecimal digits to be able to insert them } crInsertDigits, { Save deleted binary string to be able to insert it } crInsertString ); { @abstract(Declares @link(TKHexEditorChangeList.OnChange) event handler)
    Parameters:
  • Sender - identifies the event caller
  • ItemReason - specifies the undo/redo reason
} TKHexEditorUndoChangeEvent = procedure(Sender: TObject; ItemReason: TKHexEditorChangeReason) of object; { @abstract(Declares the undo/redo item description structure used by the @link(TKHexEditorChangeList) class)
    Members:
  • Data - characters (binary or digit string) needed to execute this item
  • EditArea - active edit area at the time this item was recorded
  • Group - identifies the undo/redo group. Some editor modifications produce a sequence of 2 or more undo items. This sequence is called undo/redo group and is always interpreted as a single undo/redo item. Moreover, if there is eoGroupUndo in @link(TKCustomHexEditor.Options), a single ecUndo or ecRedo command manipulates all following undo groups of the same kind (reason) as if they were a single undo/redo item.
  • GroupReason - reason (kind) of this undo group
  • ItemReason - reason (kind) of this item
  • SelEnd - end of the selection at the time this item was recorded
  • SelStart - start of the selection at the time this item was recorded
} TKHexEditorChangeItem = record Data: AnsiString; EditArea: TKHexEditorArea; Group: Cardinal; GroupReason: TKHexEditorChangeReason; Inserted: Boolean; ItemReason: TKHexEditorChangeReason; SelEnd: TKHexEditorSelection; SelStart: TKHexEditorSelection; end; { Pointer to @link(TKHexEditorChangeItem) } PKHexEditorChangeItem = ^TKHexEditorChangeItem; { @abstract(Change (undo/redo item) list manager) } TKHexEditorChangeList = class(TList) private FEditor: TKCustomHexEditor; FGroup: Cardinal; FGroupUseLock: Integer; FGroupReason: TKHexEditorChangeReason; FIndex: Integer; FModifiedIndex: Integer; FLimit: Integer; FRedoList: TKHexEditorChangeList; FOnChange: TKHexEditorUndoChangeEvent; function GetModified: Boolean; procedure SetLimit(Value: Integer); procedure SetModified(Value: Boolean); protected { Redefined to properly destroy the items } procedure Notify(Ptr: Pointer; Action: TListNotification); override; public { Performs necessary initializations
    Parameters:
  • AEditor - identifies the undo/redo list owner
  • RedoList - when this instance is used as undo list, specify a redo list to allow clear it at each valid AddChange call
} constructor Create(AEditor: TKCustomHexEditor; RedoList: TKHexEditorChangeList); { Inserts a undo/redo item
    Parameters:
  • ItemReason - specifies the undo/redo item reason. The change list doesn't allow to insert succesive crCaretPos items unless Inserted is True
  • Data - specifies the item data. Some items (crCaretPos) don't need to supply any data
  • Inserted - for the urInsert* items, specifies whether the item was recorded with @link(TKCustomHexEditor.InsertMode) on (True) or off (False). See ItemReason for crCaretPos behavior.
} procedure AddChange(ItemReason: TKHexEditorChangeReason; const Data: AnsiString = ''; Inserted: Boolean = True); virtual; { Tells the undo list a new undo/redo group is about to be created. Each BeginGroup call must have a corresponding EndGroup call (use try-finally). BeginGroup calls may be nested, however, only the first call will create an undo/redo group. Use the GroupReason parameter to specify the reason of this group. } procedure BeginGroup(GroupReason: TKHexEditorChangeReason); virtual; { Informs whether there are any undo/redo items available - i.e. CanUndo/CanRedo} function CanPeek: Boolean; { Clears the entire list - overriden to execute some adjustments } procedure Clear; override; { Completes the undo/redo group. See @link(TKHexEditorChangeList.BeginGroup) for details } procedure EndGroup; virtual; { Returns the topmost item to handle or inspect it} function PeekItem: PKHexEditorChangeItem; { If there is no reason to handle an item returned by PeekItem, it has to be poked back with this function to become active for next undo/redo command } procedure PokeItem; { For redo list only - each undo command creates a redo command with the same group information - see source } procedure SetGroupData(Group: Integer; GroupReason: TKHexEditorChangeReason); { Specifies maximum number of items - not groups } property Limit: Integer read FLimit write SetLimit; { For undo list only - returns True if undo list contains some items with regard to the eoUndoAfterSave option } property Modified: Boolean read GetModified write SetModified; { Allows to call TKCustomHexEditor.@link(TKCustomHexEditor.OnChange) event} property OnChange: TKHexEditorUndoChangeEvent read FOnChange write FOnChange; end; { @abstract(Hexadecimal editor base component) } TKCustomHexEditor = class(TKCustomControl) private FAddressCursor: TCursor; FAddressMode: TKHexEditorAddressMode; FAddressOffset: Integer; FAddressPrefix: string; FAddressSize: Integer; FAreaSpacing: Integer; FBuffer: PBytes; FCharHeight: Integer; FCharMapping: TKEditCharMapping; FCharSpacing: Integer; FCharWidth: Integer; FClipboardFormat: Word; FColors: TKHexEditorColors; FDigitGrouping: Integer; FDisabledDrawStyle: TKEditDisabledDrawStyle; FDrawStyles: TKHexEditorDrawStyles; FEditArea: TKHexEditorArea; FKeyMapping: TKEditKeyMapping; FLeftChar: Integer; FLineHeightPercent: Integer; FLineSize: Integer; FMouseWheelAccumulator: Integer; FOptions: TKEditOptions; FRedoList: TKHexEditorChangeList; FScrollBars: TScrollStyle; FScrollDeltaX: Integer; FScrollDeltaY: Integer; FScrollSpeed: Cardinal; FScrollTimer: TTimer; FSelEnd: TKHexEditorSelection; FSelStart: TKHexEditorSelection; FSize: Int64; FStates: TKHexEditorStates; FTopLine: Int64; FTotalCharSpacing: Integer; FUndoList: TKHexEditorChangeList; FOnChange: TNotifyEvent; FOnDropFiles: TKEditDropFilesEvent; FOnReplaceText: TKEditReplaceTextEvent; function GetCommandKey(Index: TKEditCommand): TKEditKey; function GetCaretVisible: Boolean; function GetData: TDataSize; function GetEmpty: Boolean; function GetFirstVisibleIndex: Integer; function GetInsertMode: Boolean; function GetLastVisibleIndex: Integer; function GetLineCount: Int64; function GetLines(Index: Int64): TDataSize; function GetModified: Boolean; function GetReadOnly: Boolean; function GetSelLength: TKHexEditorSelection; function GetSelText: TKHexEditorSelText; function GetUndoLimit: Integer; function IsAddressPrefixStored: Boolean; function IsDrawStylesStored: Boolean; function IsOptionsStored: Boolean; procedure ScrollTimerHandler(Sender: TObject); procedure SetAddressCursor(Value: TCursor); procedure SetAddressMode(Value: TKHexEditorAddressMode); procedure SetAddressOffset(Value: Integer); procedure SetAddressPrefix(const Value: string); procedure SetAddressSize(Value: Integer); procedure SetAreaSpacing(Value: Integer); procedure SetCharSpacing(Value: Integer); procedure SetColors(Value: TKHexEditorColors); procedure SetCommandKey(Index: TKEditCommand; Value: TKEditKey); procedure SetData(const Value: TDataSize); procedure SetDigitGrouping(Value: Integer); procedure SetDisabledDrawStyle(Value: TKEditDisabledDrawStyle); procedure SetDrawStyles(const Value: TKHexEditorDrawStyles); procedure SetEditArea(Value: TKHexEditorArea); procedure SetLeftChar(Value: Integer); procedure SetLineHeightPercent(Value: Integer); procedure SetLines(Index: Int64; const Value: TDataSize); procedure SetLineSize(Value: Integer); procedure SetModified(Value: Boolean); procedure SetOptions(const Value: TKEditOptions); procedure SetReadOnly(Value: Boolean); procedure SetScrollBars(Value: TScrollStyle); procedure SetScrollSpeed(Value: Cardinal); procedure SetSelEnd(Value: TKHexEditorSelection); procedure SetSelLength(Value: TKHexEditorSelection); procedure SetSelStart(Value: TKHexEditorSelection); procedure SetTopLine(Value: Int64); procedure SetUndoLimit(Value: Integer); procedure CMEnabledChanged(var Msg: TLMessage); message CM_ENABLEDCHANGED; procedure CMSysColorChange(var Msg: TLMessage); message CM_SYSCOLORCHANGE; {$IFNDEF FPC} // no way to get filenames in Lazarus inside control (why??) procedure WMDropFiles(var Msg: TLMessage); message LM_DROPFILES; {$ENDIF} procedure WMEraseBkgnd(var Msg: TLMessage); message LM_ERASEBKGND; procedure WMGetDlgCode(var Msg: TLMNoParams); message LM_GETDLGCODE; procedure WMHScroll(var Msg: TLMHScroll); message LM_HSCROLL; procedure WMKillFocus(var Msg: TLMKillFocus); message LM_KILLFOCUS; procedure WMSetFocus(var Msg: TLMSetFocus); message LM_SETFOCUS; procedure WMVScroll(var Msg: TLMVScroll); message LM_VSCROLL; protected FInUpdateScrollRange: Boolean; { Inserts a single crCaretPos item into undo list. Unless Force is set to True, this change will be inserted only if previous undo item is not crCaretPos. } procedure AddUndoCaretPos(Force: Boolean = True); { Inserts a single byte change into undo list.
    Parameters:
  • ItemReason - specifies the undo/redo item reason - most likely crInsertChar or crDeleteChar.
  • Data - specifies the data byte needed to restore the original buffer state
  • Inserted - for the urInsert* items, specifies the current @link(TKCustomHexEditor.InsertMode) status.
} procedure AddUndoByte(ItemReason: TKHexEditorChangeReason; Data: Byte; Inserted: Boolean = True); { Inserts a byte array change into undo list.
    Parameters:
  • ItemReason - specifies the undo/redo item reason - crInsert* or crDelete*.
  • Data - specifies the data bytes needed to restore the original buffer state
  • Inserted - for the urInsert* items, specifies the current @link(TKCustomHexEditor.InsertMode) status.
} procedure AddUndoBytes(ItemReason: TKHexEditorChangeReason; Data: PBytes; Length: Integer; Inserted: Boolean = True); { Inserts a string change into undo list. Has the same functionality as AddUndoBytes only Data is supplied as a string. } procedure AddUndoString(ItemReason: TKHexEditorChangeReason; const S: AnsiString; Inserted: Boolean = True); { Begins a new undo group. Use the GroupReason parameter to label it. } procedure BeginUndoGroup(GroupReason: TKHexEditorChangeReason); { Performs necessary adjustments when the buffer is modified programatically (not by user) } procedure BufferChanged; { Determines whether an ecScroll* command can be executed } function CanScroll(Command: TKEditCommand): Boolean; virtual; { Clears a character at position At. Doesn't perform any succesive adjustments. } procedure ClearChar(At: Integer); { Clears a the digit fields both in SelStart and SelEnd. Doesn't perform any succesive adjustments.} procedure ClearDigitSelection; { Clears a string of the Size length at position At. Doesn't perform any succesive adjustments. } procedure ClearString(At, Size: Int64); { Overriden method - defines additional styles for the hex editor window (scrollbars etc.)} procedure CreateParams(var Params: TCreateParams); override; { Overriden method - adjusts file drag&drop functionality } procedure CreateWnd; override; { Overriden method - adjusts file drag&drop functionality } procedure DestroyWnd; override; { Calls the @link(TKCustomHexEditor.OnChange) event } procedure DoChange; virtual; { Overriden method - handles mouse wheel messages } function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean; override; { Validates the EditArea property after it has been modified } procedure EditAreaChanged; virtual; { Closes the undo group created by @link(TKCustomHexEditor.BeginUndoGroup) } procedure EndUndoGroup; { Ensures that font pitch is always fpFixed and Font.Size is not too small or big } procedure FontChange(Sender: TObject); virtual; { Returns the horizontal page extent for the current edit area. This function is used by the ecPageLeft and ecPageRight commands. } function GetPageHorz: Integer; virtual; { Determines if the editor has input focus. } function HasFocus: Boolean; virtual; { Hides the caret. } procedure HideEditorCaret; virtual; { Inserts a character at specified position. Doesn't perform any succesive adjustments.
    Parameters:
  • At - position where the character should be inserted.
  • Value - character (data byte)
} procedure InsertChar(At: Int64; Value: Byte); { Inserts a string at specified position. Doesn't perform any succesive adjustments.
    Parameters:
  • At - position where the string should be inserted.
  • Value - data byte string
} procedure InsertString(At: Int64; const Value: TDataSize); overload; { Inserts a string at specified position. Doesn't perform any succesive adjustments.
    Parameters:
  • At - position where the string should be inserted.
  • Value - data byte string
} procedure InsertString(At: Int64; const Value: AnsiString); overload; { Returns True if the control has a selection. } function InternalGetSelAvail: Boolean; override; { Moves the caret one position left. Doesn't perform any succesive adjustments.} procedure InternalMoveLeft; virtual; { Moves the caret one position right. Doesn't perform any succesive adjustments.} procedure InternalMoveRight; virtual; { Responds to PostLateUpdate. } procedure LateUpdate(var Msg: TLMessage); override; { Overriden method - processes virtual key strokes according to current key mapping scheme.) } procedure KeyDown(var Key: Word; Shift: TShiftState); override; { Overriden method - processes character key strokes - data editing } procedure KeyPress(var Key: Char); override; { Updates information about printed shape. } procedure MeasurePages(var Info: TKPrintMeasureInfo); override; { Processes scrollbar messages.
    Parameters:
  • ScrollBar - scrollbar type from OS
  • ScrollCode - scrollbar action from OS
  • Delta - scrollbar position change
  • UpdateNeeded - set to True if you want to invalidate and update caret position
} procedure ModifyScrollBar(ScrollBar, ScrollCode, Delta: Integer; UpdateNeeded: Boolean); { Overriden method - updates caret position/selection } procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; { Overriden method - updates caret position/selection and initializes scrolling when needed. } procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; { Overriden method - releases mouse capture acquired by MouseDown } procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; { Overriden method - calls PaintLines for drawing the hex editor outline into window client area } procedure PaintToCanvas(ACanvas: TCanvas); override; { Paints/prints hex editor outline. This function must retain its reentrancy.
    Parameters:
  • Data - paint settings
} procedure PaintLines(const Data: TKHexEditorPaintData); virtual; { Paints a page to a printer/preview canvas. } procedure PaintPage; override; { Grants the input focus to the control when possible and the control has had none before } procedure SafeSetFocus; { Performs necessary adjustments after a selection property changed.
    Parameters:
  • StartEqualEnd - forces SelStart equal to SelEnd
  • ScrollToView - forces scrolling if SelEnd (caret) became invisible
} procedure SelectionChanged(StartEqualEnd: Boolean; ScrollToView: Boolean = True); { Scrolls the hex editor window horizontaly by HChars characters and/or vertically by VChars characters } procedure ScrollBy(HChars, VChars: Integer; UpdateNeeded: Boolean); reintroduce; { Scrolls the hex editor window to ensure data under defined (mouse) coordinates are visible
    Parameters:
  • Point - (mouse) coordinates
  • Timed - set to True to continue scroll via a timer. The scrolling will continue until the mouse cursor is outside of the modified client rect (@link(TKCustomHexEditor.GetModifiedClientRect)).
  • AlwaysScroll - set to True to disable new line overscrolling
} procedure ScrollTo(Point: TKPoint64; Timed, AlwaysScroll: Boolean); virtual; { Updates mouse cursor according to the state determined from current mouse position. Returns True if cursor has been changed. } function SetMouseCursor(X, Y: Integer): Boolean; override; { Shows the caret. } procedure ShowEditorCaret; virtual; { Calls the @link(TKCustomHexEditor.DoChange) method} procedure UndoChange(Sender: TObject; ItemReason: TKHexEditorChangeReason); { Updates caret position, shows/hides caret according to the input focus
    Parameters:
  • Recreate - set to True to recreate the caret after it has already been created and displayed
} procedure UpdateEditorCaret(Recreate: Boolean = False); virtual; { Updates font based dimensions } procedure UpdateCharMetrics; virtual; { Updates mouse cursor } procedure UpdateMouseCursor; virtual; { Updates the scrolling range } procedure UpdateScrollRange; virtual; { Updates selection according to the supplied coordinates.
    Parameters:
  • Point - specifies the coordinates
  • ClipToClient - specifies whether the coordinates should be clipped to modified client rectangle (@link(TKCustomHexEditor.GetModifiedClientRect)) first
} procedure UpdateSelEnd(Point: TKPoint64; ClipToClient: Boolean); virtual; { Updates the control size. } procedure UpdateSize; override; { Data buffer - made accessible for descendant classes } property Buffer: PBytes read FBuffer write FBuffer; { Redo list manager - made accessible for descendant classes } property RedoList: TKHexEditorChangeList read FRedoList; { Data buffer size - made accessible for descendant classes } property Size: Int64 read FSize write FSize; { States of this class - made accessible for descendant classes } property States: TKHexEditorStates read FStates write FStates; { Undo list manager - made accessible for descendant classes } property UndoList: TKHexEditorChangeList read FUndoList; public { Performs necessary initializations - default values to properties, create undo/redo list managers } constructor Create(AOwner: TComponent); override; { Destroy instance, undo/redo list managers, dispose buffer... } destructor Destroy; override; { Appends data at current position. Use -1 for At parameter to append at the end of the buffer. } procedure Append(At: Integer; const Data: TDataSize); overload; virtual; { Appends data at current position. Use -1 for At parameter to append at the end of the buffer. } procedure Append(At: Integer; const Data: AnsiString); overload; virtual; { Takes property values from another TKCustomHexEditor class } procedure Assign(Source: TPersistent); override; { Determines whether the caret is visible } function CaretInView: Boolean; { Clears entire data buffer. Unlike ecClearAll this method clears everything inclusive undo a redo lists. } procedure Clear; { Clears undo (and redo) list } procedure ClearUndo; { Determines whether given command can be executed at this time. Use this function in TAction.OnUpdate events.
    Parameters:
  • Command - specifies the command to inspect
} function CommandEnabled(Command: TKEditCommand): Boolean; virtual; { Executes given command. This function first calls CommandEnabled to assure given command can be executed.
    Parameters:
  • Command - specifies the command to execute
  • Data - specifies the data needed for the command
} function ExecuteCommand(Command: TKEditCommand; Data: Pointer = nil): Boolean; virtual; { Returns dimensions of all 3 possible areas according to current area definition } function GetAreaDimensions: TKHexEditorAreaDimensions; virtual; { Returns current character mapping. } function GetCharMapping: TKEditCharMapping; { Returns number of characters that vertically fit into client window } function GetClientHeightChars: Integer; virtual; { Returns number of characters that horizontally fit into client window } function GetClientWidthChars: Integer; virtual; { Returns modified client rect - a window client rect aligned to character width and character height } function GetModifiedClientRect: TRect; virtual; { Returns current maximum value for the @link(TKCustomHexEditor.LeftChar) property
    Parameters:
  • Extent - specify @link(TKHexEditorAreaDimensions).TotalHorz here, otherwise the function calculates it itself
} function GetMaxLeftChar(Extent: Integer = 0): Integer; virtual; { Returns current maximum value for the @link(TKCustomHexEditor.TopLine) property
    Parameters:
  • Extent - specify @link(TKHexEditorAreaDimensions).TotalVert here, otherwise the function calculates it itself
} function GetMaxTopLine(Extent: Int64 = 0): Int64; virtual; { Returns "real" selection end - with always higher index value than selection start value } function GetRealSelEnd: TKHexEditorSelection; { Returns "real" selection start - with always lower index value than selection end value } function GetRealSelStart: TKHexEditorSelection; { Loads data from a file } procedure LoadFromFile(const FileName: TFileName); { Loads data from a stream - stream position remains untouched } procedure LoadFromStream(Stream: TStream); { Paints the editor outline to another canvas
    Parameters:
  • ACanvas - canvas to paint the outline to
  • ARect - given rectangle in the canvas
  • ALeftChar - first left visible character
  • ATopLine - first top visible line
} procedure PaintToCanvasEx(ACanvas: TCanvas; ARect: TRect; ALeftChar: Integer; ATopLine: Int64); { Converts window coordinates into a selection
    Parameters:
  • P - window client coordinates
  • OutOfArea - uses the Area parameter to compute selection for this area even if the supplied coordinates are outside of the area outline
  • Area output parameter if OutOfArea = False, otherwise input parameter
} function PointToSel(P: TKPoint64; OutOfArea: Boolean; var Area: TKHexEditorArea): TKHexEditorSelection; virtual; { Saves data into a file } procedure SaveToFile(const FileName: TFileName); { Saves data into a stream - stream position remains untouched } procedure SaveToStream(Stream: TStream); { Determines whether a seletion (not digit selection) is available } function SelAvail: Boolean; { Determines whether a given selection is valid for given area
    Parameters:
  • Value - selection to examine
  • Area - area for which the selection must be examined
} function SelectionValid(Value: TKHexEditorSelection; Area: TKHexEditorArea): Boolean; virtual; { Converts a selection into window coordinates
    Parameters:
  • Value - selection to convert
  • Area - the same selection delivers another coordinates for each area
} function SelToPoint(Value: TKHexEditorSelection; Area: TKHexEditorArea): TKPoint64; virtual; { Specifies character mapping. The main purpose of this is to avoid non-printable characters in the text area and in AsText copies. Avoid non-printable characters when delivering a new character mapping. } procedure SetCharMapping(Value: TKEditCharMapping); { Specifies the current key stroke mapping scheme } procedure SetKeyMapping(const Value: TKEditKeyMapping); { Validates a selection for given area
    Parameters:
  • Value - selection to validate
  • Area - area for which the selection must be validated
} procedure ValidateSelection(var Value: TKHexEditorSelection; Area: TKHexEditorArea); virtual; { Specifies the address area mouse cursor. Other areas have crIBeam - should not be needed to modify that } property AddressCursor: TCursor read FAddressCursor write SetAddressCursor default cAddressCursorDef; { Specifies the radix of addresses } property AddressMode: TKHexEditorAddressMode read FAddressMode write SetAddressMode default cAddressModeDef; { Specifies the address offset } property AddressOffset: Integer read FAddressOffset write SetAddressOffset default cAddressOffsetDef; { Specifies the address number prefix i.e. 0x or $ - modify together with AddressMode } property AddressPrefix: string read FAddressPrefix write SetAddressPrefix stored IsAddressPrefixStored; { Specifies the number of address digits - up to 10 for decimal addresses } property AddressSize: Integer read FAddressSize write SetAddressSize default cAddressSizeDef; { Defines space between neighbour areas } property AreaSpacing: Integer read FAreaSpacing write SetAreaSpacing default cAreaSpacingDef; { Returns current caret position = selection end } property CaretPos: TKHexEditorSelection read FSelEnd; { Returns True if caret is visible } property CaretVisible: Boolean read GetCaretVisible; { Returns current character width = not necessarily equal to font character width } property CharWidth: Integer read FCharWidth; { Defines additional inter-character spacing } property CharSpacing: Integer read FCharSpacing write SetCharSpacing default cCharSpacingDef; { Returns current character height = not equal to font character height } property CharHeight: Integer read FCharHeight; { Returns the binary data clipboard format } property ClipboardFormat: Word read FClipboardFormat; { Makes it possible to take all color properties from another TKCustomHexEditor class } property Colors: TKHexEditorColors read FColors write SetColors; { Specifies a new key stroke combination for given command } property CommandKey[Index: TKEditCommand]: TKEditKey read GetCommandKey write SetCommandKey; { This property provides direct access to the data buffer } property Data: TDataSize read GetData write SetData; { Specifies the byte grouping in the digits area } property DigitGrouping: Integer read FDigitGrouping write SetDigitGrouping default cDigitGroupingDef; { Specifies the style how the outline is drawn when editor is disabled } property DisabledDrawStyle: TKEditDisabledDrawStyle read FDisabledDrawStyle write SetDisabledDrawStyle default cEditDisabledDrawStyleDef; { Defines areas to paint, whether to paint horizontal and vertical trailing lines, area separator lines and caret mark when the editor has no input focus } property DrawStyles: TKHexEditorDrawStyles read FDrawStyles write SetDrawStyles stored IsDrawStylesStored; { Specifies the current area for editing } property EditArea: TKHexEditorArea read FEditArea write SetEditArea default eaDigits; { Returns True if data buffer is empty } property Empty: Boolean read GetEmpty; { Returns the first visible index } property FirstVisibleIndex: Integer read GetFirstVisibleIndex; { Returns True if insert mode is on } property InsertMode: Boolean read GetInsertMode; { Specifies the current key stroke mapping scheme. } property KeyMapping: TKEditKeyMapping read FKeyMapping; { Returns the last visible index } property LastVisibleIndex: Integer read GetLastVisibleIndex; { Specifies the horizontal scroll position } property LeftChar: Integer read FLeftChar write SetLeftChar; { Determines the number of lines } property LineCount: Int64 read GetLineCount; { Specifies the line height. 100% is the current font height } property LineHeightPercent: Integer read FLineHeightPercent write SetLineHeightPercent default cLineHeightPercentDef; { Allows to modify/add data lines. If greater than LineSize, the Size member of the supplied TDataSize structure will be always trimmed to LineSize. If Index points to last incomplete line or even higher, last line will be extended/completed, i.e new data will be added to the buffer } property Lines[Index: Int64]: TDataSize read GetLines write SetLines; { Specifies the size (length) of a single line } property LineSize: Integer read FLineSize write SetLineSize default cLineSizeDef; { Returns True if the buffer was modified - eoUndoAfterSave taken into account } property Modified: Boolean read GetModified write SetModified; { Specifies the editor options that do not affect painting } property Options: TKEditOptions read FOptions write SetOptions stored IsOptionsStored; { Specifies whether the editor has to be read only editor } property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False; { Defines visible scrollbars - horizontal, vertical or both } property ScrollBars: TScrollStyle read FScrollBars write SetScrollBars default ssBoth; { Specifies how fast the scrolling by timer should be } property ScrollSpeed: Cardinal read FScrollSpeed write SetScrollSpeed default cScrollSpeedDef; { Specifies the current selection end } property SelEnd: TKHexEditorSelection read FSelEnd write SetSelEnd; { Specifies the current selection length. SelStart remains unchanged, SelEnd will be updated accordingly. To mark a selection, either set both SelStart and SelEnd properties or both SelStart and SelLength properties } property SelLength: TKHexEditorSelection read GetSelLength write SetSelLength; { Specifies the current selection start } property SelStart: TKHexEditorSelection read FSelStart write SetSelStart; { Returns selected text in many different formats } property SelText: TKHexEditorSelText read GetSelText; { Specifies the vertical scroll position } property TopLine: Int64 read FTopLine write SetTopLine; { Specifies the maximum number of undo items. Please note this value affects the undo item limit, not undo group limit. } property UndoLimit: Integer read GetUndoLimit write SetUndoLimit default cUndoLimitDef; { When assigned, this event will be invoked at each buffer change, made either by the user or programmatically by public functions } property OnChange: TNotifyEvent read FOnChange write FOnChange; { When assigned, this event will be invoked when the user drops any files onto the window } property OnDropFiles: TKEditDropFilesEvent read FOnDropFiles write FOnDropFiles; { When assigned, this event will be invoked at each prompt-forced search match } property OnReplaceText: TKEditReplaceTextEvent read FOnReplaceText write FOnReplaceText; end; { @abstract(Hexadecimal editor design-time component) } TKHexEditor = class(TKCustomHexEditor) published { See TKCustomHexEditor.@link(TKCustomHexEditor.AddressCursor) for details } property AddressCursor; { See TKCustomHexEditor.@link(TKCustomHexEditor.AddressMode) for details } property AddressMode; { See TKCustomHexEditor.@link(TKCustomHexEditor.AddressOffset) for details } property AddressOffset; { See TKCustomHexEditor.@link(TKCustomHexEditor.AddressPrefix) for details } property AddressPrefix; { See TKCustomHexEditor.@link(TKCustomHexEditor.AddressSize) for details } property AddressSize; { Inherited property - see Delphi help } property Align; { Inherited property - see Delphi help } property Anchors; { See TKCustomControl.@link(TKCustomControl.BorderStyle) for details } property BorderStyle; { Inherited property - see Delphi help } property BorderWidth; { See TKCustomHexEditor.@link(TKCustomHexEditor.CharSpacing) for details } property CharSpacing; { See TKCustomHexEditor.@link(TKCustomHexEditor.Colors) for details } property Colors; { Inherited property - see Delphi help } property Constraints; {$IFNDEF FPC} { Inherited property - see Delphi help. } property Ctl3D; {$ENDIF} { See TKCustomHexEditor.@link(TKCustomHexEditor.DigitGrouping) for details } property DigitGrouping; { See TKCustomHexEditor.@link(TKCustomHexEditor.DisabledDrawStyle) for details } property DisabledDrawStyle; { Inherited property - see Delphi help } property DragCursor; { Inherited property - see Delphi help } property DragKind; { Inherited property - see Delphi help } property DragMode; { See TKCustomHexEditor.@link(TKCustomHexEditor.DrawStyles) for details } property DrawStyles; { See TKCustomHexEditor.@link(TKCustomHexEditor.EditArea) for details } property EditArea; { Inherited property - see Delphi help } property Enabled; { Inherited property - see Delphi help. Font pitch must always remain fpFixed - specify fixed fonts only. Font.Size will also be trimmed if too small or big } property Font; { Inherited property - see Delphi help } property Height default cHeight; { See TKCustomHexEditor.@link(TKCustomHexEditor.LineHeightPercent) for details } property LineHeightPercent; { See TKCustomHexEditor.@link(TKCustomHexEditor.LineSize) for details } property LineSize; { See TKCustomHexEditor.@link(TKCustomHexEditor.Options) for details } property Options; { Inherited property - see Delphi help } property ParentShowHint; { Inherited property - see Delphi help } property PopupMenu; { See TKCustomHexEditor.@link(TKCustomHexEditor.ReadOnly) for details } property ReadOnly; { See TKCustomHexEditor.@link(TKCustomHexEditor.ScrollBars) for details } property ScrollBars; { See TKCustomHexEditor.@link(TKCustomHexEditor.ScrollSpeed) for details } property ScrollSpeed; { Inherited property - see Delphi help } property ShowHint; { Inherited property - see Delphi help } property TabOrder; { Inherited property - see Delphi help } property TabStop default True; { See TKCustomHexEditor.@link(TKCustomHexEditor.UndoLimit) for details } property UndoLimit; { Inherited property - see Delphi help } property Visible; { Inherited property - see Delphi help } property Width default cWidth; { See TKCustomHexEditor.@link(TKCustomHexEditor.OnChange) for details } property OnChange; { Inherited property - see Delphi help } property OnClick; { Inherited property - see Delphi help } property OnContextPopup; { Inherited property - see Delphi help } property OnDblClick; { Inherited property - see Delphi help } property OnDockDrop; { Inherited property - see Delphi help } property OnDockOver; { Inherited property - see Delphi help } property OnDragDrop; { Inherited property - see Delphi help } property OnDragOver; { See TKCustomHexEditor.@link(TKCustomHexEditor.OnDropFiles) for details } property OnDropFiles; { Inherited property - see Delphi help } property OnEndDock; { Inherited property - see Delphi help } property OnEndDrag; { Inherited property - see Delphi help } property OnEnter; { Inherited property - see Delphi help } property OnExit; { Inherited property - see Delphi help } property OnGetSiteInfo; { Inherited property - see Delphi help } property OnKeyDown; { Inherited property - see Delphi help } property OnKeyPress; { Inherited property - see Delphi help } property OnKeyUp; { Inherited property - see Delphi help } property OnMouseDown; {$IFDEF COMPILER9_UP} { Inherited property - see Delphi help. } property OnMouseEnter; { Inherited property - see Delphi help. } property OnMouseLeave; {$ENDIF} { Inherited property - see Delphi help } property OnMouseMove; { Inherited property - see Delphi help } property OnMouseUp; { Inherited property - see Delphi help } property OnMouseWheel; { Inherited property - see Delphi help } property OnMouseWheelDown; { Inherited property - see Delphi help } property OnMouseWheelUp; { See TKCustomControl.@link(TKCustomControl.OnPrintNotify) for details } property OnPrintNotify; { See TKCustomControl.@link(TKCustomControl.OnPrintPaint) for details } property OnPrintPaint; { See TKCustomHexEditor.@link(TKCustomHexEditor.OnReplaceText) for details } property OnReplaceText; { Inherited property - see Delphi help } property OnResize; { Inherited property - see Delphi help } property OnStartDock; { Inherited property - see Delphi help } property OnStartDrag; { Inherited property - see Delphi help } property OnUnDock; end; { Declared for backward compatibility only. Use @link(TKCustomHexEditor.Colors) and its properties/methods. } function GetColorSpec(Index: TKHexEditorColorIndex): TKHexEditorColorSpec; function MakeSelection(Index: Int64; Digit: Integer): TKHexEditorSelection; implementation uses {$IFDEF USE_THEMES} Themes, {$ENDIF} Math, {$IFDEF MSWINDOWS} ShellApi, {$ENDIF} ClipBrd, Printers, Types, KRes; function OppositeReason(ItemReason: TKHexEditorChangeReason): TKHexEditorChangeReason; begin case ItemReason of crDeleteChar: Result := crInsertChar; crDeleteDigits: Result := crInsertDigits; crDeleteString: Result := crInsertString; crInsertChar: Result := crDeleteChar; crInsertDigits: Result := crDeleteDigits; crInsertString: Result := crDeleteString; else Result := ItemReason; end; end; function GetColorSpec(Index: TKHexEditorColorIndex): TKHexEditorColorSpec; var Colors: TKHexEditorColors; begin Colors := TKHexEditorColors.Create(nil); try Result.Def := Colors.DefaultColor[Index]; Result.Name := Colors.ColorName[Index]; finally Colors.Free; end; end; function MakeSelection(Index: Int64; Digit: Integer): TKHexEditorSelection; begin Result := MakeHexDigitPosition(Index, Digit); end; { TKHexEditorColors } function TKHexEditorColors.GetColorSpec(Index: TKColorIndex): TKColorSpec; begin case Index of ciAddressText: begin Result.Def := cAddressTextDef; Result.Name := sHEAddressText; end; ciAddressBkGnd: begin Result.Def := cAddressBkgndDef; Result.Name := sHEAddressBkGnd; end; ciBkGnd: begin Result.Def := cBkGndDef; Result.Name := sHEBkGnd; end; ciDigitTextEven: begin Result.Def := cDigitTextEvenDef; Result.Name := sHEDigitTextEven; end; ciDigitTextOdd: begin Result.Def := cDigitTextOddDef; Result.Name := sHEDigitTextOdd; end; ciDigitBkGnd: begin Result.Def := cDigitBkGndDef; Result.Name := sHEDigitBkgnd; end; ciHorzLines: begin Result.Def := cHorzLinesDef; Result.Name := sHEHorzLines; end; ciInactiveCaretBkGnd: begin Result.Def := cInactiveCaretBkGndDef; Result.Name := sHEInactiveCaretBkGnd; end; ciInactiveCaretSelBkGnd: begin Result.Def := cInactiveCaretSelBkGndDef; Result.Name := sHEInactiveCaretSelBkGnd; end; ciInactiveCaretSelText: begin Result.Def := cInactiveCaretSelTextDef; Result.Name := sHEInactiveCaretSelText; end; ciInactiveCaretText: begin Result.Def := cInactiveCaretTextDef; Result.Name := sHEInactiveCaretText; end; ciLinesHighLight: begin Result.Def := cLinesHighLightDef; Result.Name := sHELinesHighLight; end; ciSelBkGnd: begin Result.Def := cSelBkGndDef; Result.Name := sHESelBkGnd; end; ciSelBkGndFocused: begin Result.Def := cSelBkGndFocusedDef; Result.Name := sHESelBkGndFocused; end; ciSelText: begin Result.Def := cSelTextDef; Result.Name := sHESelText; end; ciSelTextFocused: begin Result.Def := cSelTextFocusedDef; Result.Name := sHESelTextFocused; end; ciSeparators: begin Result.Def := cSeparatorsDef; Result.Name := sHESeparators; end; ciTextText: begin Result.Def := cTextTextDef; Result.Name := sHETextText; end; ciTextBkGnd: begin Result.Def := cTextBkgndDef; Result.Name := sHETextBkGnd; end; ciVertLines: begin Result.Def := cVertLinesDef; Result.Name := sHEVertLines; end; else Result := inherited GetColorSpec(Index); end; end; function TKHexEditorColors.InternalGetColor(Index: TKColorIndex): TColor; const AreaBkGndSet = [ciAddressBkgnd, ciDigitBkGnd, ciTextBkGnd]; BkGndSet = [ciAddressBkgnd, ciBkGnd, ciDigitBkGnd, ciInactiveCaretBkGnd, ciInactiveCaretSelBkGnd, ciSelBkGnd, ciSelBkGndFocused, ciTextBkgnd]; begin case FColorScheme of csGrayed: if Index in BkGndSet then Result := clWindow else Result := clGrayText; csBright: begin if FBrightColors[Index] = clNone then FBrightColors[Index] := BrightColor(FColors[Index], 0.5, bsOfTop); if FSingleBkGnd and (Index in AreaBkGndSet) then Result := FBrightColors[ciBkGnd] else Result := FBrightColors[Index]; end; csGrayScale: Result := ColorToGrayScale(FColors[Index]); else if FSingleBkGnd and (Index in AreaBkGndSet) then Result := FColors[ciBkGnd] else Result := FColors[Index]; end; end; function TKHexEditorColors.GetMaxIndex: Integer; begin Result := ciHexEditorColorsMax; end; { TKHexEditorChangeList } constructor TKHexEditorChangeList.Create(AEditor: TKCustomHexEditor; RedoList: TKHexEditorChangeList); begin inherited Create; FEditor := AEditor; FGroupUseLock := 0; FLimit := cUndoLimitDef; FIndex := -1; FModifiedIndex := FIndex; FRedoList := RedoList; FOnChange := nil; end; procedure TKHexEditorChangeList.AddChange(ItemReason: TKHexEditorChangeReason; const Data: AnsiString; Inserted: Boolean); var P: PKHexEditorChangeItem; begin // don't allow succesive crCaretPos if (ItemReason = crCaretPos) and not Inserted and (FIndex >= 0) and (PKHexEditorChangeItem(Items[FIndex]).ItemReason = crCaretPos) then Exit; if FIndex < FLimit - 1 then begin if FIndex < Count - 1 then Inc(FIndex) else FIndex := Add(New(PKHexEditorChangeItem)); P := Items[FIndex]; if FGroupUseLock > 0 then begin P.Group := FGroup; P.GroupReason := FGroupReason; end else begin P.Group := 0; P.GroupReason := ItemReason; end; P.ItemReason := ItemReason; P.EditArea := FEditor.EditArea; P.SelEnd := FEditor.SelEnd; P.SelStart := FEditor.SelStart; P.Data := Data; P.Inserted := Inserted; if FRedoList <> nil then FRedoList.Clear; if Assigned(FOnChange) then FOnChange(Self, ItemReason); end; end; procedure TKHexEditorChangeList.BeginGroup(GroupReason: TKHexEditorChangeReason); begin if FGroupUseLock = 0 then begin FGroupReason := GroupReason; Inc(FGroup); if FGroup = 0 then Inc(FGroup); end; Inc(FGroupUseLock); end; function TKHexEditorChangeList.CanPeek: Boolean; begin Result := FIndex >= 0; end; procedure TKHexEditorChangeList.Clear; begin inherited; FGroupUseLock := 0; FIndex := -1; FModifiedIndex := FIndex; end; procedure TKHexEditorChangeList.EndGroup; begin if FGroupUseLock > 0 then Dec(FGroupUseLock); end; function TKHexEditorChangeList.GetModified: Boolean; function CaretPosOnly: Boolean; var I: Integer; begin Result := True; for I := FModifiedIndex + 1 to FIndex do begin if PKHexEditorChangeItem(Items[I]).ItemReason <> crCaretPos then begin Result := False; Exit; end; end; end; begin Result := (FIndex > FModifiedIndex) and not CaretPosOnly; end; procedure TKHexEditorChangeList.Notify(Ptr: Pointer; Action: TListNotification); var P: PKHexEditorChangeItem; begin case Action of lnDeleted: if Ptr <> nil then begin P := Ptr; Dispose(P); end; end; end; function TKHexEditorChangeList.PeekItem: PKHexEditorChangeItem; begin if CanPeek then begin Result := Items[FIndex]; Dec(FIndex); end else Result := nil; end; procedure TKHexEditorChangeList.PokeItem; begin if FIndex < Count - 1 then Inc(FIndex); end; procedure TKHexEditorChangeList.SetGroupData(Group: Integer; GroupReason: TKHexEditorChangeReason); begin FGroup := Group; FGroupReason := GroupReason; FGroupUseLock := 1; end; procedure TKHexEditorChangeList.SetLimit(Value: Integer); begin if Value <> FLimit then begin FLimit := MinMax(Value, cUndoLimitMin, cUndoLimitMax); while Count > FLimit do Delete(0); FIndex := Min(FIndex, FLimit - 1); end; end; procedure TKHexEditorChangeList.SetModified(Value: Boolean); begin if not Value then FModifiedIndex := FIndex; end; { TKCustomHexEditor } constructor TKCustomHexEditor.Create(AOwner: TComponent); begin inherited Create(AOwner); Color := clWindow; ControlStyle := [csOpaque, csClickEvents, csDoubleClicks, csCaptureMouse]; Font.Name := cFontNameDef; Font.Style := cFontStyleDef; Font.Size := cFontSizeDef; Font.Pitch := fpFixed; Font.OnChange := FontChange; Height := cHeight; ParentColor := False; ParentFont := False; TabStop := True; Width := cWidth; FAddressCursor := cAddressCursorDef; FAddressMode := cAddressModeDef; FAddressOffset := cAddressOffsetDef; FAddressPrefix := cAddressPrefixDef; FAddressSize := cAddressSizeDef; FAreaSpacing := cAreaSpacingDef; FBuffer := nil; {$IFNDEF FPC} FClipBoardFormat := RegisterClipboardFormat('Any binary data'); {$ENDIF} FColors := TKHexEditorColors.Create(Self); FCharHeight := 8; FCharMapping := DefaultCharMapping; FCharSpacing := cCharSpacingDef; FCharWidth := 6; FDigitGrouping := cDigitGroupingDef; FDisabledDrawStyle := cEditDisabledDrawStyleDef; FDrawStyles := cDrawStylesDef; FEditArea := eaDigits; FInUpdateScrollRange := False; FLeftChar := 0; FLineHeightPercent := cLineHeightPercentDef; FLineSize := cLineSizeDef; FMouseWheelAccumulator := 0; FOptions := [eoGroupUndo]; FKeyMapping := TKEditKeyMapping.Create; FRedoList := TKHexEditorChangeList.Create(Self, nil); FScrollBars := ssBoth; FScrollSpeed := cScrollSpeedDef; FScrollTimer := TTimer.Create(Self); FScrollTimer.Enabled := False; FScrollTimer.Interval := FScrollSpeed; FScrollTimer.OnTimer := ScrollTimerHandler; FSelStart := MakeSelection(0, 0); FSelEnd := MakeSelection(0, 0); FStates := []; FTopLine := 0; FTotalCharSpacing := 0; FUndoList := TKHexEditorChangeList.Create(Self, FRedoList); FUndoList.OnChange := UndoChange; FOnChange := nil; FOnReplaceText := nil; UpdateCharMetrics; end; destructor TKCustomHexEditor.Destroy; begin inherited; FOnChange := nil; FColors.Free; FKeyMapping.Free; FUndoList.Free; FRedoList.Free; FreeMem(FBuffer); FBuffer := nil; end; procedure TKCustomHexEditor.AddUndoCaretPos(Force: Boolean); begin FUndoList.AddChange(crCaretPos, '', Force); end; procedure TKCustomHexEditor.AddUndoByte(ItemReason: TKHexEditorChangeReason; Data: Byte; Inserted: Boolean = True); begin FUndoList.AddChange(ItemReason, AnsiChar(Data), Inserted); end; procedure TKCustomHexEditor.AddUndoBytes(ItemReason: TKHexEditorChangeReason; Data: PBytes; Length: Integer; Inserted: Boolean = True); var S: AnsiString; begin if Length > 0 then begin SetLength(S, Length); Move(Data^, S[1], Length); FUndoList.AddChange(ItemReason, S, Inserted); end; end; procedure TKCustomHexEditor.AddUndoString(ItemReason: TKHexEditorChangeReason; const S: AnsiString; Inserted: Boolean = True); begin if S <> '' then FUndoList.AddChange(ItemReason, S, Inserted); end; procedure TKCustomHexEditor.Append(At: Integer; const Data: TDataSize); begin if (Data.Size > 0) and (Data.Data <> nil) then begin if At < 0 then At := FSize; InsertString(At, Data); end; end; procedure TKCustomHexEditor.Append(At: Integer; const Data: AnsiString); begin if Length(Data) > 0 then Append(At, MakeDataSize(@Data[1], Length(Data))); end; procedure TKCustomHexEditor.Assign(Source: TPersistent); begin if Source is TKCustomHexEditor then with Source as TKCustomHexEditor do begin Self.AddressCursor := AddressCursor; Self.AddressMode := AddressMode; Self.AddressPrefix := AddressPrefix; Self.AddressSize := AddressSize; Self.Align := Align; Self.Anchors := Anchors; Self.AutoSize := AutoSize; Self.BiDiMode := BiDiMode; Self.BorderStyle := BorderStyle; Self.BorderWidth := BorderWidth; Self.CharSpacing := CharSpacing; Self.Color := Color; Self.Colors := Colors; Self.Constraints.Assign(Constraints); {$IFNDEF FPC} Self.Ctl3D := Ctl3D; {$ENDIF} Self.Data := Data; Self.DigitGrouping := DigitGrouping; Self.DisabledDrawStyle := DisabledDrawStyle; Self.DragCursor := DragCursor; Self.DragKind := DragKind; Self.DragMode := DragMode; Self.DrawStyles := DrawStyles; Self.EditArea := EditArea; Self.Enabled := Enabled; Self.Font := Font; {$IFNDEF FPC} Self.ImeMode := ImeMode; Self.ImeName := ImeName; {$ENDIF} Self.KeyMapping.Assign(KeyMapping); Self.LineHeightPercent := LineHeightPercent; Self.LineSize := LineSize; Self.Modified := False; Self.Options := Options; Self.ParentBiDiMode := ParentBiDiMode; Self.ParentColor := ParentColor; {$IFNDEF FPC} Self.ParentCtl3D := ParentCtl3D; {$ENDIF} Self.ParentFont := ParentFont; Self.ParentShowHint := ParentShowHint; Self.PopupMenu := PopupMenu; Self.ScrollBars := ScrollBars; Self.SelEnd := SelEnd; Self.SelStart := SelStart; Self.SetCharMapping(GetCharMapping); Self.ShowHint := ShowHint; Self.TabOrder := TabOrder; Self.TabStop := TabStop; Self.Visible := Visible; end else inherited; end; procedure TKCustomHexEditor.BeginUndoGroup(GroupReason: TKHexEditorChangeReason); begin FUndoList.BeginGroup(GroupReason); end; procedure TKCustomHexEditor.BufferChanged; begin FUndoList.Clear; FRedoList.Clear; UpdateScrollRange; SelectionChanged(False); DoChange; end; function TKCustomHexEditor.CanScroll(Command: TKEditCommand): Boolean; var XMax, YMax: Integer; P: TKPoint64; AD: TKHExEditorAreaDimensions; begin AD := GetAreaDimensions; XMax := GetMaxLeftChar(AD.TotalHorz); YMax := GetMaxTopLine(AD.TotalVert); case Command of ecScrollUp: Result := FTopLine > 0; ecScrollDown: Result := FTopLine < YMax; ecScrollLeft: Result := FLeftChar > 0; ecScrollRight: Result := FLeftChar < XMax; ecScrollCenter: begin P := SelToPoint(FSelEnd, FEditArea); P.X := P.X - ClientWidth div 2; P.Y := P.Y - ClientHeight div 2; Result := (FLeftChar > 0) and (P.X < 0) or (FLeftChar < XMax) and (P.X > FCharWidth) or (FTopLine > 0) and (P.Y < 0) or (FTopLine < YMax) and (P.Y > FCharHeight); end; else Result := False; end; end; function TKCustomHexEditor.CaretInView: Boolean; begin Result := Pt64InRect(GetModifiedClientRect, SelToPoint(FSelEnd, FEditArea)); end; procedure TKCustomHexEditor.Clear; begin if FBuffer <> nil then begin FreeMem(FBuffer); FBuffer := nil; FSize := 0; BufferChanged; end; end; procedure TKCustomHexEditor.ClearChar(At: Integer); begin ClearString(At, 1); end; procedure TKCustomHexEditor.ClearDigitSelection; begin FSelStart.Digit := 0; FSelEnd.Digit := 0; end; procedure TKCustomHexEditor.ClearString(At, Size: Int64); begin if (FBuffer <> nil) and (Size > 0) and (At >= 0) and (At + Size <= FSize) then begin Move(FBuffer[At + Size], FBuffer[At], (FSize - At - Size) * SizeOf(Byte)); Dec(FSize, Size); ReallocMem(FBuffer, FSize); UpdateScrollRange; Invalidate; end; end; procedure TKCustomHexEditor.ClearUndo; begin FUndoList.Clear; FRedoList.Clear; end; procedure TKCustomHexEditor.CMEnabledChanged(var Msg: TLMessage); begin inherited; UpdateEditorCaret; Invalidate; end; procedure TKCustomHexEditor.CMSysColorChange(var Msg: TLMessage); begin inherited; FColors.ClearBrightColors; end; function TKCustomHexEditor.CommandEnabled(Command: TKEditCommand): Boolean; var L: TKHexEditorSelection; begin if Enabled and Visible and not (csDesigning in ComponentState) then begin L := SelLength; case Command of // movement commands ecLeft, ecSelLeft: Result := (FSelEnd.Index > 0) or (FEditArea = eaDigits) and (FSelEnd.Digit > 0); ecRight, ecSelRight: Result := (FEditArea <> eaNone) and (FSelEnd.Index < FSize); ecUp, ecSelUp: Result := FSelEnd.Index >= FLineSize; ecDown, ecSelDown: Result := (FEditArea <> eaNone) and (FSelEnd.Index < FSize); ecLineStart, ecSelLineStart: Result := (FEditArea <> eaNone) and (FSelEnd.Index mod FLineSize > 0); ecLineEnd, ecSelLineEnd: Result := (FEditArea <> eaNone) and (FSelEnd.Index mod FLineSize < Min(FLineSize - 1, FSize)); ecPageUp, ecSelPageUp: Result := FSelEnd.Index >= FlineSize; ecPageDown, ecSelPageDown: Result := (FEditArea <> eaNone) and (FSelEnd.Index < FSize div FLineSize * FLineSize); ecPageLeft, ecSelPageLeft: Result := (FEditArea <> eaNone) and (GetPageHorz > 0) and (FSelEnd.Index mod FLineSize > 0); ecPageRight, ecSelPageRight: Result := (FEditArea <> eaNone) and (GetPageHorz > 0) and (FSelEnd.Index mod FLineSize < Min(FLineSize - 1, FSize)); ecPageTop, ecSelPageTop: Result := (FEditArea <> eaNone) and (FSelEnd.Index > 0) and (SelToPoint(MakeSelection(FSelEnd.Index, 0), FEditArea).Y div FCharHeight <> 0); ecPageBottom, ecSelPageBottom: Result := (FEditArea <> eaNone) and (FSelEnd.Index < FSize) and ((ClientHeight - SelToPoint(MakeSelection(FSelEnd.Index, 0), FEditArea).Y) div FCharHeight - 1 <> 0); ecEditorTop, ecSelEditorTop: Result := FSelEnd.Index > 0; ecEditorBottom, ecSelEditorBottom: Result := (FEditArea <> eaNone) and (FSelEnd.Index < FSize); ecGotoXY, ecSelGotoXY: Result := True; // scroll commands ecScrollUp, ecScrollDown, ecScrollLeft, ecScrollRight, ecScrollCenter: Result := CanScroll(Command); // editing commands ecUndo: Result := not ReadOnly and FUndoList.CanPeek; ecRedo: Result := not ReadOnly and FRedoList.CanPeek; ecCopy, ecCut: Result := not Empty and (not ReadOnly or (Command = ecCopy)) and ((L.Index <> 0) or (L.Digit <> 0)); ecPaste: Result := not ReadOnly and (FEditArea <> eaNone) and (ClipBoard.FormatCount > 0); ecInsertChar: Result := not ReadOnly and (FEditArea <> eaNone); ecInsertDigits: Result := not ReadOnly and (FEditArea = eaDigits); ecInsertString: Result := not ReadOnly and (FEditArea <> eaNone); ecDeleteLastChar: Result := not (Empty or ReadOnly) and (FEditArea <> eaNone) and ((L.Index > 0) or (FSelEnd.Index > 0)); ecDeleteChar: Result := not (Empty or ReadOnly) and (FEditArea <> eaNone) and ((L.Index > 0) or (FSelEnd.Index < FSize)); ecDeleteBOL: Result := not (Empty or ReadOnly) and (FEditArea <> eaNone) and ((L.Index > 0) or (FSelEnd.Index mod FLineSize > 0)); ecDeleteEOL: Result := not (Empty or ReadOnly) and (FEditArea <> eaNone) and ((L.Index > 0) or (FSelEnd.Index mod FLineSize < Min(FLineSize, FSize))); ecDeleteLine: Result := not (Empty or ReadOnly) and (FEditArea <> eaNone) and ((L.Index > 0) or (FSelEnd.Index mod FLineSize > 0) or (FSelEnd.Index < FSize)); ecSelectAll: Result := not (Empty or ReadOnly) and (FEditArea <> eaNone); ecClearAll: Result := not (Empty or ReadOnly) and (FEditArea <> eaNone); ecClearIndexSelection, ecClearSelection: Result := not (Empty or ReadOnly) and (FEditArea <> eaNone) and (L.Index > 0); ecSearch: Result := not Empty; ecReplace: Result := not (Empty or ReadOnly); ecInsertMode: Result := elOverwrite in FStates; ecOverwriteMode: Result := not (elOverwrite in FStates); else Result := True; end; end else Result := False; end; procedure TKCustomHexEditor.CreateParams(var Params: TCreateParams); begin inherited; with Params do begin if FScrollBars in [ssVertical, ssBoth] then Style := Style or WS_VSCROLL; if FScrollBars in [ssHorizontal, ssBoth] then Style := Style or WS_HSCROLL; end; end; procedure TKCustomHexEditor.CreateWnd; begin inherited; {$IFDEF MSWINDOWS} if (eoDropFiles in FOptions) and not (csDesigning in ComponentState) then DragAcceptFiles(Handle, TRUE); {$ENDIF} end; procedure TKCustomHexEditor.DestroyWnd; begin {$IFDEF MSWINDOWS} if (eoDropFiles in FOptions) and not (csDesigning in ComponentState) then DragAcceptFiles(Handle, FALSE); {$ENDIF} inherited; end; procedure TKCustomHexEditor.DoChange; begin if Assigned(FOnChange) then FOnChange(Self); end; function TKCustomHexEditor.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean; const WHEEL_DIVISOR = 120; var LinesToScroll, WheelClicks: Integer; begin Result := inherited DoMouseWheel(Shift, WheelDelta, MousePos); if not Result then begin if ssCtrl in Shift then LinesToScroll := GetModifiedClientRect.Bottom div FCharHeight else LinesToScroll := 3; Inc(FMouseWheelAccumulator, WheelDelta); WheelClicks := FMouseWheelAccumulator div WHEEL_DIVISOR; FMouseWheelAccumulator := FMouseWheelAccumulator mod WHEEL_DIVISOR; ScrollBy(0, - WheelClicks * LinesToScroll, True); Result := True; end; end; procedure TKCustomHexEditor.EditAreaChanged; begin if FEditArea = eaNone then FEditArea := eaDigits; if not (edAddress in FDrawStyles) and (FEditArea = eaAddress) then FEditArea := eaDigits; if not (edDigits in FDrawStyles) and (FEditArea = eaDigits) then FEditArea := eaText; if not (edText in FDrawStyles) and (FEditArea = eaText) then if edDigits in FDrawStyles then FEditArea := eaDigits else FEditArea := eaNone; end; procedure TKCustomHexEditor.EndUndoGroup; begin FUndoList.EndGroup; end; function TKCustomHexEditor.ExecuteCommand(Command: TKEditCommand; Data: Pointer): Boolean; var I, J, K, O, N, SLen: Integer; Count, Index, Size, StartIndex, EndIndex: Int64; B: Byte; CanInsert, MoreBytes, Found, MatchCase: Boolean; C1, C2, C3: AnsiChar; S, S_FirstChar, S_LastChar, T: AnsiString; P: TKPoint64; Area: TKHexEditorArea; L, OldSelStart, OldSelEnd, Sel1, Sel2: TKHexEditorSelection; PChI, PChI_First, PChI_Next: PKHexEditorChangeItem; PSD: PKEditSearchData; ReplaceAction: TKEditReplaceAction; {$IFNDEF FPC} BA: PBytes; H: THandle; {$ENDIF} begin Result := False; if CommandEnabled(Command) then begin Result := True; L := SelLength; OldSelEnd := FSelEnd; OldSelStart := FSelStart; case Command of ecLeft..ecSelGotoXY: AddUndoCaretPos(False); end; case Command of ecLeft, ecSelLeft: begin InternalMoveLeft; SelectionChanged(Command <> ecSelLeft); end; ecRight, ecSelRight: begin InternalMoveRight; SelectionChanged(Command <> ecSelRight); end; ecUp, ecSelUp: begin Dec(FSelEnd.Index, FLineSize); SelectionChanged(Command <> ecSelUp); end; ecDown, ecSelDown: begin Inc(FSelEnd.Index, FLineSize); SelectionChanged(Command <> ecSelDown); end; ecLineStart, ecSelLineStart: begin FSelEnd := MakeSelection((FSelEnd.Index div FLineSize) * FLineSize, 0); SelectionChanged(Command <> ecSelLineStart); end; ecLineEnd, ecSelLineEnd: begin FSelEnd := MakeSelection((FSelEnd.Index div FLineSize) * FLineSize + FLineSize - 1, cHexDigitCount - 1); SelectionChanged(Command <> ecSelLineEnd); end; ecPageUp, ecSelPageUp: begin Dec(FSelEnd.Index, Min(ClientHeight div FCharHeight, FSelEnd.Index div FLineSize) * FLineSize); SelectionChanged(Command <> ecSelPageUp); end; ecPageDown, ecSelPageDown: begin Inc(FSelEnd.Index, Min(ClientHeight div FCharHeight, (FSize - FSelEnd.Index) div FLineSize) * FLineSize); SelectionChanged(Command <> ecSelPageDown); end; ecPageLeft, ecSelPageLeft: begin Dec(FSelEnd.Index, Min(GetPageHorz, FSelEnd.Index mod FLineSize)); SelectionChanged(Command <> ecSelPageLeft); end; ecPageRight, ecSelPageRight: begin Inc(FSelEnd.Index, Min(GetPageHorz, FLineSize - 1 - FSelEnd.Index mod FLineSize)); SelectionChanged(Command <> ecSelPageRight); end; ecPageTop, ecSelPageTop: begin P := SelToPoint(MakeSelection(FSelEnd.Index, 0), FEditArea); Dec(FSelEnd.Index, P.Y div FCharHeight * FLineSize); SelectionChanged(Command <> ecSelPageTop); end; ecPageBottom, ecSelPageBottom: begin P := SelToPoint(MakeSelection(FSelEnd.Index, 0), FEditArea); Inc(FSelEnd.Index, ((ClientHeight - P.Y) div FCharHeight - 1) * FLineSize); SelectionChanged(Command <> ecSelPageBottom); end; ecEditorTop, ecSelEditorTop: begin FSelEnd := MakeSelection(0, 0); SelectionChanged(Command <> ecSelEditorTop); end; ecEditorBottom, ecSelEditorBottom: begin FSelEnd := MakeSelection(FSize, 0); SelectionChanged(Command <> ecSelEditorBottom); end; ecGotoXY, ecSelGotoXY: begin Sel1 := PointToSel(PKPoint64(Data)^, False, Area); if Area <> eaNone then begin FSelEnd := Sel1; FEditArea := Area; SelectionChanged(Command <> ecSelGotoXY); end else Result := False; end; // scroll commands ecScrollUp: begin if (FEditArea <> eaNone) and (SelToPoint(FSelEnd, FEditArea).Y >= GetModifiedClientRect.Bottom - FCharHeight) then begin ScrollBy(0, -1, False); Dec(FSelEnd.Index, FLineSize); SelectionChanged(True, False); Invalidate; end else ScrollBy(0, -1, True); end; ecScrollDown: begin if (FEditArea <> eaNone) and (SelToPoint(FSelEnd, FEditArea).Y <= GetModifiedClientRect.Top) then begin ScrollBy(0, 1, False); Inc(FSelEnd.Index, FLineSize); SelectionChanged(True, False); Invalidate; end else ScrollBy(0, 1, True); end; ecScrollLeft: begin if FEditArea <> eaNone then begin // overscroll check P := SelToPoint(MakeSelection(0, 0), FEditArea); if P.X < GetModifiedClientRect.Right - FCharWidth then begin ScrollBy(-1, 0, True); P := SelToPoint(FSelEnd, FEditArea); if (P.X >= GetModifiedClientRect.Right) and ((FSelEnd.Index mod FLineSize > 0) or (FSelEnd.Digit > 0)) then ExecuteCommand(ecLeft) end; end else ScrollBy(-1, 0, True); end; ecScrollRight: begin if FEditArea <> eaNone then begin // overscroll check P := SelToPoint(MakeSelection(FLineSize - 1, cHexDigitCount - 1), FEditArea); if P.X > 0 then begin ScrollBy(1, 0, True); P := SelToPoint(FSelEnd, FEditArea); if (P.X < 0) and ((FSelEnd.Index mod FLineSize < FLineSize - 1) or (FSelEnd.Digit < cHexDigitCount - 1)) then ExecuteCommand(ecRight) end; end else ScrollBy(1, 0, True); end; ecScrollCenter: begin P := SelToPoint(FSelEnd, FEditArea); I := (P.X - ClientWidth div 2) div FCharWidth; J := (P.Y - ClientHeight div 2) div FCharHeight; ScrollBy(I, J, True); end; // editing commands ecUndo: begin PChI := FUndoList.PeekItem; PChI_First := PChI; while PChI <> nil do begin Size := Length(PChI.Data); Count := Min(Size, FSize - PChI.SelEnd.Index); FRedoList.SetGroupData(PChI.Group, PChI.GroupReason); case PChI.ItemReason of crCaretPos: FRedoList.AddChange(crCaretPos, ''); crDeleteChar, crDeleteDigits, crDeleteString: begin if FBuffer <> nil then begin SetLength(S, Count); System.Move(FBuffer[PChI.SelEnd.Index], S[1], Count); end else S := ''; FRedoList.AddChange(OppositeReason(PChI.ItemReason), S, PChI.Inserted); end; crInsertChar, crInsertDigits, crInsertString: FRedoList.AddChange(OppositeReason(PChI.ItemReason), PChI.Data); end; FSelEnd := PChI.SelEnd; FSelStart := PChI.SelStart; FEditArea := PChI.EditArea; case PChI.ItemReason of crDeleteChar, crDeleteDigits, crDeleteString: begin if PChI.Inserted then ClearString(PChI.SelEnd.Index, Size) else if FBuffer <> nil then begin System.Move(PChI.Data[1], FBuffer[PChI.SelEnd.Index], Count); Invalidate; end; end; crInsertChar, crInsertDigits, crInsertString: InsertString(GetRealSelStart.Index, PChI.Data); end; EditAreaChanged; SelectionChanged(False, False); if PChI.ItemReason <> crCaretPos then DoChange; PChI_Next := FUndoList.PeekItem; if (PChI_Next <> nil) and not ((PChI.Group <> 0) and (PChI.Group = PChI_Next.Group) or (eoGroupUndo in FOptions) and (PChI_First.GroupReason = PChI_Next.GroupReason)) then begin FUndoList.PokeItem; Break; end; PChI := PChI_Next; end; if not CaretInView then ExecuteCommand(ecScrollCenter); end; ecRedo: begin PChI := FRedoList.PeekItem; PChI_First := PChI; while PChI <> nil do begin FUndoList.PokeItem; Size := Length(PChI.Data); Sel1 := GetRealSelStart; case PChI.ItemReason of crInsertChar, crInsertDigits, crInsertString: begin if PChI.Inserted then InsertString(Sel1.Index, PChI.Data) else if FBuffer <> nil then begin System.Move(PChI.Data[1], FBuffer[Sel1.Index], Min(Size, FSize - FSelEnd.Index)); Invalidate; end; end; crDeleteChar, crDeleteDigits, crDeleteString: ClearString(Sel1.Index, Size); end; FSelEnd := PChI.SelEnd; FSelStart := PChI.SelStart; FEditArea := PChI.EditArea; EditAreaChanged; SelectionChanged(False, False); if PChI.ItemReason <> crCaretPos then DoChange; PChI_Next := FRedoList.PeekItem; if (PChI_Next <> nil) and not ((PChI.Group <> 0) and (PChI.Group = PChI_Next.Group) or (eoGroupUndo in FOptions) and (PChI_First.GroupReason = PChI_Next.GroupReason)) then begin FRedoList.PokeItem; Break; end; PChI := PChI_Next; end; if not CaretInView then ExecuteCommand(ecScrollCenter); end; ecCopy: begin Sel1 := GetRealSelStart; Sel2 := GetRealSelEnd; {$IFDEF FPC} ClipBoard.AsText := string(BinaryToDigits(FBuffer, Sel1, Sel2)) {$ELSE} if FEditArea = eaDigits then ClipBoard.AsText := string(BinaryToDigits(FBuffer, Sel1, Sel2)) else if L.Index <> 0 then begin S := BinaryToText(FBuffer, Sel1.Index, Sel2.Index, @FCharMapping); H := GlobalAlloc(GMEM_MOVEABLE + GMEM_DDESHARE, L.Index); try BA := GlobalLock(H); try System.Move(FBuffer[Sel1.Index], BA^, L.Index); finally GlobalUnlock(H); end; ClipBoard.Open; try ClipBoard.SetAsHandle(FClipboardFormat, H); ClipBoard.AsText := string(S); finally ClipBoard.Close; end; except GlobalFree(H); end; end; {$ENDIF} end; ecCut: begin ExecuteCommand(ecCopy); ExecuteCommand(ecClearSelection); end; ecPaste: begin if L.Index > 0 then ExecuteCommand(ecClearSelection); if ClipBoard.FormatCount > 0 then begin S := ''; {$IFNDEF FPC} H := 0; // paste as binary data if ClipBoard.HasFormat(FClipboardFormat) then H := ClipBoard.GetAsHandle(FClipboardFormat) else {$ENDIF} if ClipBoard.HasFormat(CF_TEXT) then begin S := AnsiString(ClipBoard.AsText); if S <> '' then begin SLen := Length(S); if (FEditArea = eaDigits) and ExecuteCommand(ecInsertDigits, Pointer(S)) then begin S := ''; if SLen >= cHexDigitCount then begin Inc(FSelEnd.Index, SLen div cHexDigitCount) end else begin Inc(FSelEnd.Digit, SLen); if FSelEnd.Digit >= cHexDigitCount then begin Inc(FSelEnd.Index); FSelEnd.Digit := FSelEnd.Digit mod cHexDigitCount; end; end; SelectionChanged(True); end else ExecuteCommand(ecInsertString, Pointer(S)); end; end {$IFNDEF FPC} else H := ClipBoard.GetAsHandle(ClipBoard.Formats[0]); if H <> 0 then begin BA := GlobalLock(H); try I := GlobalSize(H); if I > 0 then begin SetLength(S, I); System.Move(BA^, S[1], I); end; finally GlobalUnlock(H); end; if S <> '' then ExecuteCommand(ecInsertString, Pointer(S)); end {$ENDIF} ; if S <> '' then begin Inc(FSelEnd.Index, Length(S)); FSelEnd.Digit := 0; SelectionChanged(True); end; end; end; ecInsertChar: begin BeginUndoGroup(crInsertChar); try N := PInteger(Data)^; if L.Index > 0 then ExecuteCommand(ecClearSelection); ValidateSelection(FSelEnd, FEditArea); if FBuffer <> nil then B := FBuffer[FSelEnd.Index] else B := 0; CanInsert := (FBuffer = nil) or (FSelEnd.Digit = 0) and (not (elOverwrite in FStates) or (FSelEnd.Index = FSize)); AddUndoByte(crDeleteChar, B, CanInsert); if CanInsert then InsertChar(FSelEnd.Index, 0) else Invalidate; case FEditArea of eaDigits: begin FBuffer[FSelEnd.Index] := ReplaceDigit(FBuffer[FSelEnd.Index], N, FSelEnd.Digit); InternalMoveRight; end; eaText: begin FBuffer[FSelEnd.Index] := Byte(N); InternalMoveRight; end; end; SelectionChanged(True); finally EndUndoGroup; end; end; ecInsertDigits: begin S := AnsiString(Data); if (S <> '') and DigitsToBinStr(S) then begin BeginUndoGroup(crInsertDigits); try if L.Index > 0 then ExecuteCommand(ecClearSelection); ValidateSelection(FSelEnd, FEditArea); MoreBytes := Length(S) >= cHexDigitCount; if MoreBytes then // we don't move digit positions of the remaining block SetLength(S, Length(S) div cHexDigitCount * cHexDigitCount); J := 0; if (FBuffer <> nil) and (not MoreBytes or (FSelEnd.Digit > 0)) then begin B := FBuffer[FSelEnd.Index]; S_FirstChar := AnsiChar(B); S_LastChar := S_FirstChar; // split current byte AddUndoByte(crInsertChar, B); ClearChar(FSelEnd.Index); N := Length(S); for I := FSelEnd.Digit to cHexDigitCount - 1 do begin if J < N then begin Inc(J); S_FirstChar := AnsiChar(ReplaceDigit(Ord(S_FirstChar[1]), Ord(S[J]), I)); end else Break; end; K := Length(S); if K > J then for I := FSelEnd.Digit - 1 downto 0 do begin if K > J then begin S_LastChar := AnsiChar(ReplaceDigit(Ord(S_LastChar[1]), Ord(S[K]), I)); Dec(K); end else Break; end else S_LastChar := ''; O := cHexDigitCount; end else begin S_FirstChar := ''; S_LastChar := ''; O := 0; end; T := ''; if MoreBytes then begin N := Length(S) - O; O := J; for I := 0 to N div cHexDigitCount - 1 do begin K := 0; for J := 1 to cHexDigitCount do begin K := K * cHexBase; Inc(K, Ord(S[I * 2 + J + O])); end; T := AnsiString(Format('%s%s', [T, AnsiChar(K)])); end; end; S := S_FirstChar + T + S_LastChar; // always insert (don't overwrite) AddUndoString(crDeleteDigits, S); InsertString(FSelEnd.Index, S); SelectionChanged(True); finally EndUndoGroup; end; end else Result := False; end; ecInsertString: begin S := AnsiString(Data); if S <> '' then begin BeginUndoGroup(crInsertString); try if L.Index > 0 then ExecuteCommand(ecClearIndexSelection); // always insert (don't overwrite) AddUndoString(crDeleteString, S); InsertString(FSelEnd.Index, S); SelectionChanged(True); finally EndUndoGroup; end; end else Result := False; end; ecDeleteLastChar: begin if L.Index <> 0 then ExecuteCommand(ecClearSelection) else begin BeginUndoGroup(crDeleteString); try AddUndoCaretPos; FSelStart.Index := FSelEnd.Index - 1; ExecuteCommand(ecClearIndexSelection) finally EndUndoGroup; end; end; end; ecDeleteChar: begin if L.Index <> 0 then ExecuteCommand(ecClearSelection) else begin BeginUndoGroup(crDeleteString); try AddUndoCaretPos; FSelStart.Index := FSelEnd.Index + 1; ExecuteCommand(ecClearIndexSelection) finally EndUndoGroup; end; end; end; ecDeleteBOL: begin if L.Index <> 0 then ExecuteCommand(ecClearSelection) else begin BeginUndoGroup(crDeleteString); try AddUndoCaretPos; FSelStart.Index := (FSelEnd.Index div FLineSize) * FLineSize; ExecuteCommand(ecClearIndexSelection) finally EndUndoGroup; end; end; end; ecDeleteEOL: begin if L.Index <> 0 then ExecuteCommand(ecClearSelection) else begin BeginUndoGroup(crDeleteString); try AddUndoCaretPos; FSelStart.Index := Min((FSelEnd.Index div FLineSize + 1) * FLineSize, FSize); ExecuteCommand(ecClearIndexSelection) finally EndUndoGroup; end; end; end; ecDeleteLine: begin if L.Index <> 0 then ExecuteCommand(ecClearSelection) else begin BeginUndoGroup(crDeleteString); try AddUndoCaretPos; FSelStart.Index := (FSelEnd.Index div FLineSize) * FLineSize; FSelEnd.Index := Min(FSelStart.Index + FLineSize, FSize); ExecuteCommand(ecClearIndexSelection) finally EndUndoGroup; end; end; end; ecSelectAll: begin AddUndoCaretPos; FSelStart := MakeSelection(0, 0); FSelEnd := MakeSelection(FSize, 0); SelectionChanged(False); end; ecClearAll: begin ExecuteCommand(ecSelectAll); ExecuteCommand(ecClearIndexSelection); end; ecClearIndexSelection: begin Index := GetRealSelStart.Index; AddUndoBytes(crInsertString, PBytes(@FBuffer[Index]), L.Index, True); ClearString(Index, L.Index); FSelEnd := MakeSelection(Index, 0); SelectionChanged(True); end; ecClearSelection: begin Sel1 := GetRealSelStart; Sel2 := GetRealSelEnd; if (Sel1.Digit > 0) {and (Sel1.Digit + Sel2.Digit = cHexDigitCount) }then begin BeginUndoGroup(crDeleteDigits); try // digit clear mode AddUndoCaretPos; FSelEnd := MakeSelection(Sel1.Index + 1, 0); FSelStart := FSelEnd; if Sel2.Digit = 0 then begin Dec(L.Index); N := FBuffer[Sel2.Index - 1]; end else N := FBuffer[Sel2.Index]; AddUndoBytes(crInsertDigits, PBytes(@FBuffer[FSelEnd.Index]), L.Index, True); ClearString(FSelEnd.Index, L.Index); FSelEnd := Sel1; AddUndoByte(crDeleteChar, FBuffer[Sel1.Index], False); for I := Sel1.Digit to cHexDigitCount - 1 do begin FBuffer[Sel1.Index] := ReplaceDigit(FBuffer[Sel1.Index], N mod cHexBase, I); N := N div cHexBase; end; SelectionChanged(True); finally EndUndoGroup; end; end else ExecuteCommand(ecClearIndexSelection); end; ecSearch, ecReplace: begin // doesn't search for single digits PSD := Data; if PSD <> nil then begin PSD.ErrorReason := eseOk; S := AnsiString(PSD.TextToFind); if Command = ecReplace then begin T := AnsiString(PSD.TextToReplace); ReplaceAction := eraYes; end; if esoSelectedOnly in PSD.Options then if esoFirstSearch in PSD.Options then begin PSD.SelStart := GetRealSelStart.Index; PSD.SelEnd := GetRealSelEnd.Index; end else begin PSD.SelStart := MinMax(PSD.SelStart, 0, FSize); PSD.SelEnd := MinMax(PSD.SelEnd, 0, FSize); end; if esoFirstSearch in PSD.Options then Exclude(PSD.Options, esoWereDigits); if esoTreatAsDigits in PSD.Options then begin if DigitsToBinStr(S) then begin S := BinStrToBinary(S); if Command = ecReplace then begin if DigitsToBinStr(T) then begin T := BinStrToBinary(T); PSD.TextToFind := string(S); PSD.TextToReplace := string(T); Exclude(PSD.Options, esoTreatAsDigits); Include(PSD.Options, esoWereDigits); end else PSD.ErrorReason := eseNoDigitsReplace; end else begin PSD.TextToFind := string(S); Exclude(PSD.Options, esoTreatAsDigits); Include(PSD.Options, esoWereDigits); end; end else PSD.ErrorReason := eseNoDigitsFind; end; if PSD.ErrorReason = eseOk then begin SLen := Length(S); if esoBackwards in PSD.Options then begin O := -1; if (esoEntireScope in PSD.Options) and (esoFirstSearch in PSD.Options) then StartIndex := FSize else StartIndex := GetRealSelStart.Index - 1; if esoSelectedOnly in PSD.Options then begin EndIndex := PSD.SelStart; if esoFirstSearch in PSD.Options then StartIndex := PSD.SelEnd end else EndIndex := 0; StartIndex := Min(StartIndex, FSize - SLen + 1); if StartIndex < EndIndex then PSD.ErrorReason := eseNoMatch end else begin O := 1; if (esoEntireScope in PSD.Options) and (esoFirstSearch in PSD.Options) then StartIndex := 0 else StartIndex := GetRealSelEnd.Index; if esoSelectedOnly in PSD.Options then begin EndIndex := PSD.SelEnd; if esoFirstSearch in PSD.Options then StartIndex := PSD.SelStart end else EndIndex := FSize; EndIndex := Min(EndIndex, FSize - SLen + 1); if StartIndex >= EndIndex then PSD.ErrorReason := eseNoMatch end; if PSD.ErrorReason = eseOk then begin Found := False; MatchCase := PSD.Options * [esoMatchCase, esoWereDigits] <> []; if MatchCase then C1 := S[1] else C1 := UpCase(S[1]); StartIndex := MinMax(StartIndex, 0, FSize - 1); while StartIndex <> EndIndex do begin if MatchCase then C2 := AnsiChar(FBuffer[StartIndex]) else C2 := UpCase(AnsiChar(FBuffer[StartIndex])); if C1 = C2 then begin if FSize - StartIndex >= SLen then begin J := 2; Dec(StartIndex); while (J <= SLen) do begin if MatchCase then begin C2 := AnsiChar(FBuffer[StartIndex + J]); C3 := S[J]; end else begin C2 := Upcase(AnsiChar(FBuffer[StartIndex + J])); C3 := Upcase(S[J]); end; if C2 = C3 then Inc(J) else Break; end; Inc(StartIndex); if J = SLen + 1 then begin Found := True; FSelStart := MakeSelection(StartIndex, 0); FSelEnd := MakeSelection(StartIndex + SLen, 0); if Command = ecReplace then begin if (esoPrompt in PSD.Options) and Assigned(FOnReplaceText) then begin SelectionChanged(False, False); if not CaretInView then ExecuteCommand(ecScrollCenter); FOnReplaceText(Self, string(S), string(T), ReplaceAction) end else ReplaceAction := eraYes; case ReplaceAction of eraCancel: Break; eraYes, eraAll: begin if T = '' then ExecuteCommand(ecClearIndexSelection) else ExecuteCommand(ecInsertString, Pointer(T)); FSelEnd := MakeSelection(StartIndex + Length(T), 0); AddUndoCaretPos; if ReplaceAction = eraAll then Include(PSD.Options, esoAll); end; end; if not (esoAll in PSD.Options) then Break; end else Break; end end; end; Inc(StartIndex, O); end; if Found then begin SelectionChanged(False, False); if not CaretInView then ExecuteCommand(ecScrollCenter); end else PSD.ErrorReason := eseNoMatch; end; end; Exclude(PSD.Options, esoFirstSearch); end else Result := False; end; ecInsertMode: begin Exclude(FStates, elOverwrite); UpdateEditorCaret(True); end; ecOverwriteMode: begin Include(FStates, elOverwrite); UpdateEditorCaret(True); end; ecToggleMode: begin if elOverwrite in FStates then Exclude(FStates, elOverwrite) else Include(FStates, elOverwrite); UpdateEditorCaret(True); end; // focus change ecGotFocus, ecLostFocus: begin UpdateEditorCaret; Invalidate; end; end; if (OldSelStart.Index <> OldSelEnd.Index) or (FSelStart.Index <> FSelEnd.Index) or (OldSelStart.Digit <> OldSelEnd.Digit) or (FSelStart.Digit <> FSelEnd.Digit) or not (elCaretVisible in FStates) and (edInactiveCaret in FDrawStyles) and ((FSelStart.Index <> OldSelStart.Index) or (FSelStart.Digit <> OldSelStart.Digit) or (FSelEnd.Index <> OldSelEnd.Index) or (FSelEnd.Digit <> OldSelEnd.Digit)) then Invalidate; end; end; procedure TKCustomHexEditor.FontChange(Sender: TObject); begin if not (csDestroying in ComponentState) then begin Font.Pitch := fpFixed; if Font.Size >= 0 then Font.Size := MinMax(Font.Size, cFontSizeMin, cFontSizeMax); UpdateCharMetrics; UpdateScrollRange; end; end; function TKCustomHexEditor.GetAreaDimensions: TKHexEditorAreaDimensions; begin FillChar(Result, SizeOf(Result), 0); with Result do begin if edAddress in FDrawStyles then begin Address := Length(FAddressPrefix) + FAddressSize; if FDrawStyles * [edDigits, edText] <> [] then AddressOut := FAreaSpacing; end; if edDigits in FDrawStyles then begin Digits := FLineSize * cHexDigitCount + FLineSize div FDigitGrouping; if FLineSize mod FDigitGrouping = 0 then Dec(Digits); if edAddress in FDrawStyles then DigitsIn := FAreaSpacing; if edText in FDrawStyles then DigitsOut := FAreaSpacing; end; if edText in FDrawStyles then begin Text := FLineSize; if FDrawStyles * [edAddress, edDigits] <> [] then TextIn := FAreaSpacing; end; TotalHorz := Address + AddressOut + Digits + DigitsIn + DigitsOut + Text + TextIn; if [edAddress, edDigits, edText] * FDrawStyles <> [] then TotalVert := LineCount else TotalVert := 0; end; end; function TKCustomHexEditor.GetCaretVisible: Boolean; begin Result := elCaretVisible in FStates; end; function TKCustomHexEditor.GetCharMapping: TKEditCharMapping; begin Result := FCharMapping; end; function TKCustomHexEditor.GetClientHeightChars: Integer; begin Result := ClientHeight div FCharHeight; end; function TKCustomHexEditor.GetClientWidthChars: Integer; begin Result := ClientWidth div FCharWidth; end; function TKCustomHexEditor.GetCommandKey(Index: TKEditCommand): TKEditKey; begin Result := FKeyMapping.Key[Index]; end; function TKCustomHexEditor.GetData: TDataSize; begin Result.Data := FBuffer; Result.Size := FSize; end; function TKCustomHexEditor.GetEmpty: Boolean; begin Result := FBuffer = nil; end; function TKCustomHexEditor.GetFirstVisibleIndex: Integer; begin Result := PointToSel(CreateEmptyPoint64, False, FEditArea).Index; end; function TKCustomHexEditor.GetInsertMode: Boolean; begin Result := not (elOverwrite in FStates); end; function TKCustomHexEditor.GetLastVisibleIndex: Integer; begin Result := PointToSel(PointToPoint64(GetModifiedClientRect.BottomRight), False, FEditArea).Index; end; function TKCustomHexEditor.GetLineCount: Int64; begin Result := DivUp64(FSize + 1, FLineSize); end; function TKCustomHexEditor.GetLines(Index: Int64): TDataSize; var I: Int64; begin I := Index * FLineSize; if (FBuffer <> nil) and (I >= 0) and (I < FSize) then begin Result.Data := @FBuffer[I]; Result.Size := Min(FLineSize, FSize - I); end else begin Result.Data := nil; Result.Size := 0; end; end; function TKCustomHexEditor.GetModified: Boolean; begin Result := (elModified in FStates) or FUndoList.Modified; end; function TKCustomHexEditor.GetModifiedClientRect: TRect; begin Result := Rect(0, 0, GetClientWidthChars * FCharWidth, GetClientHeightChars * FCharHeight); end; function TKCustomHexEditor.GetMaxLeftChar(Extent: Integer): Integer; begin if Extent <= 0 then Extent := GetAreaDimensions.TotalHorz; Result := Max(Extent - GetClientWidthChars, 0); end; function TKCustomHexEditor.GetMaxTopLine(Extent: Int64): Int64; begin if Extent <= 0 then Extent := GetAreaDimensions.TotalVert; Result := Max(Extent - GetClientHeightChars, 0); end; function TKCustomHexEditor.GetPageHorz: Integer; begin case FEditArea of eaDigits: Result := ClientWidth * FDigitgrouping div (FCharWidth * (cHexDigitCount * FDigitGrouping + 1)); eaText: Result := ClientWidth div FCharWidth; else Result := 0; end; end; function TKCustomHexEditor.GetReadOnly: Boolean; begin Result := elReadOnly in FStates; end; function TKCustomHexEditor.GetRealSelEnd: TKHexEditorSelection; begin if FSelStart.Index <= FSelEnd.Index then Result := FSelEnd else Result := FSelStart; end; function TKCustomHexEditor.GetRealSelStart: TKHexEditorSelection; begin if FSelStart.Index <= FSelEnd.Index then Result := FSelStart else Result := FSelEnd; end; function TKCustomHexEditor.GetSelLength: TKHexEditorSelection; begin if FSelStart.Index <= FSelEnd.Index then Result.Index := FSelEnd.Index - FSelStart.Index else Result.Index := FSelStart.Index - FSelEnd.Index; if FSelStart.Digit <= FSelEnd.Digit then Result.Digit := FSelEnd.Digit - FSelStart.Digit else Result.Digit := FSelStart.Digit - FSelEnd.Digit; end; function TKCustomHexEditor.GetSelText: TKHexEditorSelText; var L, Sel1, Sel2: TKHexEditorSelection; begin L := SelLength; with Result do begin if L.Index > 0 then begin Sel1 := GetRealSelStart; Sel2 := GetRealSelEnd; AsBinaryRaw := BinaryToText(FBuffer, Sel1.Index, Sel2.Index, nil); AsBinaryMapped := BinaryToText(FBuffer, Sel1.Index, Sel2.Index, @FCharMapping); AsDigits := BinaryToDigits(FBuffer, Sel1, Sel2); Sel1.Digit := 0; Sel2.Digit := 0; AsDigitsByteAligned := BinaryToDigits(FBuffer, Sel1, Sel2); end else begin AsBinaryRaw := ''; AsBinaryMapped := ''; AsDigits := ''; AsDigitsByteAligned := ''; end; end; end; function TKCustomHexEditor.GetUndoLimit: Integer; begin Result := FUndoList.Limit; end; function TKCustomHexEditor.HasFocus: Boolean; var Form: TCustomForm; begin Form := GetParentForm(Self); if (Form <> nil) and Form.Visible and Form.Enabled and Form.Active then Result := (Form.ActiveControl = Self) else Result := False; end; procedure TKCustomHexEditor.HideEditorCaret; {var P: TPoint;} begin if HandleAllocated then //P := SelToPoint(FSelEnd, FEditArea); HideCaret(Handle); //{$IFDEF FPC}SetCaretPosEx(Handle,{$ELSE}SetCaretPos({$ENDIF} P.X, P.Y + 1); end; procedure TKCustomHexEditor.InsertChar(At: Int64; Value: Byte); begin InsertString(At, MakeDataSize(@Value, SizeOf(Value))); end; procedure TKCustomHexEditor.InsertString(At: Int64; const Value: TDataSize); begin if (At >= 0) and (At <= FSize) and (Value.Size > 0) then begin Inc(FSize, Value.Size); ReallocMem(FBuffer, FSize); if At < FSize - Value.Size then Move(FBuffer[At], FBuffer[At + Value.Size], (FSize - At - Value.Size) * SizeOf(Byte)); Move(Value.Data^, FBuffer[At], Value.Size); UpdateScrollRange; end; end; procedure TKCustomHexEditor.InsertString(At: Int64; const Value: AnsiString); begin if length(Value) > 0 then InsertString(At, MakeDataSize(@Value[1], Length(Value))); end; function TKCustomHexEditor.InternalGetSelAvail: Boolean; begin Result := SelAvail; end; procedure TKCustomHexEditor.InternalMoveLeft; begin if FEditArea = eaDigits then begin if FSelEnd.Digit > 0 then Dec(FSelEnd.Digit) else if FSelEnd.Index > 0 then begin FSelEnd.Digit := cHexDigitCount - 1; Dec(FSelEnd.Index); end end else Dec(FSelEnd.Index); end; procedure TKCustomHexEditor.InternalMoveRight; begin if FEditArea = eaDigits then begin if (FSelEnd.Index < FSize) and (FSelEnd.Digit < cHexDigitCount - 1) then Inc(FSelEnd.Digit) else begin FSelEnd.Digit := 0; Inc(FSelEnd.Index); end end else Inc(FSelEnd.Index); end; function TKCustomHexEditor.IsAddressPrefixStored: Boolean; begin Result := FAddressPrefix <> '0x'; end; function TKCustomHexEditor.IsDrawStylesStored: Boolean; begin Result := FDrawStyles <> cDrawStylesDef; end; function TKCustomHexEditor.IsOptionsStored: Boolean; begin Result := FOptions <> [eoGroupUndo]; end; procedure TKCustomHexEditor.KeyDown(var Key: Word; Shift: TShiftState); var Cmd: TKEditCommand; begin inherited; Exclude(FStates, elIgnoreNextChar); if not (csDesigning in ComponentState) then begin Cmd := FKeyMapping.FindCommand(Key, Shift); if Cmd <> ecNone then begin ExecuteCommand(Cmd); Key := 0; Include(FStates, elIgnoreNextChar); end; if Key = VK_ESCAPE then Include(FStates, elIgnoreNextChar); end; end; procedure TKCustomHexEditor.KeyPress(var Key: Char); var I: Integer; begin inherited; if not (csDesigning in ComponentState) then begin if not (elIgnoreNextChar in FStates) then begin case FEditArea of eaDigits: I := DigitToBin(AnsiChar(Key)); {$IFDEF UNICODE} eaText: begin I := 0; WideCharToMultiByte(DefaultSystemCodePage, 0, @Key, 1, @I, 1, nil, nil); end; {$ELSE} eaText: I := Ord(Key); {$ENDIF} else I := -1; end; if I >= 0 then ExecuteCommand(ecInsertChar, @I); end else Exclude(FStates, elIgnoreNextChar); end; end; procedure TKCustomHexEditor.LateUpdate(var Msg: TLMessage); begin inherited; case Msg.Msg of KM_SCROLL: UpdateScrollRange; end; end; procedure TKCustomHexEditor.LoadFromFile(const FileName: TFileName); var Stream: TFileStream; begin Stream := TFileStream.Create(FileName, fmOpenRead); try LoadFromStream(Stream); finally Stream.Free; end; end; procedure TKCustomHexEditor.LoadFromStream(Stream: TStream); var I, Size: Int64; begin Size := Stream.Size - Stream.Position; if Size > 0 then begin Clear; FSize := Size; GetMem(FBuffer, FSize); // unable to read big file at once, so do it stepwise I := 0; while Size > 0 do begin Stream.Read(FBuffer[I], Min(Size, cIOChunkSize)); Inc(I, cIOChunkSize); Dec(Size, cIOChunkSize); end; BufferChanged; end; end; procedure TKCustomHexEditor.MeasurePages(var Info: TKPrintMeasureInfo); var AD: TKHexEditorAreaDimensions; PageLines, ActiveLines: Integer; FitToPage, SelOnly: Boolean; Scale: Double; APageSetup: TKPrintPageSetup; begin APageSetup := PageSetup; FitToPage := poFitToPage in APageSetup.Options; SelOnly := APageSetup.Range = prSelectedOnly; Scale := APageSetup.Scale / 100; AD := GetAreaDimensions; Info.OutlineWidth := AD.TotalHorz * FCharWidth; if FitToPage then Scale := APageSetup.MappedControlPaintAreaWidth / Info.OutlineWidth; PageLines := Round(APageSetup.MappedPaintAreaHeight / Scale) div FCharHeight; if SelOnly then ActiveLines := DivUp64(GetRealSelEnd.Index, FLineSize) - GetRealSelStart.Index div FLineSize else ActiveLines := LineCount; Info.OutlineHeight := PageLines * FCharHeight; Info.ControlHorzPageCount := 1; // cut text off Info.ControlVertPageCount := DivUp(ActiveLines, PageLines); end; procedure TKCustomHexEditor.ModifyScrollBar(ScrollBar, ScrollCode, Delta: Integer; UpdateNeeded: Boolean); var I, J, K: Integer; HasScrollBar: Boolean; SI: TScrollInfo; begin HasScrollBar := (ScrollBar = SB_HORZ) and (ScrollBars = ssHorizontal) or (ScrollBar = SB_VERT) and (ScrollBars = ssVertical) or (ScrollBars = ssBoth); if HasScrollBar then begin FillChar(SI, SizeOf(TScrollInfo), 0); SI.cbSize := SizeOf(TScrollInfo); SI.fMask := SIF_PAGE or SIF_TRACKPOS; GetScrollInfo(Handle, ScrollBar, SI); {$IFDEF UNIX} SI.nTrackPos := Delta; {$ENDIF} end; if ScrollBar = SB_HORZ then begin I := FLeftChar; J := GetMaxLeftChar; end else begin I := FTopLine; J := GetMaxTopLine; end; K := I; case ScrollCode of SB_LINEUP: Dec(I); SB_LINEDOWN: Inc(I); SB_PAGEUP: Dec(I, SI.nPage); SB_PAGEDOWN: Inc(I, SI.nPage); SB_THUMBTRACK, SB_THUMBPOSITION: I := SI.nTrackPos; cScrollDelta: Inc(I, Delta); end; I := MinMax(I, 0, J); if K <> I then begin if HasScrollBar then begin FillChar(SI, SizeOf(TScrollInfo), 0); SI.nPos := I; SI.fMask := SIF_POS; SetScrollInfo(Handle, ScrollBar, SI, True); end; if ScrollBar = SB_HORZ then FLeftChar := I else FTopLine := I; if UpdateNeeded then begin UpdateEditorCaret; Invalidate; end; end; end; procedure TKCustomHexEditor.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var P: TKPoint64; Command: TKEditCommand; begin inherited; if Enabled and (Button = mbLeft) and not (ssDouble in Shift) then begin SafeSetFocus; P := Point64(X, Y); if ssShift in Shift then Command := ecSelGotoXY else Command := ecGotoXY; if ExecuteCommand(Command, @P) then Include(FStates, elMouseCapture); end; end; procedure TKCustomHexEditor.MouseMove(Shift: TShiftState; X, Y: Integer); var P: TKPoint64; R: TRect; begin inherited; if (elMouseCapture in FStates) then begin P := Point64(X, Y); R := GetModifiedClientRect; if Pt64InRect(R, P) then UpdateSelEnd(P, False) else if not FScrollTimer.Enabled then ScrollTo(P, True, False); end; end; procedure TKCustomHexEditor.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin inherited; Exclude(FStates, elMouseCapture); end; procedure TKCustomHexEditor.PaintLines(const Data: TKHexEditorPaintData); var HalfPosWidth, I, J, K, M, MaxAddress, WHorz, WVert, WSep: Integer; Index, L, LineIndex, Addr: Int64; LeftIndent, VTextIndent: Integer; BC1, BC2, FC1, FC2, PC1: TColor; EditorFocused, DrawInactiveCaret, DrawNormal, DigitSep, SelCondition: Boolean; S: AnsiString; Fmt: string; C: AnsiChar; R, R1, RClip: TRect; OldColorScheme: TKColorScheme; ASelStart, ASelEnd: TKHexEditorSelection; AD: TKHexEditorAreaDimensions; begin { this function must be reentrant because of print function so there is necessary to backup all changes to global properties} OldColorScheme := FColors.ColorScheme; with Data.Canvas do try R := Data.PaintRect; AD := GetAreaDimensions; // add possible inter-character spacing (in Lazarus not fully implemented yet) SetTextCharacterExtra(Handle, Data.CharSpacing); LeftIndent := R.Left - Data.LeftChar * Data.CharWidth; VTextIndent := (Data.CharHeight - Abs(Font.Height)) div 2; HalfPosWidth := Data.CharWidth div 2; Fmt := ''; MaxAddress := 0; L := LineCount; DrawInactiveCaret := not (Data.Printing or Data.CaretShown) and (edInactiveCaret in FDrawStyles); DrawNormal := not Data.Printing; EditorFocused := HasFocus; if FSelStart.Index <= FSelEnd.Index then begin ASelStart := FSelStart; ASelEnd := FSelEnd; end else begin ASelStart := FSelEnd; ASelEnd := FSelStart; end; // preserve space for lines and separators if edHorzLines in FDrawStyles then WVert := Max(1, Data.CharHeight div 25) else WVert := 0; if edVertLines in FDrawStyles then WHorz := Max(1, Data.CharWidth div 20) else WHorz := 0; if edSeparators in FDrawStyles then WSep := Max(1, Data.CharWidth div 20) else WSep := 0; // address area pre-comp if edAddress in FDrawStyles then begin if FAddressMode = eamDec then begin C := 'd'; J := 10; end else begin C := 'x'; J := 16; end; Fmt := Format('%s%%.%d%s', [FAddressPrefix, FAddressSize, C]); MaxAddress := 1; for I := 1 to FAddressSize do MaxAddress := MaxAddress * J; end; // update color scheme if Data.Printing then begin if Data.PaintColors then FColors.ColorScheme := csNormal else FColors.ColorScheme := csGrayScale; end else begin if Enabled or (FDisabledDrawStyle = eddNormal) then FColors.ColorScheme := csNormal else if FDisabledDrawStyle = eddGrayed then FColors.ColorScheme := csGrayed else FColors.ColorScheme := csBright end; FColors.SingleBkGnd := edSingleBkGnd in FDrawStyles; // get clip box for updating; if Data.Printing then RClip := R else GetClipBox(Handle, {$IFDEF FPC}@{$ENDIF}RClip); // now paint text lines LineIndex := Data.TopLine; while LineIndex <= Min(L - 1, Data.BottomLine) do begin Brush.Style := bsSolid; K := LeftIndent; R.Bottom := R.Top + Data.CharHeight - WVert; if (R.Top <= RClip.Bottom) and (R.Bottom >= RClip.Top) then begin if edAddress in FDrawStyles then begin Index := LineIndex * FLineSize; Brush.Color := clRed; if (DrawNormal or Data.PaintSelection) and ((ASelStart.Index <> ASelEnd.Index) or (ASelStart.Digit <> ASelEnd.Digit)) and (Index + FLineSize - 1 >= ASelStart.Index) and (Index < ASelEnd.Index) then begin PC1 := FColors.LinesHighLight; if (FEditArea = eaAddress) and (EditorFocused or Data.PaintSelection) then begin FC1 := FColors.SelTextFocused; BC1 := FColors.SelBkGndFocused; end else begin FC1 := FColors.SelText; BC1 := FColors.SelBkGnd; end; end else begin PC1 := FColors.HorzLines; FC1 := FColors.AddressText; BC1 := FColors.AddressBkGnd; end; Brush.Color := BC1; Font.Color := FC1; R.Left := K; Inc(K, AD.Address * Data.CharWidth); R.Right := K; Addr := LineIndex * FLineSize + FAddressOffset; if MaxAddress <> 0 then Addr := Addr mod MaxAddress; FillRect(R); TextOut(R.Left, R.Top + VTextIndent, Format(Fmt, [Addr])); if edHorzLines in FDrawStyles then begin Brush.Color := PC1; FillRect(Rect(R.Left, R.Bottom, R.Right, R.Bottom + WVert)); end; if AD.AddressOut > 0 then begin R.Left := K; Inc(K, AD.AddressOut * Data.CharWidth); R.Right := K; Brush.Color := FColors.AddressBkGnd; FillRect(Rect(R.Left, R.Top, R.Right - WSep, R.Bottom)); if edHorzLines in FDrawStyles then begin Brush.Color := FColors.HorzLines; FillRect(Rect(R.Left, R.Bottom, R.Right - WSep, R.Bottom + WVert)); end; end; end; if edDigits in FDrawStyles then begin if AD.DigitsIn > 0 then begin R.Left := K; Inc(K, AD.DigitsIn * Data.CharWidth); R.Right := K; Brush.Color := FColors.DigitBkGnd; FillRect(Rect(R.Left + WSep, R.Top, R.Right, R.Bottom)); if edHorzLines in FDrawStyles then begin Brush.Color := FColors.HorzLines; FillRect(Rect(R.Left + WSep, R.Bottom, R.Right, R.Bottom + WVert)); end; end; Index := 0; for J := 0 to FLineSize - 1 do begin Index := LineIndex * FLineSize + J; DigitSep := (J < FLineSize - 1) and ((J + 1) mod FDigitGrouping = 0); R.Left := K; Inc(K, cHexDigitCount * Data.CharWidth); R.Right := K; if Index <= FSize then begin if Index < FSize then S := AnsiString(Format(cHexFmtText, [FBuffer[Index]])) else S := ' '; if (Index <> FSelStart.Index) and (Index <> FSelEnd.Index) then begin SelCondition := (Index >= ASelStart.Index) and (Index < ASelEnd.Index); if (DrawNormal or Data.PaintSelection) and SelCondition then begin PC1 := FColors.LinesHighLight; if (FEditArea = eaDigits) and (EditorFocused or Data.PaintSelection) then begin FC1 := FColors.SelTextFocused; BC1 := FColors.SelBkGndFocused; end else begin FC1 := FColors.SelText; BC1 := FColors.SelBkGnd; end; FC2 := FColors.InactiveCaretSelText; BC2 := FColors.InactiveCaretSelBkGnd; end else begin PC1 := FColors.HorzLines; if DrawNormal or Data.PaintAll or SelCondition then begin if (J div FDigitGrouping) and 1 = 0 then FC1 := FColors.DigitTextEven else FC1 := FColors.DigitTextOdd; end else FC1 := FColors.DigitBkGnd; BC1 := FColors.DigitBkGnd; FC2 := FColors.InactiveCaretText; BC2 := FColors.InactiveCaretBkGnd; end; Brush.Color := BC1; Font.Color := FC1; Brush.Style := bsSolid; FillRect(R); Brush.Style := bsClear; TextOut(R.Left, R.Top + VTextIndent, string(AnsiChar(S[1]))); TextOut(R.Left + Data.CharWidth, R.Top + VTextIndent, string(AnsiChar(S[2]))); if (Index = FSelEnd.Index) and DrawInactiveCaret then begin // draw inactive caret - place into previous drawn text R1 := R; Inc(R1.Left, Data.CharWidth * Min(FSelEnd.Digit, cHexDigitCount - 1)); R1.Right := R1.Left + Data.CharWidth; Font.Color := FC2; Brush.Color := BC2; Brush.Style := bsSolid; FillRect(R1); Brush.Style := bsClear; TextOut(R1.Left, R1.Top + VTextIndent, string(S)); end; if edHorzLines in FDrawStyles then begin Brush.Color := PC1; Brush.Style := bsSolid; FillRect(Rect(R.Left, R.Bottom, R.Right, R.Bottom + WVert)); end; end else begin R1 := R; R1.Right := R1.Left; Inc(R1.Right, Data.CharWidth); for M := 0 to cHexDigitCount - 1 do begin SelCondition := (ASelStart.Index = ASelEnd.Index) and ( (M >= ASelStart.Digit) and (M < ASelEnd.Digit) or (M >= ASelEnd.Digit) and (M < ASelStart.Digit) ) or (ASelStart.Index <> ASelEnd.Index) and ( (Index = ASelStart.Index) and (M >= ASelStart.Digit) or (Index = ASelEnd.Index) and (M < ASelEnd.Digit) ); if (DrawNormal or Data.PaintSelection) and SelCondition then begin PC1 := FColors.LinesHighLight; if DrawInactiveCaret and (Index = FSelEnd.Index) and (M = FSelEnd.Digit) then begin FC1 := FColors.InactiveCaretSelText; BC1 := FColors.InactiveCaretSelBkGnd; end else if (FEditArea = eaDigits) and (EditorFocused or Data.PaintSelection) then begin FC1 := FColors.SelTextFocused; BC1 := FColors.SelBkGndFocused; end else begin FC1 := FColors.SelText; BC1 := FColors.SelBkGnd; end; end else begin PC1 := FColors.HorzLines; if DrawInactiveCaret and (Index = FSelEnd.Index) and (M = FSelEnd.Digit) then begin FC1 := FColors.InactiveCaretText; BC1 := FColors.InactiveCaretBkGnd; end else begin if DrawNormal or Data.PaintAll or SelCondition then begin if (J div FDigitGrouping) and 1 = 0 then FC1 := FColors.DigitTextEven else FC1 := FColors.DigitTextOdd; end else FC1 := FColors.DigitBkGnd; BC1 := FColors.DigitBkGnd; end; end; Brush.Color := BC1; Font.Color := FC1; Brush.Style := bsSolid; FillRect(R1); Brush.Style := bsClear; TextOut(R1.Left, R1.Top + VTextIndent, string(AnsiChar(S[M + 1]))); if edHorzLines in FDrawStyles then begin Brush.Color := PC1; Brush.Style := bsSolid; FillRect(Rect(R1.Left, R1.Bottom, R1.Right, R1.Bottom + WVert)); end; R1.Left := R1.Right; Inc(R1.Right, Data.CharWidth); end; end; if DigitSep then begin if Index < FSize then M := Data.CharWidth else M := HalfPosWidth; Brush.Color := FColors.DigitBkGnd; Brush.Style := bsSolid; FillRect(Rect(R.Right, R.Top, R.Right + Data.CharWidth, R.Bottom)); if edHorzLines in FDrawStyles then begin Brush.Color := FColors.HorzLines; FillRect(Rect(R.Right, R.Bottom, R.Right + M, R.Bottom + WVert)); end; if edVertLines in FDrawStyles then begin M := R.Right + HalfPosWidth; Brush.Color := FColors.VertLines; FillRect(Rect(M, R.Top, M + WHorz, R.Bottom)); end; Inc(K, Data.CharWidth); end; end else begin Inc(K, Integer(DigitSep) * Data.CharWidth); Brush.Color := FColors.DigitBkGnd; Brush.Style := bsSolid; FillRect(Rect(R.Left, R.Top, K, R.Bottom + WVert)); end; end; if AD.DigitsOut > 0 then begin R.Left := K; Inc(K, AD.DigitsOut * Data.CharWidth); R.Right := K; Brush.Style := bsSolid; Brush.Color := FColors.DigitBkGnd; FillRect(Rect(R.Left, R.Top, R.Right - WSep, R.Bottom)); if edHorzLines in FDrawStyles then begin if Index < FSize then Brush.Color := FColors.HorzLines else Brush.Color := FColors.DigitBkGnd; FillRect(Rect(R.Left, R.Bottom, R.Right - WSep, R.Bottom + WVert)); end; end; end; if edText in FDrawStyles then begin if AD.TextIn > 0 then begin R.Left := K; Inc(K, AD.TextIn * Data.CharWidth); R.Right := K; Brush.Color := FColors.TextBkGnd; Brush.Style := bsSolid; FillRect(Rect(R.Left + WSep, R.Top, R.Right, R.Bottom)); if edHorzLines in FDrawStyles then begin Brush.Color := FColors.HorzLines; FillRect(Rect(R.Left + WSep, R.Bottom, R.Right, R.Bottom + WVert)); end; end; for J := 0 to FLineSize - 1 do begin Index := LineIndex * FLineSize + J; R.Left := K; Inc(K, Data.CharWidth); R.Right := K; if Index <= FSize then begin SelCondition := (Index >= ASelStart.Index) and (Index < ASelEnd.Index); if (DrawNormal or Data.PaintSelection) and SelCondition then begin PC1 := FColors.LinesHighLight; if DrawInactiveCaret and (Index = FSelEnd.Index) then begin FC1 := FColors.InactiveCaretSelText; BC1 := FColors.InactiveCaretSelBkGnd; end else if (FEditArea = eaText) and (EditorFocused or Data.PaintSelection) then begin FC1 := FColors.SelTextFocused; BC1 := FColors.SelBkGndFocused; end else begin FC1 := FColors.SelText; BC1 := FColors.SelBkGnd; end; end else begin PC1 := FColors.HorzLines; if DrawInactiveCaret and (Index = FSelEnd.Index) then begin FC1 := FColors.InactiveCaretText; BC1 := FColors.InactiveCaretBkGnd; end else begin if DrawNormal or Data.PaintAll or SelCondition then FC1 := FColors.TextText else FC1 := FColors.TextBkgnd; BC1 := FColors.TextBkgnd; end; end; Brush.Color := BC1; Brush.Style := bsSolid; FillRect(R); Brush.Style := bsClear; if Index < FSize then begin Font.Color := FC1; TextOut(R.Left, R.Top + VTextIndent, string(AnsiChar(FCharMapping[FBuffer[Index]]))); end; if edHorzLines in FDrawStyles then begin Brush.Color := PC1; Brush.Style := bsSolid; FillRect(Rect(R.Left, R.Bottom, R.Right, R.Bottom + WVert)); end; end else begin Brush.Color := FColors.TextBkGnd; Brush.Style := bsSolid; FillRect(Rect(R.Left, R.Top, K, R.Bottom + WVert)); end; end; end; end; Inc(LineIndex); Inc(R.Top, Data.CharHeight); end; // now complete blank areas below text and optionally paint separators K := LeftIndent; R.Bottom := Data.PaintRect.Bottom; Brush.Style := bsSolid; if edAddress in FDrawStyles then begin R.Left := K; Inc(K, (AD.Address + AD.AddressOut) * Data.CharWidth); R.Right := K; if FDrawStyles * [edDigits, edText] <> [] then Dec(R.Right, WSep); if R.Top < R.Bottom then begin Brush.Color := FColors.AddressBkGnd; FillRect(R); end; if (edSeparators in FDrawStyles) and (FDrawStyles * [edDigits, edText] <> []) then begin Brush.Color := FColors.Separators; FillRect(Rect(K - WSep, Data.PaintRect.Top, K + WSep, Data.PaintRect.Bottom)); end; end; if edDigits in FDrawStyles then begin R.Left := K; if edAddress in FDrawStyles then Inc(R.Left, WSep); Inc(K, (AD.Digits + AD.DigitsIn + AD.DigitsOut) * Data.CharWidth); R.Right := K; if edText in FDrawStyles then Dec(R.Right, WSep); if R.Top < R.Bottom then begin Brush.Color := FColors.DigitBkGnd; FillRect(R); end; if (edSeparators in FDrawStyles) and (edText in FDrawStyles) then begin Brush.Color := FColors.Separators; FillRect(Rect(K - WSep, Data.PaintRect.Top, K + WSep, Data.PaintRect.Bottom)); end; end; if edText in FDrawStyles then begin R.Left := K; if FDrawStyles * [edAddress, edDigits] <> [] then Inc(R.Left, WSep); Inc(K, (AD.TextIn + AD.Text) * Data.CharWidth); R.Right := K; if R.Top < R.Bottom then begin Brush.Color := FColors.TextBkGnd; FillRect(R); end; end; if K < ClientWidth then begin Brush.Color := FColors.BkGnd; FillRect(Rect(K, 0, ClientWidth, ClientHeight)); end; finally FColors.ColorScheme := OldColorScheme; end; end; procedure TKCustomHexEditor.PaintPage; var ActiveLines, AreaWidth, AreaHeight, FirstLine, PageLines: Integer; SelOnly: Boolean; TmpRect, TmpRect1: TRect; APageSetup: TKPrintPageSetup; Data: TKHexEditorPaintData; begin APageSetup := PageSetup; SelOnly := APageSetup.Range = prSelectedOnly; AreaWidth := Round(APageSetup.MappedControlPaintAreaWidth / APageSetup.CurrentScale); AreaHeight := Round(APageSetup.MappedPaintAreaHeight / APageSetup.CurrentScale); PageLines := AreaHeight div FCharHeight; if SelOnly then begin FirstLine := GetRealSelStart.Index div FLineSize; ActiveLines := DivUp64(GetRealSelEnd.Index, FLineSize) - FirstLine; end else begin FirstLine := 0; ActiveLines := LineCount; end; TmpRect := Rect(0, 0, APageSetup.MappedOutlineWidth, APageSetup.MappedOutlineHeight); TmpRect1 := Rect(0, 0, AreaWidth, AreaHeight); IntersectRect(TmpRect, TmpRect, TmpRect1); TmpRect1 := TmpRect; TranslateRectToDevice(APageSetup.Canvas.Handle, TmpRect1); SelectClipRect(APageSetup.Canvas.Handle, TmpRect1); Data.Canvas := APageSetup.Canvas; Data.Canvas.Font := Font; Data.Canvas.Font.Height := Abs(Font.Height); Data.PaintRect := TmpRect; Data.TopLine := (APageSetup.CurrentPageControl - 1) * PageLines; Data.BottomLine := Min(Data.TopLine + PageLines, ActiveLines) - 1; Inc(Data.TopLine, FirstLine); Inc(Data.BottomLine, FirstLine); Data.LeftChar := 0; Data.CharWidth := FCharWidth; Data.CharHeight := FCharHeight; Data.CharSpacing := FTotalCharSpacing; Data.Printing := True; Data.PaintSelection := poPaintSelection in APageSetup.Options; Data.PaintAll := not SelOnly; Data.PaintColors := poUseColor in APageSetup.Options; PaintLines(Data); end; procedure TKCustomHexEditor.PaintToCanvas(ACanvas: TCanvas); var Data: TKHexEditorPaintData; begin ACanvas.Font := Font; with Data do begin Canvas := ACanvas; PaintRect := ClientRect; LeftChar := FLeftChar; TopLine := FTopLine; CharWidth := FCharWidth; CharHeight := FCharHeight; BottomLine := TopLine + ClientHeight div FCharHeight; CharSpacing := FTotalCharSpacing; Printing := False; PaintSelection := False; CaretShown := elCaretVisible in FStates; end; {$IFDEF FPC} if Data.CaretShown then HideEditorCaret; try {$ENDIF} PaintLines(Data); {$IFDEF FPC} finally if Data.CaretShown then ShowEditorCaret; end; {$ENDIF} end; procedure TKCustomHexEditor.PaintToCanvasEx(ACanvas: TCanvas; ARect: TRect; ALeftChar: Integer; ATopLine: Int64); var Data: TKHexEditorPaintData; Region: HRGN; begin ACanvas.Font := Font; with Data do begin Canvas := ACanvas; PaintRect := ARect; LeftChar := ALeftChar; TopLine := ATopLine; CharWidth := FCharWidth; CharHeight := FCharHeight; BottomLine := TopLine + (ARect.Bottom - ARect.Top) div FCharHeight; CharSpacing := FTotalCharSpacing; Printing := False; PaintSelection := False; end; Region := CreateRectRgnIndirect(ARect); try SelectClipRgn(ACanvas.Handle, Region); try PaintLines(Data); finally SelectClipRgn(ACanvas.Handle, 0); end; finally DeleteObject(Region); end; end; function TKCustomHexEditor.PointToSel(P: TKPoint64; OutOfArea: Boolean; var Area: TKHexEditorArea): TKHexEditorSelection; var Digit, HalfPosWidth, I, X, X1, XMax: Integer; DigitSep: Boolean; AD: TKHexEditorAreaDimensions; Sel: TKHexEditorSelection; begin Result := MakeSelection(cInvalidIndex, 0); P.X := P.X + FLeftChar * FCharWidth; P.Y := P.Y div FCharHeight + FTopLine; AD := GetAreaDimensions; HalfPosWidth := FCharWidth div 2; X := 0; if OutOfArea then P.Y := MinMax(P.Y, 0, LineCount - 1) else Area := eaNone; if P.Y < LineCount then begin if edAddress in FDrawStyles then begin XMax := X + (AD.Address + AD.AddressOut) * FCharWidth; if not OutOfArea or (Area = eaAddress) then if (P.X >= X) and (P.X < XMax) then begin Result := MakeSelection(P.Y * FLineSize, 0); Area := eaAddress; end else if Area = eaAddress then // OutOfArea = True begin Result.Index := P.Y * FLineSize; if P.X >= XMax then Inc(Result.Index, FLineSize); end; X := XMax; end; if (P.X >= X) or OutOfArea then begin if edDigits in FDrawStyles then begin XMax := X + (AD.Digits + AD.DigitsIn + AD.DigitsOut) * FCharWidth; if not OutOfArea or (Area = eaDigits) then if (P.X >= X) and (P.X < XMax) then begin Inc(X, AD.DigitsIn * FCharWidth); for I := 0 to FLineSize - 1 do begin DigitSep := (I < FLineSize - 1) and ((I + 1) mod FDigitGrouping = 0); X1 := X; Inc(X, cHexDigitCount * FCharWidth); if DigitSep then Inc(X, HalfPosWidth) else if I = FLineSize - 1 then Inc(X, AD.DigitsOut * FCharWidth); if P.X < X then begin Digit := (Max(P.X - X1, 0) + HalfPosWidth) div FCharWidth; Sel := MakeSelection(P.Y * FLineSize + I, Digit); if (Digit >= cHexDigitCount) and (Sel.Index < FSize) then // don't split the FSize character box begin Inc(Sel.Index); Sel.Digit := 0; end; if (Sel.Index <= FSize) or OutOfArea then begin Result := Sel; Area := eaDigits; end; Break; end; if DigitSep then Inc(X, HalfPosWidth); end; end else if Area = eaDigits then // OutOfArea = True begin Result.Index := P.Y * FLineSize; if P.X >= XMax then Inc(Result.Index, FLineSize); end; X := XMax; end; if ((P.X >= X) or OutOfArea) and (edText in FDrawStyles) then begin XMax := X + (AD.Text + AD.TextIn) * FCharWidth; if not OutOfArea or (Area = eaText) then if (P.X >= X) and (P.X < XMax) then begin Inc(X, AD.TextIn * FCharWidth); Sel := MakeSelection(P.Y * FLineSize, 0); I := Max(P.X - X, 0) div FCharWidth; if Sel.Index + I = FSize then Sel.Index := FSize // don't split the FSize character box else Inc(Sel.Index, (Max(P.X - X, 0) + HalfPosWidth) div FCharWidth); if (Sel.Index <= FSize) or OutOfArea then begin Result := Sel; Area := eaText; end; end else if Area = eaText then // OutOfArea = True begin Result.Index := P.Y * FLineSize; if P.X >= XMax then Inc(Result.Index, FLineSize); end; end; end; end; ValidateSelection(Result, Area); end; procedure TKCustomHexEditor.SafeSetFocus; var Form: TCustomForm; begin Form := GetParentForm(Self); if (Form <> nil) and Form.Visible and Form.Enabled and not (csDestroying in Form.ComponentState) and Visible and Enabled then Form.ActiveControl := Self; end; procedure TKCustomHexEditor.SaveToFile(const FileName: TFileName); var Stream: TFileStream; begin Stream := TFileStream.Create(FileName, fmCreate); try SaveToStream(Stream); finally Stream.Free; end; end; procedure TKCustomHexEditor.SaveToStream(Stream: TStream); var I, Size: Int64; begin if FBuffer <> nil then begin // unable to write big file at once, so do it stepwise I := 0; Size := FSize; while Size > 0 do begin Stream.Write(FBuffer[I], Min(Size, cIOChunkSize)); Inc(I, cIOChunkSize); Dec(Size, cIOChunkSize); end; end; end; procedure TKCustomHexEditor.ScrollBy(HChars, VChars: Integer; UpdateNeeded: Boolean); begin if HChars <> 0 then ModifyScrollBar(SB_HORZ, cScrollDelta, HChars, UpdateNeeded); if VChars <> 0 then ModifyScrollBar(SB_VERT, cScrollDelta, VChars, UpdateNeeded); end; procedure TKCustomHexEditor.ScrollTo(Point: TKPoint64; Timed, AlwaysScroll: Boolean); var ScrollHorz: Boolean; R: TRect; begin // disable horizontal overscroll when scrolling e.g. with mouse ScrollHorz := AlwaysScroll or (FSelEnd.Index mod FLineSize <> 0) and (FSelEnd.Index < FSize) or (FSelEnd.Digit > 0); R := GetModifiedClientRect; if ScrollHorz then begin if Point.X < R.Left then FScrollDeltaX := DivDown64(Point.X, FCharWidth) else if Point.X >= R.Right then FScrollDeltaX := (Point.X - R.Right) div FCharWidth + 1 else FScrollDeltaX := 0; end else FScrollDeltaX := 0; if Point.Y < R.Top then FScrollDeltaY := DivDown64(Point.Y, FCharHeight) else if Point.Y >= R.Bottom then FScrollDeltaY := (Point.Y - R.Bottom) div FCharHeight + 1 else FScrollDeltaY := 0; if (FScrollDeltaX <> 0) or (FScrollDeltaY <> 0) then if Timed then begin ScrollBy(FScrollDeltaX, FScrollDeltaY, False); FScrollTimer.Enabled := True; end else ScrollBy(FScrollDeltaX, FScrollDeltaY, True); UpdateSelEnd(Point, True); end; procedure TKCustomHexEditor.ScrollTimerHandler(Sender: TObject); var P: TPoint; begin GetCursorPos(P); P := ScreenToClient(P); if (elMouseCapture in FStates) and not (Dragging or PtInRect(GetModifiedClientRect, P)) then ScrollTo(PointToPoint64(P), True, False) else FScrollTimer.Enabled := False; end; function TKCustomHexEditor.SelAvail: Boolean; begin Result := SelLength.Index > 0; end; procedure TKCustomHexEditor.SelectionChanged(StartEqualEnd: Boolean; ScrollToView: Boolean = True); begin ValidateSelection(FSelEnd, FEditArea); if StartEqualEnd then FSelStart := FSelEnd else ValidateSelection(FSelStart, FEditArea); if HasParent then begin if ScrollToView and (FEditArea <> eaNone) then ScrollTo(SelToPoint(FSelEnd, FEditArea), False, True); UpdateEditorCaret; Invalidate; InvalidatePageSetup; end; end; function TKCustomHexEditor.SelectionValid(Value: TKHexEditorSelection; Area: TKHexEditorArea): Boolean; begin Result := (Area <> eaNone) and ( (Value.Index >= 0) and (Value.Index < FSize) or (Value.Index = FSize) and (Value.Digit = 0)) end; function TKCustomHexEditor.SelToPoint(Value: TKHexEditorSelection; Area: TKHexEditorArea): TKPoint64; var AD: TKHexEditorAreaDimensions; begin Result := CreateEmptyPoint64; AD := GetAreaDimensions; ValidateSelection(Value, Area); if (Area = eaDigits) and (edDigits in FDrawStyles) then begin Result.X := ((Value.Index mod FLineSize) div FDigitGrouping * (cHexDigitCount * FDigitGrouping + 1) + (Value.Index mod FLineSize) mod FDigitGrouping * cHexDigitCount + Value.Digit + AD.DigitsIn) end else if (Area = eaText) and (edText in FDrawStyles) then Result.X := (Value.Index mod FLineSize + AD.DigitsIn + AD.Digits + AD.DigitsOut + AD.TextIn) else if Area = eaAddress then begin if edDigits in FDrawStyles then Result.X := AD.DigitsIn else if edText in FDrawStyles then Result.X := AD.TextIn; end; Result.X := (Result.X + AD.Address + AD.AddressOut - FLeftChar) * FCharWidth; Result.Y := (Value.Index div FLineSize - FTopLine) * FCharHeight; end; procedure TKCustomHexEditor.SetAddressCursor(Value: TCursor); begin if Value <> FAddressCursor then begin FAddressCursor := Value; UpdateMouseCursor; end; end; procedure TKCustomHexEditor.SetAddressMode(Value: TKHexEditorAddressMode); begin if Value <> FAddressMode then begin FAddressMode := Value; Invalidate; end; end; procedure TKCustomHexEditor.SetAddressOffset(Value: Integer); begin if Value <> FAddressOffset then begin FAddressOffset := Value; Invalidate; end; end; procedure TKCustomHexEditor.SetAddressPrefix(const Value: string); begin if Value <> FAddressPrefix then begin FAddressPrefix := Value; UpdateScrollRange; end; end; procedure TKCustomHexEditor.SetAddressSize(Value: Integer); begin Value := MinMax(Value, cAddressSizeMin, cAddressSizeMax); if Value <> FAddressSize then begin FAddressSize := Value; UpdateScrollRange; end; end; procedure TKCustomHexEditor.SetAreaSpacing(Value: Integer); begin Value := MinMax(Value, cAreaSpacingMin, cAreaSpacingMax); if Value <> FAreaSpacing then begin FAreaSpacing := Value; UpdateScrollRange; end; end; procedure TKCustomHexEditor.SetCharMapping(Value: TKEditCharMapping); begin if not CompareMem(@Value[0], @FCharMapping[0], cCharMappingSize) then begin Move(Value[0], FCharMapping[0], cCharMappingSize); if edText in FDrawStyles then Invalidate; end; end; procedure TKCustomHexEditor.SetCharSpacing(Value: Integer); begin Value := MinMax(Value, cCharSpacingMin, cCharSpacingMax); if Value <> FCharSpacing then begin FCharSpacing := Value; UpdateCharMetrics; UpdateScrollRange; end; end; procedure TKCustomHexEditor.SetColors(Value: TKHexEditorColors); begin FColors.Assign(Value); end; procedure TKCustomHexEditor.SetCommandKey(Index: TKEditCommand; Value: TKEditKey); begin FKeyMapping.Key[Index] := Value; end; procedure TKCustomHexEditor.SetData(const Value: TDataSize); begin if (Value.Data <> FBuffer) or (Value.Size <> FSize) then begin Clear; if Value.Data <> nil then begin FSize := Value.Size; GetMem(FBuffer, FSize); System.Move(Value.Data^, FBuffer^, FSize); BufferChanged; end; end; end; procedure TKCustomHexEditor.SetDigitGrouping(Value: Integer); begin Value := MinMax(Value, cDigitGroupingMin, Min(FLineSize, cDigitGroupingMax)); if Value <> FDigitGrouping then begin FDigitGrouping := Value; UpdateScrollRange; end; end; procedure TKCustomHexEditor.SetDisabledDrawStyle(Value: TKEditDisabledDrawStyle); begin if Value <> FDisabledDrawStyle then begin FDisabledDrawStyle := Value; if not Enabled then Invalidate; end; end; procedure TKCustomHexEditor.SetDrawStyles(const Value: TKHexEditorDrawStyles); begin if Value <> FDrawStyles then begin FDrawStyles := Value; EditAreaChanged; // must be called first UpdateScrollRange; end; end; procedure TKCustomHexEditor.SetEditArea(Value: TKHexEditorArea); begin if Value <> FEditArea then begin FEditArea := Value; EditAreaChanged; if Value <> FEditArea then Invalidate; end; end; procedure TKCustomHexEditor.SetKeyMapping(const Value: TKEditKeyMapping); begin FKeyMapping.Assign(Value); end; procedure TKCustomHexEditor.SetLineHeightPercent(Value: Integer); begin Value := MinMax(Value, cLineHeightPercentMin, cLineHeightPercentMax); if Value <> FLineHeightPercent then begin FLineHeightPercent := Value; UpdateCharMetrics; UpdateScrollRange; end; end; procedure TKCustomHexEditor.SetLeftChar(Value: Integer); begin Value := MinMax(Value, 0, GetMaxLeftChar); if Value <> FLeftChar then ScrollBy(Value - FLeftChar, 0, True); end; procedure TKCustomHexEditor.SetLines(Index: Int64; const Value: TDataSize); var I, Size: Int64; begin I := Index * FLineSize; if (Value.Data <> nil) and (Value.Size > 0) and (I >= 0) and (I <= FSize) then begin Size := Min(FLineSize, Value.Size); if I + Size > FSize then begin FSize := Size; ReallocMem(FBuffer, FSize); end; System.Move(Value.Data^, FBuffer[I], Size); BufferChanged; end; end; procedure TKCustomHexEditor.SetLineSize(Value: Integer); begin Value := MinMax(Value, cLineSizeMin, cLineSizeMax); if Value <> FLineSize then begin FLineSize := Value; UpdateScrollRange; end; end; procedure TKCustomHexEditor.SetModified(Value: Boolean); begin if Value <> GetModified then begin if Value then Include(FStates, elModified) else begin Exclude(FStates, elModified); if eoUndoAfterSave in FOptions then FUndoList.Modified := False else begin FUndoList.Clear; FRedoList.Clear; end; end; end; end; function TKCustomHexEditor.SetMouseCursor(X, Y: Integer): Boolean; var ACursor: TCursor; P: TKPoint64; Area: TKHexEditorArea; begin P := Point64(X, Y); PointToSel(P, False, Area); if Pt64InRect(ClientRect, P) then begin case Area of eaAddress: ACursor := FAddressCursor; eaDigits: ACursor := crIBeam; eaText: ACursor := crIBeam; else ACursor := crDefault; end; end else ACursor := crDefault; {$IFDEF FPC} FCursor := ACursor; SetTempCursor(ACursor); {$ELSE} Windows.SetCursor(Screen.Cursors[ACursor]); {$ENDIF} Result := True; end; procedure TKCustomHexEditor.SetOptions(const Value: TKEditOptions); {$IFDEF MSWINDOWS} var UpdateDropFiles: Boolean; {$ENDIF} begin if Value <> FOptions then begin {$IFDEF MSWINDOWS} UpdateDropFiles := (eoDropFiles in Value) <> (eoDropFiles in FOptions); FOptions := Value; // (un)register HWND as drop target if UpdateDropFiles and not (csDesigning in ComponentState) and HandleAllocated then DragAcceptFiles(Handle, (eoDropFiles in fOptions)); {$ELSE} FOptions := Value; {$ENDIF} end; end; procedure TKCustomHexEditor.SetReadOnly(Value: Boolean); begin if Value <> GetReadOnly then begin if Value then Include(FStates, elReadOnly) else Exclude(FStates, elReadOnly); end; end; procedure TKCustomHexEditor.SetScrollBars(Value: TScrollStyle); begin if Value <> FScrollBars then begin FScrollBars := Value; {$IFDEF FPC} CallUpdateSize; {$ELSE} RecreateWnd; {$ENDIF} end; end; procedure TKCustomHexEditor.SetScrollSpeed(Value: Cardinal); begin Value := MinMax(Integer(Value), cScrollSpeedMin, cScrollSpeedMax); if Value <> FScrollSpeed then begin FScrollSpeed := Value; FScrollTimer.Enabled := False; FScrollTimer.Interval := FScrollSpeed; end; end; procedure TKCustomHexEditor.SetSelEnd(Value: TKHexEditorSelection); begin if (Value.Index <> FSelEnd.Index) or (Value.Digit <> FSelEnd.Digit) then begin FSelEnd := Value; SelectionChanged(False, False); Invalidate; end; end; procedure TKCustomHexEditor.SetSelLength(Value: TKHexEditorSelection); var X: TKHexEditorSelection; begin X := GetSelLength; if (Value.Index <> X.Index) or (Value.Digit <> X.Digit) then begin FSelEnd.Index := FSelStart.Index + Value.Index; FSelEnd.Digit := FSelStart.Digit + Value.Digit; if FSelEnd.Digit >= cHexDigitCount then Inc(FSelEnd.Index); SelectionChanged(False, False); Invalidate; end; end; procedure TKCustomHexEditor.SetSelStart(Value: TKHexEditorSelection); begin if (Value.Index <> FSelStart.Index) or (Value.Digit <> FSelStart.Digit) then begin FSelStart := Value; SelectionChanged(False, False); Invalidate; end; end; procedure TKCustomHexEditor.SetTopLine(Value: Int64); begin Value := MinMax(Value, 0, GetMaxTopLine); if Value <> FTopLine then ScrollBy(0, Value - FTopLine, True); end; procedure TKCustomHexEditor.SetUndoLimit(Value: Integer); begin Value := MinMax(Value, cUndoLimitMin, cUndoLimitMax); if Value <> FUndoList.Limit then begin FUndoList.Limit := Value; FRedoList.Limit := Value; end; end; procedure TKCustomHexEditor.ShowEditorCaret; var P: TKPoint64; begin P := SelToPoint(FSelEnd, FEditArea); {$IFDEF FPC}SetCaretPosEx(Handle,{$ELSE}SetCaretPos({$ENDIF} P.X, P.Y + 1); ShowCaret(Handle); end; procedure TKCustomHexEditor.UndoChange(Sender: TObject; ItemReason: TKHexEditorChangeReason); begin if (Sender = FUndoList) and (ItemReason <> crCaretPos) then DoChange; end; procedure TKCustomHexEditor.UpdateEditorCaret(Recreate: Boolean = False); var CW, CH: Integer; begin Include(FStates, elCaretUpdate); try if Enabled and Focused and (FEditArea in [eaDigits, eaText]) and not (csDesigning in ComponentState) and not (eoDisableCaret in FOptions) then begin if not (elCaretVisible in FStates) or Recreate then begin if elOverwrite in FStates then CW := FCharWidth else CW := Max(2, (Abs(Font.Height) * 2) div 25); if edHorzLines in FDrawStyles then CH := FCharHeight - Max(1, FCharHeight div 25) else CH := FCharHeight; {$IFDEF FPC} CreateCaret(Handle, 0, CW, CH - 2); {$ELSE} if CreateCaret(Handle, 0, CW, CH - 2) then {$ENDIF} Include(FStates, elCaretVisible); Invalidate; end; if elCaretVisible in FStates then ShowEditorCaret; end else if elCaretVisible in FStates then begin Exclude(FStates, elCaretVisible); HideEditorCaret; {$IFDEF FPC} DestroyCaret(Handle); {$ELSE} DestroyCaret; {$ENDIF} end; finally Exclude(FStates, elCaretUpdate); end; end; procedure TKCustomHexEditor.UpdateCharMetrics; var DC: HDC; TM: TTextMetric; begin DC := GetDC(0); try SelectObject(DC, Font.Handle); GetTextMetrics(DC, TM); FTotalCharSpacing := FCharSpacing * 2; // ensure even char spacing because of PointToSel if TM.tmAveCharWidth and 1 <> 0 then Inc(FTotalCharSpacing); FCharWidth := TM.tmAveCharWidth + FTotalCharSpacing; FCharHeight := TM.tmHeight * FLineHeightPercent div 100; finally ReleaseDC(0, DC); end; end; procedure TKCustomHexEditor.UpdateMouseCursor; var P: TPoint; begin P := ScreenToClient(Mouse.CursorPos); SetMouseCursor(P.X, P.Y); end; procedure TKCustomHexEditor.UpdateScrollRange; var I, CharCount: Integer; AD: TKHexEditorAreaDimensions; SI: TScrollInfo; SBVisible: Boolean; begin if HandleAllocated then begin if FInUpdateScrollRange then begin PostLateUpdate(FillMessage(KM_SCROLL, 0, 0), True); Exit; end; FInUpdateScrollRange := True; try AD := GetAreaDimensions; // update horizontal scroll position I := FLeftChar - GetMaxLeftChar(AD.TotalHorz); if I > 0 then Dec(FLeftChar, I); FLeftChar := Max(FLeftChar, 0); // update vertical scroll position I := FTopLine - GetMaxTopLine(AD.TotalVert); if I > 0 then Dec(FTopLine, I); FTopLine := Max(FTopLine, 0); if FScrollBars in [ssBoth, ssHorizontal, ssVertical] then begin SI.cbSize := SizeOf(TScrollInfo); SI.fMask := SIF_RANGE or SIF_PAGE or SIF_POS {$IFDEF UNIX}or SIF_UPDATEPOLICY{$ENDIF}; SI.nMin := 0; {$IFDEF UNIX} SI.ntrackPos := SB_POLICY_CONTINUOUS; {$ENDIF} if FScrollBars in [ssBoth, ssHorizontal] then begin CharCount := Max(GetClientWidthChars, 1); SBVisible := CharCount < AD.TotalHorz; ShowScrollBar(Handle, SB_HORZ, SBVisible); if SBVisible then begin SI.nMax := AD.TotalHorz{$IFNDEF FPC}- 1{$ENDIF}; SI.nPage := CharCount; SI.nPos := FLeftChar; SetScrollInfo(Handle, SB_HORZ, SI, True); end; end else ShowScrollBar(Handle, SB_HORZ, False); if FScrollBars in [ssBoth, ssVertical] then begin CharCount := Max(GetClientHeightChars, 1); SBVisible := CharCount < AD.TotalVert; ShowScrollBar(Handle, SB_VERT, SBVisible); if SBVisible then begin SI.nMax := AD.TotalVert{$IFNDEF FPC}- 1{$ENDIF}; SI.nPage := CharCount; SI.nPos := FTopLine; SetScrollInfo(Handle, SB_VERT, SI, True); end; end else ShowScrollBar(Handle, SB_VERT, False); end; UpdateEditorCaret(True); Invalidate; InvalidatePageSetup; finally FInUpdateScrollRange := False; end; end; end; procedure TKCustomHexEditor.UpdateSelEnd(Point: TKPoint64; ClipToClient: Boolean); var R: TRect; Sel: TKHexEditorSelection; begin if ClipToClient then begin R := GetModifiedClientRect; Dec(R.Right, FCharWidth); Dec(R.Bottom, FCharHeight); if CanScroll(ecScrollLeft) and (Point.X < R.Left) then Point.X := R.Left else if CanScroll(ecScrollRight) and (Point.X > R.Right) then Point.X := R.Right; if CanScroll(ecScrollUp) and (Point.Y < R.Top) then Point.Y := R.Top else if CanScroll(ecScrollDown) and (Point.Y > R.Bottom) then Point.Y := R.Bottom; end; Sel := PointToSel(Point, True, FEditArea); if (Sel.Index <> cInvalidIndex) and ((Sel.Index <> FSelEnd.Index) or (Sel.Digit <> FSelEnd.Digit)) then begin FSelEnd := Sel; UpdateEditorCaret; Invalidate; InvalidatePageSetup; end; end; procedure TKCustomHexEditor.UpdateSize; begin UpdateScrollRange; end; procedure TKCustomHexEditor.ValidateSelection(var Value: TKHexEditorSelection; Area: TKHexEditorArea); begin if Area <> eaNone then begin Value.Index := MinMax(Value.Index, 0, FSize); if Value.Index = FSize then Value.Digit := 0 else Value.Digit := MinMax(Value.Digit, 0, cHexDigitCount - 1); end else Value := MakeSelection(cInvalidIndex, 0); end; {$IFNDEF FPC} procedure TKCustomHexEditor.WMDropFiles(var Msg: TLMessage); var I, FileCount: Integer; PathName: array[0..260] of Char; Point: TPoint; FilesList: TStringList; begin try if Assigned(FOnDropFiles) then begin FilesList := TStringList.Create; try FileCount := DragQueryFile(THandle(Msg.wParam), Cardinal(-1), nil, 0); DragQueryPoint(THandle(Msg.wParam), Point); for i := 0 to FileCount - 1 do begin DragQueryFile(THandle(Msg.wParam), I, PathName, SizeOf(PathName)); FilesList.Add(PathName); end; FOnDropFiles(Self, Point.X, Point.Y, FilesList); finally FilesList.Free; end; end; finally Msg.Result := 0; DragFinish(THandle(Msg.wParam)); end; end; {$ENDIF} procedure TKCustomHexEditor.WMEraseBkgnd(var Msg: TLMessage); begin Msg.Result := 1; end; procedure TKCustomHexEditor.WMGetDlgCode(var Msg: TLMNoParams); begin Msg.Result := DLGC_WANTARROWS; end; procedure TKCustomHexEditor.WMHScroll(var Msg: TLMHScroll); begin SafeSetFocus; ModifyScrollBar(SB_HORZ, Msg.ScrollCode, Msg.Pos, True); end; procedure TKCustomHexEditor.WMKillFocus(var Msg: TLMKillFocus); begin inherited; ExecuteCommand(ecLostFocus); end; procedure TKCustomHexEditor.WMSetFocus(var Msg: TLMSetFocus); begin inherited; ExecuteCommand(ecGotFocus); end; procedure TKCustomHexEditor.WMVScroll(var Msg: TLMVScroll); begin SafeSetFocus; ModifyScrollBar(SB_VERT, Msg.ScrollCode, Msg.Pos, True); end; end. tomboy-ng_0.39-1/kcontrols/source/kmemortf.pas0000644000175000017500000043514614346341266021315 0ustar dbannondbannon{ @abstract(This file is part of the KControls component suite for Delphi and Lazarus.) @author(Tomas Krysl) Copyright (c) 2020 Tomas Krysl

License:
This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html. } unit kmemortf; // lowercase name because of Lazarus/Linux {$include kcontrols.inc} {$WEAKPACKAGEUNIT ON} interface uses Classes, Contnrs, Graphics, Controls, Types, KControls, KFunctions, KGraphics, KMemo; type TKMemoRTFCtrlMethod = procedure(ACtrl: Integer; var AText: AnsiString; AParam: Integer) of object; { Specifies the RTF control word descriptor. Is only used by RTF reader. } TKMemoRTFCtrl = class(TObject) private FCode: Integer; FCtrl: AnsiString; FMethod: TKMemoRTFCtrlMethod; public constructor Create; property Code: Integer read FCode write FCode; property Ctrl: AnsiString read FCtrl write FCtrl; property Method: TKMemoRTFCtrlMethod read FMethod write FMethod; end; { Specifies the RTF control word table. Is only used by RTF reader. Maybe using hash table would be even faster. } TKMemoRTFCtrlTable = class(TObjectList) private function GetItem(Index: Integer): TKMemoRTFCtrl; procedure SetItem(Index: Integer; const Value: TKMemoRTFCtrl); public procedure AddCtrl(const ACtrl: AnsiString; ACode: Integer; AMethod: TKMemoRTFCtrlMethod); function FindByCtrl(const ACtrl: AnsiString): TKMemoRtfCtrl; virtual; procedure SortTable; virtual; property Items[Index: Integer]: TKMemoRTFCtrl read GetItem write SetItem; default; end; { Specifies the RTF color descriptor. } TKMemoRTFColor = class(TObject) private FColorRec: TKColorRec; public constructor Create; property ColorRec: TKColorRec read FColorRec write FColorRec; property Red: Byte read FColorRec.R write FColorRec.R; property Green: Byte read FColorRec.G write FColorRec.G; property Blue: Byte read FColorRec.B write FColorRec.B; end; { Specifies the RTF color table. } TKMemoRTFColorTable = class(TObjectList) private function GetItem(Index: Integer): TKMemoRTFColor; procedure SetItem(Index: Integer; const Value: TKMemoRTFColor); public procedure AddColor(AColor: TColor); virtual; function GetColor(AIndex: Integer): TColor; virtual; function GetIndex(AColor: TColor): Integer; virtual; property Items[Index: Integer]: TKMemoRTFColor read GetItem write SetItem; default; end; { Specifies the RTF font descriptor. } TKMemoRTFFont = class(TObject) private FFont: TFont; FFontIndex: Integer; public constructor Create; destructor Destroy; override; property Font: TFont read FFont; property FontIndex: Integer read FFontIndex write FFontIndex; end; { Specifies the RTF font table. } TKMemoRTFFontTable = class(TObjectList) private function GetItem(Index: Integer): TKMemoRTFFont; procedure SetItem(Index: Integer; const Value: TKMemoRTFFont); public function AddFont(AFont: TFont): Integer; virtual; function GetFont(AFontIndex: Integer): TFont; virtual; function GetIndex(AFont: TFont): Integer; virtual; property Items[Index: Integer]: TKMemoRTFFont read GetItem write SetItem; default; end; { Specifies the RTF list level descriptor. } TKMemoRTFListLevel = class(TObject) private FFirstIndent: Integer; FJustify: Integer; FLeftIndent: Integer; FNumberType: Integer; FStartAt: Integer; FNumberingFormat: TKMemoNumberingFormat; FFontIndex: Integer; function GetNumberTypeAsNumbering: TKMemoParaNumbering; procedure SetNumberTypeAsNumbering(const Value: TKMemoParaNumbering); public constructor Create; destructor Destroy; override; property FirstIndent: Integer read FFirstIndent write FFirstIndent; property FontIndex: Integer read FFontIndex write FFontIndex; property Justify: Integer read FJustify write FJustify; property LeftIndent: Integer read FLeftIndent write FLeftIndent; property NumberingFormat: TKMemoNumberingFormat read FNumberingFormat; property NumberType: Integer read FNumberType write FNumberType; property NumberTypeAsNumbering: TKMemoParaNumbering read GetNumberTypeAsNumbering write SetNumberTypeAsNumbering; property StartAt: Integer read FStartAt write FStartAt; end; { Specifies the RTF list levels. } TKMemoRTFListLevels = class(TObjectList) private function GetItem(Index: Integer): TKMemoRTFListLevel; procedure SetItem(Index: Integer; const Value: TKMemoRTFListLevel); public property Items[Index: Integer]: TKMemoRTFListLevel read GetItem write SetItem; default; end; TKMemoRTFListTable = class; { Specifies the RTF list descriptor. } TKMemoRTFList = class(TObject) private FID: Integer; FLevels: TKMemoRTFListLevels; public constructor Create(AParent: TKMemoRTFListTable); destructor Destroy; override; property ID: Integer read FID write FID; property Levels: TKMemoRTFListLevels read FLevels; end; { Specifies the RTF list table. } TKMemoRTFListTable = class(TObjectList) private FOverrides: TKMemoDictionary; function GetItem(Index: Integer): TKMemoRTFList; procedure SetItem(Index: Integer; const Value: TKMemoRTFList); protected FIDCounter: Integer; public constructor Create; destructor Destroy; override; procedure AssignFromListTable(AListTable: TKMemoListTable; AFontTable: TKMemoRTFFontTable); procedure AssignToListTable(AListTable: TKMemoListTable; AFontTable: TKMemoRTFFontTable); function FindByID(AListID: Integer): Integer; function FindByIndex(AIndex: Integer): Integer; function IDByIndex(AIndex: Integer): Integer; function NextID: Integer; property Items[Index: Integer]: TKMemoRTFList read GetItem write SetItem; default; property Overrides: TKMemoDictionary read FOverrides; end; { Specifies the supported RTF shape object type. } TKMemoRTFShapeContentType = (sctUnknown, sctTextBox, sctImage, sctRectangle, sctText); { Specifies the RTF shape object since KMemo has no generic drawing object support. } TKMemoRTFShape = class(TObject) private FBackground: Boolean; FContentPosition: TKRect; FContentType: TKMemoRTFShapeContentType; FCtrlName: AnsiString; FCtrlValue: AnsiString; FFitToShape: Boolean; FFitToText: Boolean; FHorzPosCode: Integer; FBlock: TKMemoBlock; FStyle: TKMemoBlockStyle; FVertPosCode: Integer; FWrap: Integer; FWrapSide: Integer; FFillBlip: Boolean; procedure SetWrap(const Value: Integer); procedure SetWrapSide(const Value: Integer); function GetWrap: Integer; function GetWrapSide: Integer; protected procedure RTFWrapToWrapMode; virtual; procedure WrapModeToRTFWrap; virtual; public constructor Create; destructor Destroy; override; property Background: Boolean read FBackground write FBackground; property Block: TKMemoBlock read FBlock write FBlock; property ContentPosition: TKRect read FContentPosition; property ContentType: TKMemoRTFShapeContentType read FContentType write FContentType; property CtrlName: AnsiString read FCtrlName write FCtrlName; property CtrlValue: AnsiString read FCtrlValue write FCtrlValue; property FillBlip: Boolean read FFillBlip write FFillBlip; property FitToShape: Boolean read FFitToShape write FFitToShape; property FitToText: Boolean read FFitToText write FFitToText; property HorzPosCode: Integer read FHorzPosCode write FHorzPosCode; property Style: TKMemoBlockStyle read FStyle; property VertPosCode: Integer read FVertPosCode write FVertPosCode; property Wrap: Integer read GetWrap write SetWrap; property WrapSide: Integer read GetWrapSide write SetWrapSide; end; TKMemoRTFGroup = (rgNone, rgUnknown, rgColorTable, rgField, rgFieldInst, rgFieldResult, rgFontTable, rgFooter, rgHeader, rgInfo, rgListTable, rgList, rgListLevel, rgListLevelText, rgListOverrideTable, rgListOverride, rgPageBackground, rgPicture, rgPicProp, rgShape, rgShapeInst, rgShapePict, rgStyleSheet, rgTextBox); { Specifies the RTF reader state. This class is used by RTF reader to store reader state on the stack. } TKMemoRTFState = class(TObject) private FTextStyle: TKMemoTextStyle; FParaStyle: TKMemoParaStyle; FGroup: TKMemoRTFGroup; public constructor Create; destructor Destroy; override; procedure Assign(ASource: TKmemoRTFState); virtual; property Group: TKMemoRTFGroup read FGroup write FGroup; property ParaStyle: TKMemoParaStyle read FParaStyle write FParaStyle; property TextStyle: TKMemoTextStyle read FTextStyle write FTextStyle; end; { Specifies the stack for the RTF reader state. } TKMemoRTFStack = class(TStack) public function Push(AObject: TKMemoRTFState): TKMemoRTFState; function Pop: TKMemoRTFState; function Peek: TKMemoRTFState; end; TKMemoRTFHeaderProp = (rphNone, rphRtf, rphCodePage, rphDefaultFont, rphIgnoreCharsAfterUnicode, rphFontTable, rphColorTable, rphStyleSheet); TKMemoRTFDocumentProp = (rpdNone, rpdFooter, rpdFooterLeft, rpdFooterRight, rpdHeader, rpdHeaderLeft, rpdHeaderRight, rpdInfo); TKMemoRTFColorProp = (rpcNone, rpcRed, rpcGreen, rpcBlue); TKMemoRTFFieldProp = (rpfiNone, rpfiField, rpfiResult); TKMemoRTFFontProp = (rpfNone, rpfIndex, rpfCharset, rpfPitch); TKMemoRTFImageProp = (rpiNone, rpiPict, rpiJPeg, rpiPng, rpiEmf, rpiWmf, rpiWidth, rpiHeight, rpiCropBottom, rpiCropLeft, rpiCropRight, rpiCropTop, rpiReqWidth, rpiReqHeight, rpiScaleX, rpiScaleY); TKMemoRTFListProp = (rplNone, rplList, rplListOverride, rplListLevel, rplListId, rplListIndex, rplListText, rplLevelStartAt, rplLevelNumberType, rplLevelJustify, rplLevelText, rplLevelFontIndex, rplLevelFirstIndent, rplLevelLeftIndent, rplPnText); TKMemoRTFParaProp = (rppNone, rppParD, rppIndentFirst, rppIndentBottom, rppIndentLeft, rppIndentRight, rppIndentTop, rppAlignLeft, rppAlignCenter, rppAlignRight, rppAlignJustify, rppBackColor, rppNoWordWrap, rppBorderBottom, rppBorderLeft, rppBorderRight, rppBorderTop, rppBorderAll, rppBorderWidth, rppBorderNone, rppBorderRadius, rppBorderColor, rppLineSpacing, rppLineSpacingMode, rppPar, rppListIndex, rppListLevel, rppListStartAt); TKMemoRTFShapeProp = (rpsNone, rpsShape, rpsBottom, rpsLeft, rpsRight, rpsTop, rpsXColumn, rpsYPara, rpsWrap, rpsWrapSide, rpsSn, rpsSv, rpsShapeText); TKMemoRTFSpecialCharProp = (rpscNone, rpscTab, rpscLquote, rpscRQuote, rpscLDblQuote, rpscRDblQuote, rpscEnDash, rpscEmDash, rpscBullet, rpscNBSP, rpscEmSpace, rpscEnSpace, rpscAnsiChar, rpscUnicodeChar); TKMemoRTFTableProp = (rptbNone, rptbRowBegin, rptbCellEnd, rptbRowEnd, rptbLastRow, rptbRowPaddBottom, rptbRowPaddLeft, rptbRowPaddRight, rptbRowPaddTop, rptbBorderBottom, rptbBorderLeft, rptbPaddAll, rptbBorderRight, rptbBorderTop, rptbBorderWidth, rptbBorderNone, rptbBorderColor, rptbBackColor, rptbHorzMergeBegin, rptbHorzMerge, rptbVertMergeBegin, rptbVertMerge, rptbCellPaddBottom, rptbCellPaddLeft, rptbCellPaddRight, rptbCellPaddTop, rptbCellWidth, rptbCellX); TKMemoRTFTextProp = (rptNone, rptPlain, rptFontIndex, rptBold, rptItalic, rptUnderline, rptStrikeout, rptCaps, rptSmallCaps, rptFontSize, rptForeColor, rptBackColor, rptSubscript, rptSuperscript); TKMemoRTFUnknownProp = (rpuNone, rpuUnknownSym, rpuPageBackground, rpuPicProp, rpuShapeInst, rpuShapePict, rpuNonShapePict, rpuFieldInst, rpuListTable, rpuListOverrideTable); { Specifies the common ancestor for RTF streaming. } TKMemoRTFFiler = class(TObject) private protected FMemo: TKCustomMemo; FStream: TStream; FTwipsPerPixelX, FTwipsPerPixelY: Double; public constructor Create(AMemo: TKCustomMemo); virtual; function EMUToPoints(AValue: Integer): Integer; virtual; function PointsToEMU(AValue: Integer): Integer; virtual; function PixelsToTwipsX(AValue: Integer): Integer; virtual; function PixelsToTwipsY(AValue: Integer): Integer; virtual; function TwipsToPixelsX(AValue: Integer): Integer; virtual; function TwipsToPixelsY(AValue: Integer): Integer; virtual; end; { Specifies the RTF reader. } TKMemoRTFReader = class(TKMemoRTFFiler) private function GetActiveFont: TKMemoRTFFont; function GetActiveColor: TKMemoRTFColor; function GetActiveImage: TKMemoImageBlock; function GetActiveShape: TKMemoRTFShape; function GetActiveContainer: TKMemoContainer; function GetActiveTable: TKMemoTable; function GetActiveList: TKMemoRTFList; function GetActiveListLevel: TKMemoRTFListLevel; function GetActiveListOverride: TKMemoDictionaryItem; protected FActiveBlocks: TKMemoBlocks; FActiveColor: TKMemoRTFColor; FActiveContainer: TKMemoContainer; FActiveFont: TKMemoRTFFont; FActiveImage: TKMemoImageBlock; FActiveImageClass: TGraphicClass; FActiveImageIsEMF: Boolean; FActiveList: TKMemoRTFList; FActiveListLevel: TKMemoRTFListLevel; FActiveListOverride: TKMemoDictionaryItem; FActiveParaBorder: TAlign; FActiveShape: TKMemoRTFShape; FActiveString: TKString; FActiveState: TKMemoRTFState; FActiveTable: TKMemoTable; FActiveTableBorder: TAlign; FActiveTableCell: TKMemoTableCell; FActiveTableCellXPos: Integer; FActiveTableCol: Integer; FActiveTableColCount: Integer; FActiveTableLastRow: Boolean; FActiveTableRow: TKMemoTableRow; FActiveTableRowPadd: TRect; FActiveText: TKMemoTextBlock; FActiveURL: TKString; FAtIndex: TKMemoBlockIndex; FColorTable: TKMemoRTFColorTable; FCtrlTable: TKMemoRTFCtrlTable; FDefaultCodePage: Integer; FDefaultFontIndex: Integer; FFontTable: TKMemoRTFFontTable; FIgnoreChars: Integer; FIgnoreCharsAfterUnicode: Integer; FIndexStack: TKMemoIndexObjectStack; FGraphicClass: TGraphicClass; FListTable: TKMemoRTFListTable; FStack: TKMemoRTFStack; procedure AddText(const APart: TKString); virtual; procedure AddTextToNumberingFormat(const APart: TKString); virtual; procedure ApplyFont(ATextStyle: TKMemoTextStyle; AFontIndex: Integer); virtual; procedure ApplyHighlight(ATextStyle: TKMemoTextStyle; AHighlightCode: Integer); virtual; procedure FillCtrlTable; virtual; function ParamToBool(const AValue: AnsiString): Boolean; virtual; function ParamToColor(const AValue: AnsiString): TColor; virtual; function ParamToInt(const AValue: AnsiString): Integer; virtual; function ParamToEMU(const AValue: AnsiString): Integer; virtual; procedure FlushColor; virtual; procedure FlushContainer; virtual; procedure FlushFont; virtual; procedure FlushHyperlink; virtual; procedure FlushImage; virtual; procedure FlushList; virtual; procedure FlushListLevel; virtual; procedure FlushListOverride; virtual; procedure FlushParagraph; virtual; procedure FlushShape; virtual; procedure FlushTable; virtual; procedure FlushText; virtual; function HighlightCodeToColor(AValue: Integer): TColor; virtual; procedure PopFromStack(ACtrl: Integer; var AText: AnsiString; AParam: Integer); virtual; procedure PushToStack(ACtrl: Integer; var AText: AnsiString; AParam: Integer); virtual; function ReadNext(out ACtrl, AText: AnsiString; out AParam: Int64): Boolean; virtual; procedure ReadColorGroup(ACtrl: Integer; var AText: AnsiString; AParam: Integer); virtual; procedure ReadDocumentGroups(ACtrl: Integer; var AText: AnsiString; AParam: Integer); virtual; procedure ReadFieldGroup(ACtrl: Integer; var AText: AnsiString; AParam: Integer); virtual; procedure ReadFontGroup(ACtrl: Integer; var AText: AnsiString; AParam: Integer); virtual; procedure ReadHeaderGroup(ACtrl: Integer; var AText: AnsiString; AParam: Integer); virtual; procedure ReadListGroup(ACtrl: Integer; var AText: AnsiString; AParam: Integer); virtual; procedure ReadParaFormatting(ACtrl: Integer; var AText: AnsiString; AParam: Integer); virtual; procedure ReadPictureGroup(ACtrl: Integer; var AText: AnsiString; AParam: Integer); virtual; procedure ReadShapeGroup(ACtrl: Integer; var AText: AnsiString; AParam: Integer); virtual; procedure ReadSpecialCharacter(ACtrl: Integer; var AText: AnsiString; AParam: Integer); virtual; procedure ReadStream; virtual; procedure ReadTableFormatting(ACtrl: Integer; var AText: AnsiString; AParam: Integer); virtual; procedure ReadTextFormatting(ACtrl: Integer; var AText: AnsiString; AParam: Integer); virtual; procedure ReadUnknownGroup(ACtrl: Integer; var AText: AnsiString; AParam: Integer); virtual; property ActiveColor: TKMemoRTFColor read GetActiveColor; property ActiveContainer: TKMemoContainer read GetActiveContainer; property ActiveFont: TKMemoRTFFont read GetActiveFont; property ActiveList: TKMemoRTFList read GetActiveList; property ActiveListLevel: TKMemoRTFListLevel read GetActiveListLevel; property ActiveListOverride: TKMemoDictionaryItem read GetActiveListOverride; property ActiveImage: TKMemoImageBlock read GetActiveImage; property ActiveShape: TKMemoRTFShape read GetActiveShape; property ActiveTable: TKMemoTable read GetActiveTable; public constructor Create(AMemo: TKCustomMemo); override; destructor Destroy; override; procedure LoadFromFile(const AFileName: TKString; AActiveBlocks: TKMemoBlocks; AtIndex: TKMemoSelectionIndex); virtual; procedure LoadFromStream(AStream: TStream; AActiveBlocks: TKMemoBlocks; AtIndex: TKMemoSelectionIndex); virtual; end; { Specifies the RTF writer. } TKMemoRTFWriter = class(TKMemoRTFFiler) private FReadableOutput: Boolean; protected FCodePage: Integer; FColorTable: TKMemoRTFColorTable; FFontTable: TKMemoRTFFontTable; FGroupLevel: Integer; FListTable: TKMemoRTFListTable; FSelectedOnly: Boolean; function BoolToParam(AValue: Boolean): AnsiString; virtual; function CanSave(ABlock: TKMemoBlock): Boolean; virtual; function ColorToHighlightCode(AValue: TColor): Integer; virtual; function ColorToParam(AValue: TColor): AnsiString; virtual; function EMUToParam(AValue: Integer): AnsiString; virtual; procedure FillColorTable(ABlocks: TKMemoBlocks); virtual; procedure FillFontTable(ABlocks: TKMemoBlocks); virtual; procedure WriteBackground; virtual; procedure WriteBody(ABlocks: TKMemoBlocks; AInsideOfTable: Boolean); virtual; procedure WriteColorTable; virtual; procedure WriteContainer(ABlock: TKMemoContainer; AInsideTable: Boolean); virtual; procedure WriteCtrl(const ACtrl: AnsiString); procedure WriteCtrlParam(const ACtrl: AnsiString; AParam: Integer); procedure WriteFontTable; virtual; procedure WriteGroupBegin; procedure WriteGroupEnd; procedure WriteHeader(ABlocks: TKMemoBlocks); virtual; procedure WriteHyperlinkBegin(ABlock: TKMemoHyperlink); virtual; procedure WriteHyperlinkEnd; virtual; procedure WriteImage(ABlock: TKmemoImageBlock); virtual; procedure WriteImageBlock(ABlock: TKmemoImageBlock; AInsideTable: Boolean); virtual; procedure WriteListTable; virtual; procedure WriteListText(ANumberBlock: TKMemoTextBlock); virtual; procedure WriteParagraph(ABlock: TKMemoParagraph; AInsideTable: Boolean); virtual; procedure WriteParaStyle(AParaStyle: TKMemoParaStyle); virtual; procedure WritePicture(AImage: TGraphic); virtual; procedure WriteSemiColon; procedure WriteShape(AShape: TKMemoRTFShape; AInsideTable: Boolean); virtual; procedure WriteShapeProp(const APropName, APropValue: AnsiString); virtual; procedure WriteShapeProperties(AShape: TKMemoRTFShape); virtual; procedure WriteShapePropName(const APropName: AnsiString); procedure WriteShapePropValue(const APropValue: AnsiString); procedure WriteSpace; procedure WriteString(const AText: AnsiString); procedure WriteTable(ABlock: TKMemoTable); virtual; procedure WriteTableRowProperties(ATable: TKMemoTable; ARowIndex, ASavedRowIndex: Integer); virtual; procedure WriteTextBlock(ABlock: TKMemoTextBlock; ASelectedOnly: Boolean); virtual; procedure WriteTextStyle(ATextStyle: TKMemoTextStyle); virtual; procedure WriteUnicodeString(const AText: TKString); virtual; procedure WriteUnknownGroup; public constructor Create(AMemo: TKCustomMemo); override; destructor Destroy; override; procedure SaveToFile(const AFileName: TKString; ASelectedOnly: Boolean); virtual; procedure SaveToStream(AStream: TStream; ASelectedOnly: Boolean; AActiveBlocks: TKMemoBlocks = nil); virtual; property ReadableOutput: Boolean read FReadableOutput write FReadableOutput; end; function CharSetToCP(ACharSet: TFontCharSet): Integer; function CPToCharSet(ACodePage: Integer): TFontCharSet; implementation uses Math, SysUtils, KEditCommon, KHexEditor, KRes {$IFDEF FPC} , LCLIntf, LCLProc, LConvEncoding, LCLType, LazUTF8 {$ELSE} , JPeg, Windows {$ENDIF} ; const cRTFHyperlink = 'HYPERLINK'; function CharSetToCP(ACharSet: TFontCharSet): Integer; begin case ACharset of 1: Result := 0; //Default 2: Result := 42; //Symbol 77: Result := 10000; //Mac Roman 78: Result := 10001; //Mac Shift Jis 79: Result := 10003; //Mac Hangul 80: Result := 10008; //Mac GB2312 81: Result := 10002; //Mac Big5 83: Result := 10005; //Mac Hebrew 84: Result := 10004; //Mac Arabic 85: Result := 10006; //Mac Greek 86: Result := 10081; //Mac Turkish 87: Result := 10021; //Mac Thai 88: Result := 10029; //Mac East Europe 89: Result := 10007; //Mac Russian 128: Result := 932; //Shift JIS 129: Result := 949; //Hangul 130: Result := 1361; //Johab 134: Result := 936; //GB2312 136: Result := 950; //Big5 161: Result := 1253; //Greek 162: Result := 1254; //Turkish 163: Result := 1258; //Vietnamese 177: Result := 1255; //Hebrew 178: Result := 1256; //Arabic 186: Result := 1257; //Baltic 204: Result := 1251; //Russian 222: Result := 874; //Thai 238: Result := 1250; //Eastern European 254: Result := 437; //PC 437 255: Result := 850; //OEM else Result := SystemCodePage; //system default end; end; function CPToCharSet(ACodePage: Integer): TFontCharSet; begin case ACodePage of 0: Result := 1; //Default 42: Result := 2; //Symbol 10000: Result := 77; //Mac Roman 10001: Result := 78; //Mac Shift Jis 10003: Result := 79; //Mac Hangul 10008: Result := 80; //Mac GB2312 10002: Result := 81; //Mac Big5 10005: Result := 83; //Mac Hebrew 10004: Result := 84; //Mac Arabic 10006: Result := 85; //Mac Greek 10081: Result := 86; //Mac Turkish 10021: Result := 87; //Mac Thai 10029: Result := 88; //Mac East Europe 10007: Result := 89; //Mac Russian 932: Result := 128; //Shift JIS 949: Result := 129; //Hangul 1361: Result := 130; //Johab 936: Result := 134; //GB2312 950: Result := 136; //Big5 1253: Result := 161; //Greek 1254: Result := 162; //Turkish 1258: Result := 163; //Vietnamese 1255: Result := 177; //Hebrew 1256: Result := 178; //Arabic 1257: Result := 186; //Baltic 1251: Result := 204; //Russian 874: Result := 222; //Thai 1250: Result := 238; //Eastern European 437: Result := 254; //PC 437 850: Result := 255; //OEM else Result := 0; //ANSI end; end; function AdobeSymbolToUTF16(AValue: Integer): Integer; begin case AValue of $20: Result := $0020; //SPACE //space {/$20: Result := $00A0; //NO-BREAK SPACE //space } $21: Result := $0021; //EXCLAMATION MARK //exclam $22: Result := $2200; //FOR ALL //universal $23: Result := $0023; //NUMBER SIGN //numbersign $24: Result := $2203; //THERE EXISTS //existential $25: Result := $0025; //PERCENT SIGN //percent $26: Result := $0026; //AMPERSAND //ampersand $27: Result := $220B; //CONTAINS AS MEMBER //suchthat $28: Result := $0028; //LEFT PARENTHESIS //parenleft $29: Result := $0029; //RIGHT PARENTHESIS //parenright $2A: Result := $2217; //ASTERISK OPERATOR //asteriskmath $2B: Result := $002B; //PLUS SIGN //plus $2C: Result := $002C; //COMMA //comma $2D: Result := $2212; //MINUS SIGN //minus $2E: Result := $002E; //FULL STOP //period $2F: Result := $002F; //SOLIDUS //slash $30: Result := $0030; //DIGIT ZERO //zero $31: Result := $0031; //DIGIT ONE //one $32: Result := $0032; //DIGIT TWO //two $33: Result := $0033; //DIGIT THREE //three $34: Result := $0034; //DIGIT FOUR //four $35: Result := $0035; //DIGIT FIVE //five $36: Result := $0036; //DIGIT SIX //six $37: Result := $0037; //DIGIT SEVEN //seven $38: Result := $0038; //DIGIT EIGHT //eight $39: Result := $0039; //DIGIT NINE //nine $3A: Result := $003A; //COLON //colon $3B: Result := $003B; //SEMICOLON //semicolon $3C: Result := $003C; //LESS-THAN SIGN //less $3D: Result := $003D; //EQUALS SIGN //equal $3E: Result := $003E; //GREATER-THAN SIGN //greater $3F: Result := $003F; //QUESTION MARK //question $40: Result := $2245; //APPROXIMATELY EQUAL TO //congruent $41: Result := $0391; //GREEK CAPITAL LETTER ALPHA //Alpha $42: Result := $0392; //GREEK CAPITAL LETTER BETA //Beta $43: Result := $03A7; //GREEK CAPITAL LETTER CHI //Chi $44: Result := $0394; //GREEK CAPITAL LETTER DELTA //Delta {/$44: Result := $2206; //INCREMENT //Delta} $45: Result := $0395; //GREEK CAPITAL LETTER EPSILON //Epsilon $46: Result := $03A6; //GREEK CAPITAL LETTER PHI //Phi $47: Result := $0393; //GREEK CAPITAL LETTER GAMMA //Gamma $48: Result := $0397; //GREEK CAPITAL LETTER ETA //Eta $49: Result := $0399; //GREEK CAPITAL LETTER IOTA //Iota $4A: Result := $03D1; //GREEK THETA SYMBOL //theta1 $4B: Result := $039A; //GREEK CAPITAL LETTER KAPPA //Kappa $4C: Result := $039B; //GREEK CAPITAL LETTER LAMDA //Lambda $4D: Result := $039C; //GREEK CAPITAL LETTER MU //Mu $4E: Result := $039D; //GREEK CAPITAL LETTER NU //Nu $4F: Result := $039F; //GREEK CAPITAL LETTER OMICRON //Omicron $50: Result := $03A0; //GREEK CAPITAL LETTER PI //Pi $51: Result := $0398; //GREEK CAPITAL LETTER THETA //Theta $52: Result := $03A1; //GREEK CAPITAL LETTER RHO //Rho $53: Result := $03A3; //GREEK CAPITAL LETTER SIGMA //Sigma $54: Result := $03A4; //GREEK CAPITAL LETTER TAU //Tau $55: Result := $03A5; //GREEK CAPITAL LETTER UPSILON //Upsilon $56: Result := $03C2; //GREEK SMALL LETTER FINAL SIGMA //sigma1 $57: Result := $03A9; //GREEK CAPITAL LETTER OMEGA //Omega {/$57: Result := $2126; //OHM SIGN //Omega} $58: Result := $039E; //GREEK CAPITAL LETTER XI //Xi $59: Result := $03A8; //GREEK CAPITAL LETTER PSI //Psi $5A: Result := $0396; //GREEK CAPITAL LETTER ZETA //Zeta $5B: Result := $005B; //LEFT SQUARE BRACKET //bracketleft $5C: Result := $2234; //THEREFORE //therefore $5D: Result := $005D; //RIGHT SQUARE BRACKET //bracketright $5E: Result := $22A5; //UP TACK //perpendicular $5F: Result := $005F; //LOW LINE //underscore $60: Result := $F8E5; //RADICAL EXTENDER //radicalex (CUS) $61: Result := $03B1; //GREEK SMALL LETTER ALPHA //alpha $62: Result := $03B2; //GREEK SMALL LETTER BETA //beta $63: Result := $03C7; //GREEK SMALL LETTER CHI //chi $64: Result := $03B4; //GREEK SMALL LETTER DELTA //delta $65: Result := $03B5; //GREEK SMALL LETTER EPSILON //epsilon $66: Result := $03C6; //GREEK SMALL LETTER PHI //phi $67: Result := $03B3; //GREEK SMALL LETTER GAMMA //gamma $68: Result := $03B7; //GREEK SMALL LETTER ETA //eta $69: Result := $03B9; //GREEK SMALL LETTER IOTA //iota $6A: Result := $03D5; //GREEK PHI SYMBOL //phi1 $6B: Result := $03BA; //GREEK SMALL LETTER KAPPA //kappa $6C: Result := $03BB; //GREEK SMALL LETTER LAMDA //lambda $6D: Result := $00B5; //MICRO SIGN //mu {/$6D: Result := $03BC; //GREEK SMALL LETTER MU //mu} $6E: Result := $03BD; //GREEK SMALL LETTER NU //nu $6F: Result := $03BF; //GREEK SMALL LETTER OMICRON //omicron $70: Result := $03C0; //GREEK SMALL LETTER PI //pi $71: Result := $03B8; //GREEK SMALL LETTER THETA //theta $72: Result := $03C1; //GREEK SMALL LETTER RHO //rho $73: Result := $03C3; //GREEK SMALL LETTER SIGMA //sigma $74: Result := $03C4; //GREEK SMALL LETTER TAU //tau $75: Result := $03C5; //GREEK SMALL LETTER UPSILON //upsilon $76: Result := $03D6; //GREEK PI SYMBOL //omega1 $77: Result := $03C9; //GREEK SMALL LETTER OMEGA //omega $78: Result := $03BE; //GREEK SMALL LETTER XI //xi $79: Result := $03C8; //GREEK SMALL LETTER PSI //psi $7A: Result := $03B6; //GREEK SMALL LETTER ZETA //zeta $7B: Result := $007B; //LEFT CURLY BRACKET //braceleft $7C: Result := $007C; //VERTICAL LINE //bar $7D: Result := $007D; //RIGHT CURLY BRACKET //braceright $7E: Result := $007E; //TILDE OPERATOR //similar $A0: Result := $20AC; //EURO SIGN //Euro $A1: Result := $03D2; //GREEK UPSILON WITH HOOK SYMBOL //Upsilon1 $A2: Result := $2032; //PRIME //minute $A3: Result := $2264; //LESS-THAN OR EQUAL TO //lessequal $A4: Result := $2044; //FRACTION SLASH //fraction {/$A4: Result := $2215; //DIVISION SLASH //fraction} $A5: Result := $221E; //INFINITY //infinity $A6: Result := $0192; //LATIN SMALL LETTER F WITH HOOK //florin $A7: Result := $2663; //BLACK CLUB SUIT //club $A8: Result := $2666; //BLACK DIAMOND SUIT //diamond $A9: Result := $2665; //BLACK HEART SUIT //heart $AA: Result := $2660; //BLACK SPADE SUIT //spade $AB: Result := $2194; //LEFT RIGHT ARROW //arrowboth $AC: Result := $2190; //LEFTWARDS ARROW //arrowleft $AD: Result := $2191; //UPWARDS ARROW //arrowup $AE: Result := $2192; //RIGHTWARDS ARROW //arrowright $AF: Result := $2193; //DOWNWARDS ARROW //arrowdown $B0: Result := $00B0; //DEGREE SIGN //degree $B1: Result := $00B1; //PLUS-MINUS SIGN //plusminus $B2: Result := $2033; //DOUBLE PRIME //second $B3: Result := $2265; //GREATER-THAN OR EQUAL TO //greaterequal $B4: Result := $00D7; //MULTIPLICATION SIGN //multiply $B5: Result := $221D; //PROPORTIONAL TO //proportional $B6: Result := $2202; //PARTIAL DIFFERENTIAL //partialdiff $B7: Result := $2022; //BULLET //bullet $B8: Result := $00F7; //DIVISION SIGN //divide $B9: Result := $2260; //NOT EQUAL TO //notequal $BA: Result := $2261; //IDENTICAL TO //equivalence $BB: Result := $2248; //ALMOST EQUAL TO //approxequal $BC: Result := $2026; //HORIZONTAL ELLIPSIS //ellipsis $BD: Result := $F8E6; //VERTICAL ARROW EXTENDER //arrowvertex (CUS) $BE: Result := $F8E7; //HORIZONTAL ARROW EXTENDER //arrowhorizex (CUS) $BF: Result := $21B5; //DOWNWARDS ARROW WITH CORNER LEFTWARDS //carriagereturn $C0: Result := $2135; //ALEF SYMBOL //aleph $C1: Result := $2111; //BLACK-LETTER CAPITAL I //Ifraktur $C2: Result := $211C; //BLACK-LETTER CAPITAL R //Rfraktur $C3: Result := $2118; //SCRIPT CAPITAL P //weierstrass $C4: Result := $2297; //CIRCLED TIMES //circlemultiply $C5: Result := $2295; //CIRCLED PLUS //circleplus $C6: Result := $2205; //EMPTY SET //emptyset $C7: Result := $2229; //INTERSECTION //intersection $C8: Result := $222A; //UNION //union $C9: Result := $2283; //SUPERSET OF //propersuperset $CA: Result := $2287; //SUPERSET OF OR EQUAL TO //reflexsuperset $CB: Result := $2284; //NOT A SUBSET OF //notsubset $CC: Result := $2282; //SUBSET OF //propersubset $CD: Result := $2286; //SUBSET OF OR EQUAL TO //reflexsubset $CE: Result := $2208; //ELEMENT OF //element $CF: Result := $2209; //NOT AN ELEMENT OF //notelement $D0: Result := $2220; //ANGLE //angle $D1: Result := $2207; //NABLA //gradient $D2: Result := $F6DA; //REGISTERED SIGN SERIF //registerserif (CUS) $D3: Result := $F6D9; //COPYRIGHT SIGN SERIF //copyrightserif (CUS) $D4: Result := $F6DB; //TRADE MARK SIGN SERIF //trademarkserif (CUS) $D5: Result := $220F; //N-ARY PRODUCT //product $D6: Result := $221A; //SQUARE ROOT //radical $D7: Result := $22C5; //DOT OPERATOR //dotmath $D8: Result := $00AC; //NOT SIGN //logicalnot $D9: Result := $2227; //LOGICAL AND //logicaland $DA: Result := $2228; //LOGICAL OR //logicalor $DB: Result := $21D4; //LEFT RIGHT DOUBLE ARROW //arrowdblboth $DC: Result := $21D0; //LEFTWARDS DOUBLE ARROW //arrowdblleft $DD: Result := $21D1; //UPWARDS DOUBLE ARROW //arrowdblup $DE: Result := $21D2; //RIGHTWARDS DOUBLE ARROW //arrowdblright $DF: Result := $21D3; //DOWNWARDS DOUBLE ARROW //arrowdbldown $E0: Result := $25CA; //LOZENGE //lozenge $E1: Result := $2329; //LEFT-POINTING ANGLE BRACKET //angleleft $E2: Result := $F8E8; //REGISTERED SIGN SANS SERIF //registersans (CUS) $E3: Result := $F8E9; //COPYRIGHT SIGN SANS SERIF //copyrightsans (CUS) $E4: Result := $F8EA; //TRADE MARK SIGN SANS SERIF //trademarksans (CUS) $E5: Result := $2211; //N-ARY SUMMATION //summation $E6: Result := $F8EB; //LEFT PAREN TOP //parenlefttp (CUS) $E7: Result := $F8EC; //LEFT PAREN EXTENDER //parenleftex (CUS) $E8: Result := $F8ED; //LEFT PAREN BOTTOM //parenleftbt (CUS) $E9: Result := $F8EE; //LEFT SQUARE BRACKET TOP //bracketlefttp (CUS) $EA: Result := $F8EF; //LEFT SQUARE BRACKET EXTENDER //bracketleftex (CUS) $EB: Result := $F8F0; //LEFT SQUARE BRACKET BOTTOM //bracketleftbt (CUS) $EC: Result := $F8F1; //LEFT CURLY BRACKET TOP //bracelefttp (CUS) $ED: Result := $F8F2; //LEFT CURLY BRACKET MID //braceleftmid (CUS) $EE: Result := $F8F3; //LEFT CURLY BRACKET BOTTOM //braceleftbt (CUS) $EF: Result := $F8F4; //CURLY BRACKET EXTENDER //braceex (CUS) $F1: Result := $232A; //RIGHT-POINTING ANGLE BRACKET //angleright $F2: Result := $222B; //INTEGRAL //integral $F3: Result := $2320; //TOP HALF INTEGRAL //integraltp $F4: Result := $F8F5; //INTEGRAL EXTENDER //integralex (CUS) $F5: Result := $2321; //BOTTOM HALF INTEGRAL //integralbt $F6: Result := $F8F6; //RIGHT PAREN TOP //parenrighttp (CUS) $F7: Result := $F8F7; //RIGHT PAREN EXTENDER //parenrightex (CUS) $F8: Result := $F8F8; //RIGHT PAREN BOTTOM //parenrightbt (CUS) $F9: Result := $F8F9; //RIGHT SQUARE BRACKET TOP //bracketrighttp (CUS) $FA: Result := $F8FA; //RIGHT SQUARE BRACKET EXTENDER //bracketrightex (CUS) $FB: Result := $F8FB; //RIGHT SQUARE BRACKET BOTTOM //bracketrightbt (CUS) $FC: Result := $F8FC; //RIGHT CURLY BRACKET TOP //bracerighttp (CUS) $FD: Result := $F8FD; //RIGHT CURLY BRACKET MID //bracerightmid (CUS) $FE: Result := $F8FE; //RIGHT CURLY BRACKET BOTTOM //bracerightbt (CUS) else Result := AValue; end; end; { TKMemoRTFCtrlItem } constructor TKMemoRTFCtrl.Create; begin FCode := 0; FCtrl := ''; FMethod := nil; end; { TKMemoRTFCtrlTable } function KMemoRTFSearchCompare(Data: Pointer; Index: Integer; KeyPtr: Pointer): Integer; var Tbl: TKMemoRTFCtrlTable; TblCtrl, Ctrl: AnsiString; begin Tbl := TKMemoRTFCtrlTable(Data); Ctrl := AnsiString(keyPtr); TblCtrl := Tbl[Index].Ctrl; if Ctrl > TblCtrl then Result := 1 else if Ctrl < TblCtrl then Result := -1 else Result := 0; end; function KMemoRTFSortCompare(Data: Pointer; Index1, Index2: Integer): Integer; var Tbl: TKMemoRTFCtrlTable; TblCtrl1, TblCtrl2: AnsiString; begin Tbl := TKMemoRTFCtrlTable(Data); TblCtrl1 := Tbl[Index1].Ctrl; TblCtrl2 := Tbl[Index2].Ctrl; if TblCtrl1 > TblCtrl2 then Result := 1 else if TblCtrl1 < TblCtrl2 then Result := -1 else Result := 0; end; procedure KMemoRTFSortExchange(Data: Pointer; Index1, Index2: Integer); var Tbl: TKMemoRTFCtrlTable; begin Tbl := TKMemoRTFCtrlTable(Data); Tbl.Exchange(Index1, Index2); end; procedure TKMemoRTFCtrlTable.AddCtrl(const ACtrl: AnsiString; ACode: Integer; AMethod: TKMemoRTFCtrlMethod); var Item: TKMemoRTFCtrl; begin Item := TKMemoRTFCtrl.Create; Item.Ctrl := ACtrl; Item.Code := ACode; Item.Method := AMethod; inherited Add(Item); end; function TKMemoRTFCtrlTable.FindByCtrl(const ACtrl: AnsiString): TKMemoRtfCtrl; var Index: Integer; begin Index := BinarySearch(Self, Count, Pointer(ACtrl), KMemoRTFSearchCompare, True); if Index >= 0 then Result := Items[Index] else Result := nil; end; function TKMemoRTFCtrlTable.GetItem(Index: Integer): TKMemoRTFCtrl; begin Result := TKMemoRTFCtrl(inherited GetItem(Index)); end; procedure TKMemoRTFCtrlTable.SetItem(Index: Integer; const Value: TKMemoRTFCtrl); begin inherited SetItem(Index, Value); end; procedure TKMemoRTFCtrlTable.SortTable; begin QuickSort(Self, Count, KMemoRTFSortCompare, KMemoRTFSortExchange, True); end; { TKMemoRTFColor } constructor TKMemoRTFColor.Create; begin FColorRec.Value := 0; end; { TKMemoRTFColorTable } procedure TKMemoRTFColorTable.AddColor(AColor: TColor); var RTFColor: TKMemoRTFColor; begin if AColor <> clNone then begin if GetIndex(AColor) < 0 then begin RTFColor := TKMemoRTFColor.Create; RTFColor.ColorRec := ColorToColorRec(AColor); Add(RTFColor); end; end; end; function TKMemoRTFColorTable.getColor(AIndex: Integer): TColor; begin if (AIndex >= 0) and (AIndex < Count) then Result := ColorRecToColor(Items[AIndex].ColorRec) else Result := clNone; end; function TKMemoRTFColorTable.GetIndex(AColor: TColor): Integer; var I: Integer; Color, ColorRec: TKColorRec; begin Color := ColorToColorRec(AColor); Result := -1; for I := 0 to Count - 1 do begin ColorRec := Items[I].ColorRec; if ColorRec.Value = Color.Value then begin Result := I; Break; end; end; end; function TKMemoRTFColorTable.GetItem(Index: Integer): TKMemoRTFColor; begin Result := TKMemoRTFColor(inherited GetItem(Index)); end; procedure TKMemoRTFColorTable.SetItem(Index: Integer; const Value: TKMemoRTFColor); begin inherited SetItem(Index, Value); end; { TKMemoRTFFont } constructor TKMemoRTFFont.Create; begin FFont := TFont.Create; end; destructor TKMemoRTFFont.Destroy; begin FFont.Free; inherited; end; { TKMemoRTFFontTable } function TKMemoRTFFontTable.AddFont(AFont: TFont): Integer; var RTFFont: TKMemoRTFFont; begin Result := GetIndex(AFont); if Result < 0 then begin RTFFont := TKmemoRTFFont.Create; RTFFont.Font.Assign(AFont); RTFFont.FontIndex := Count; Result := Add(RTFFont); end; end; function TKMemoRTFFontTable.GetFont(AFontIndex: Integer): TFont; var I: Integer; Item: TKMemoRTFFont; begin Result := nil; for I := 0 to Count - 1 do begin Item := Items[I]; if Item.FontIndex = AFontIndex then begin Result := Item.Font; Exit; end; end; end; function TKMemoRTFFontTable.GetIndex(AFont: TFont): Integer; var I: Integer; Font: TFont; begin Result := -1; for I := 0 to Count - 1 do begin Font := Items[I].Font; if (Font.Name = AFont.Name) and (Font.Charset = AFont.Charset) and (Font.Pitch = AFont.Pitch) then begin Result := I; Break; end; end; end; function TKMemoRTFFontTable.GetItem(Index: Integer): TKMemoRTFFont; begin Result := TKMemoRTFFont(inherited GetItem(Index)); end; procedure TKMemoRTFFontTable.SetItem(Index: Integer; const Value: TKMemoRTFFont); begin inherited SetItem(Index, Value); end; { TKMemoRTFListLevel } constructor TKMemoRTFListLevel.Create; begin FFirstIndent := 0; FFontIndex := -1; FNumberingFormat := TKMemoNumberingFormat.Create; FJustify := 0; FLeftIndent := 0; FNumberType := 0; FStartAt := 1; end; destructor TKMemoRTFListLevel.Destroy; begin FNumberingFormat.Free; inherited; end; function TKMemoRTFListLevel.GetNumberTypeAsNumbering: TKMemoParaNumbering; begin // we support only basic types of Word numberings... case FNumberType of 1: Result := pnuRomanHi; 2: Result := pnuRomanLo; 3: Result := pnuLetterHi; 4: Result := pnuLetterLo; 23: Result := pnuBullets; 255: Result := pnuNone; else Result := pnuArabic; end; end; procedure TKMemoRTFListLevel.SetNumberTypeAsNumbering(const Value: TKMemoParaNumbering); begin case Value of pnuBullets, pnuTriangleBullets, pnuArrowOneBullets, pnuArrowTwoBullets, pnuCircleBullets: FNumberType := 23; // maps to bullet, TODO: find out how other bullet styles are stored in RTF... pnuArabic: FNumberType := 0; pnuLetterLo: FNumberType := 4; pnuLetterHi: FNumberType := 3; pnuRomanLo: FNumberType := 2; pnuRomanHi: FNumberType := 1; else FNumberType := 255; // pnuNone end; end; { TKMemoRTFListLevels } function TKMemoRTFListLevels.GetItem(Index: Integer): TKMemoRTFListLevel; begin Result := TKMemoRTFListLevel(inherited GetItem(Index)); end; procedure TKMemoRTFListLevels.SetItem(Index: Integer; const Value: TKMemoRTFListLevel); begin inherited SetItem(Index, Value); end; { TKMemoRTFList } constructor TKMemoRTFList.Create(AParent: TKMemoRTFListTable); begin if AParent <> nil then FID := AParent.NextID else FID := Random(MaxInt); FLevels := TKMemoRTFListLevels.Create; end; destructor TKMemoRTFList.Destroy; begin FLevels.Free; inherited; end; { TKMemoRTFListTable } constructor TKMemoRTFListTable.Create; begin inherited; FIdCounter := 0; FOverrides := TKMemoDictionary.Create; end; destructor TKMemoRTFListTable.Destroy; begin FOverrides.Free; inherited; end; procedure TKMemoRTFListTable.AssignFromListTable(AListTable: TKMemoListTable; AFontTable: TKMemoRTFFontTable); var List: TKMemoList; ListLevel: TKMemoListLevel; RTFList: TKMemoRTFList; RTFListLevel: TKMemoRTFListLevel; NFItem: TKMemoNumberingFormatItem; I, J, K, Len: Integer; begin Clear; for I := 0 to AListTable.Count - 1 do begin List := AListTable.Items[I]; RTFList := TKMemoRTFList.Create(Self); RTFList.ID := List.ID; for J := 0 to List.Levels.Count - 1 do begin ListLevel := List.Levels[J]; RTFListLevel := TKMemoRTFListLevel.Create; RTFListLevel.FirstIndent := ListLevel.FirstIndent; RTFListLevel.LeftIndent := ListLevel.LeftIndent; if ListLevel.NumberingFontChanged then RTFListLevel.FontIndex := AFontTable.AddFont(ListLevel.NumberingFont); RTFListLevel.NumberTypeAsNumbering := ListLevel.Numbering; RTFListLevel.NumberingFormat.Assign(ListLevel.NumberingFormat); // fixup numbering format for RTF save // add length field Len := 0; for K := 0 to RTFListLevel.NumberingFormat.Count - 1 do begin NFItem := RTFListLevel.NumberingFormat[K]; if (NFItem.Level >= 0) and (NFItem.Text = '') then Inc(Len) else Inc(Len, StringLength(NFItem.Text)); end; RTFListLevel.NumberingFormat.InsertItem(0, Len, ''); RTFListLevel.StartAt := ListLevel.NumberStartAt; RTFList.Levels.Add(RTFListLevel); end; Add(RTFList); FOverrides.AddItem(I, RTFList.ID); end; end; procedure TKMemoRTFListTable.AssignToListTable(AListTable: TKMemoListTable; AFontTable: TKMemoRTFFontTable); var List: TKMemoList; ListLevel: TKMemoListLevel; RTFList: TKMemoRTFList; RTFListLevel: TKMemoRTFListLevel; NFItem: TKMemoNumberingFormatItem; Font: TFont; I, J, K, L, UnicodeValue: Integer; S: TKString; begin AListTable.LockUpdate; try for I := 0 to Count - 1 do begin RTFList := Items[I]; List := AListTable.FindByID(RTFList.ID); if List = nil then begin List := TKMemoList.Create; List.Parent := AListTable; List.ID := RTFList.ID; AListTable.Add(List); end; List.Levels.Clear; for J := 0 to RTFList.Levels.Count - 1 do begin RTFListLevel := RTFList.Levels[J]; ListLevel := TKMemoListLevel.Create; ListLevel.Parent := List.Levels; ListLevel.FirstIndent := RTFListLevel.FirstIndent; ListLevel.LeftIndent := RTFListLevel.LeftIndent; ListLevel.Numbering := RTFListLevel.NumberTypeAsNumbering; ListLevel.NumberingFormat.Assign(RTFListLevel.NumberingFormat); ListLevel.NumberStartAt := RTFListLevel.StartAt; if RTFListLevel.FontIndex >= 0 then begin Font := AFontTable.GetFont(RTFListLevel.FontIndex); if Font <> nil then begin ListLevel.NumberingFont.Assign(Font); if ListLevel.NumberingFont.Name = 'Symbol' then begin ListLevel.NumberingFont.Name := 'Arial'; ListLevel.NumberingFont.Charset := 0; for K := 0 to ListLevel.NumberingFormat.Count - 1 do begin NFItem := ListLevel.NumberingFormat[K]; S := ''; for L := 1 to StringLength(NFItem.Text) do begin UnicodeValue := Ord(NativeUTFToUnicode(StringCopy(NFItem.Text, L, 1))); S := S + UnicodeToNativeUTF(WideChar(AdobeSymbolToUTF16(Byte(UnicodeValue)))); end; NFItem.Text := S; end; end; end; end; List.Levels.Add(ListLevel); end; end; finally AListTable.UnLockUpdate; end; end; function TKMemoRTFListTable.FindByID(AListID: Integer): Integer; var I: Integer; begin Result := -1; for I := 0 to Count - 1 do if Items[I].ID = AListID then begin Result := I; Break; end; end; function TKMemoRTFListTable.FindByIndex(AIndex: Integer): Integer; var I: Integer; begin Result := -1; for I := 0 to FOverrides.Count - 1 do if FOverrides.Items[I].Index = AIndex then begin Result := FindByID(FOverrides.Items[I].Value); Break; end; end; function TKMemoRTFListTable.GetItem(Index: Integer): TKMemoRTFList; begin Result := TKMemoRTFList(inherited GetItem(Index)); end; function TKMemoRTFListTable.IDByIndex(AIndex: Integer): Integer; var I: Integer; begin I := FindByIndex(AIndex); if I >= 0 then Result := Items[I].ID else Result := cInvalidListID; end; function TKMemoRTFListTable.NextID: Integer; begin Result := FIDCounter; Inc(FIDCounter); end; procedure TKMemoRTFListTable.SetItem(Index: Integer; const Value: TKMemoRTFList); begin inherited SetItem(Index, Value); end; { TKMemoRTFShape } constructor TKMemoRTFShape.Create; begin FBackground := False; FContentPosition := TKRect.Create; FContentType := sctUnknown; FFillBlip := False; FFitToShape := False; FFitToText := True; FHorzPosCode := 0; FBlock := nil; FStyle := TKMemoBlockStyle.Create; FStyle.Brush.Color := clWhite; FStyle.ContentMargin.AssignFromValues(5, 5, 5, 5); FVertPosCode := 0; FWrap := 0; FWrapSide := 0; end; destructor TKMemoRTFShape.Destroy; begin FContentPosition.Free; FStyle.Free; inherited; end; function TKMemoRTFShape.GetWrap: Integer; begin WrapModeToRTFWrap; Result := FWrap; end; function TKMemoRTFShape.GetWrapSide: Integer; begin WrapModeToRTFWrap; Result := FWrapSide; end; procedure TKMemoRTFShape.SetWrap(const Value: Integer); begin FWrap := Value; RTFWrapToWrapMode; end; procedure TKMemoRTFShape.SetWrapSide(const Value: Integer); begin FWrapSide := Value; RTFWrapToWrapMode; end; procedure TKMemoRTFShape.WrapModeToRTFWrap; begin FWrapSide := 0; FWrap := 0; case FStyle.WrapMode of wrAround: FWrap := 2; wrAroundLeft: begin FWrap := 2; FWrapSide := 1; end; wrAroundRight: begin FWrap := 2; FWrapSide := 2; end; wrTight: FWrap := 2; // FWrap should be 4, change when tight wrapping supported wrTightLeft: begin FWrap := 2; FWrapSide := 1; end; // FWrap should be 4, change when tight wrapping supported wrTightRight: begin FWrap := 2; FWrapSide := 2; end; // FWrap should be 4, change when tight wrapping supported wrTopBottom: FWrap := 1; wrNone: FWrap := 3; end; end; procedure TKMemoRTFShape.RTFWrapToWrapMode; begin case FWrap of 1: FStyle.WrapMode := wrTopBottom; 2: case FWrapSide of 1: FStyle.WrapMode := wrAroundLeft; 2: FStyle.WrapMode := wrAroundRight; else FStyle.WrapMode := wrAround; end; 3: FStyle.WrapMode := wrNone; 4: case FWrapSide of 1: FStyle.WrapMode := wrTightLeft; 2: FStyle.WrapMode := wrTightRight; else FStyle.WrapMode := wrTight; end; else FStyle.WrapMode := wrAround; end; end; { TKMemoRTFState } procedure TKMemoRTFState.Assign(ASource: TKmemoRTFState); begin if ASource <> nil then begin FGroup := ASource.Group; FParaStyle.Assign(ASource.ParaStyle); FTextStyle.Assign(ASource.TextStyle); // don't assign the IsShape and IsPicture properties, they should not be inherited end; end; constructor TKMemoRTFState.Create; begin FGroup := rgNone; FParaStyle := TKMemoParaStyle.Create; FTextStyle := TKMemoTextStyle.Create; end; destructor TKMemoRTFState.Destroy; begin FParaStyle.Free; FTextStyle.Free; inherited; end; { TKMemoRTFStack } function TKMemoRTFStack.Peek: TKMemoRTFState; begin Result := TKMemoRTFState(inherited Peek); end; function TKMemoRTFStack.Pop: TKMemoRTFState; begin Result := TKMemoRTFState(inherited Pop); end; function TKMemoRTFStack.Push(AObject: TKMemoRTFState): TKMemoRTFState; begin Result := TKMemoRTFState(inherited Push(AObject)); end; { TKMemoRTFFiler } constructor TKMemoRTFFiler.Create(AMemo: TKCustomMemo); begin if (AMemo <> nil) and AMemo.HandleAllocated then begin FTwipsPerPixelX := TwipsPerPixelX(AMemo.Handle); FTwipsPerPixelY := TwipsPerPixelY(AMemo.Handle); end else begin FTwipsPerPixelX := TwipsPerPixelX(0); FTwipsPerPixelY := TwipsPerPixelY(0); end; FMemo := AMemo; FStream := nil; end; function TKMemoRTFFiler.EMUToPoints(AValue: Integer): Integer; begin Result := DivUp(AValue, 12700); end; function TKMemoRTFFiler.PointsToEMU(AValue: Integer): Integer; begin Result := AValue * 12700; end; function TKMemoRTFFiler.PixelsToTwipsX(AValue: Integer): Integer; begin Result := Round(AValue * FTwipsPerPixelX); end; function TKMemoRTFFiler.PixelsToTwipsY(AValue: Integer): Integer; begin Result := Round(AValue * FTwipsPerPixelY); end; function TKMemoRTFFiler.TwipsToPixelsX(AValue: Integer): Integer; begin Result := Round(AValue / FTwipsPerPixelX); end; function TKMemoRTFFiler.TwipsToPixelsY(AValue: Integer): Integer; begin Result := Round(AValue / FTwipsPerPixelY); end; { TKMemoRTFReader } constructor TKMemoRTFReader.Create(AMemo: TKCustomMemo); begin inherited; FColorTable := TKMemoRTFColorTable.Create; FCtrlTable := TKMemoRTFCtrlTable.Create; FFontTable := TKMemoRTFFontTable.Create; FIndexStack := TKMemoIndexObjectStack.Create; FListTable := TKMemoRTFListTable.Create; FStack := TKMemoRTFStack.Create; FStream := nil; FillCtrlTable; FCtrlTable.SortTable; end; destructor TKMemoRTFReader.Destroy; begin FColorTable.Free; FCtrlTable.Free; FFontTable.Free; FIndexStack.Free; FListTable.Free; FStack.Free; inherited; end; procedure TKMemoRTFReader.FillCtrlTable; begin // control symbols FCtrlTable.AddCtrl('{', 0, PushToStack); FCtrlTable.AddCtrl('}', 0, PopFromStack); FCtrlTable.AddCtrl('*', Integer(rpuUnknownSym), ReadUnknownGroup); FCtrlTable.AddCtrl('shpinst', Integer(rpuShapeInst), ReadUnknownGroup); FCtrlTable.AddCtrl('shppict', Integer(rpuShapePict), ReadUnknownGroup); FCtrlTable.AddCtrl('nonshppict', Integer(rpuNonShapePict), ReadUnknownGroup); FCtrlTable.AddCtrl('background', Integer(rpuPageBackground), ReadUnknownGroup); FCtrlTable.AddCtrl('picprop', Integer(rpuPicProp), ReadUnknownGroup); FCtrlTable.AddCtrl('fldinst', Integer(rpuFieldInst), ReadUnknownGroup); FCtrlTable.AddCtrl('listtable', Integer(rpuListTable), ReadUnknownGroup); FCtrlTable.AddCtrl('listoverridetable', Integer(rpuListOverrideTable), ReadUnknownGroup); // header ctrls FCtrlTable.AddCtrl('rtf', Integer(rphRtf), ReadHeaderGroup); FCtrlTable.AddCtrl('ansicpg', Integer(rphCodePage), ReadHeaderGroup); FCtrlTable.AddCtrl('deff', Integer(rphDefaultFont), ReadHeaderGroup); FCtrlTable.AddCtrl('uc', Integer(rphIgnoreCharsAfterUnicode), ReadHeaderGroup); FCtrlTable.AddCtrl('fonttbl', Integer(rphFontTable), ReadHeaderGroup); FCtrlTable.AddCtrl('colortbl', Integer(rphColorTable), ReadHeaderGroup); FCtrlTable.AddCtrl('stylesheet', Integer(rphStyleSheet), ReadHeaderGroup); // document ctrls FCtrlTable.AddCtrl('footer', Integer(rpdFooter), ReadDocumentGroups); FCtrlTable.AddCtrl('footerl', Integer(rpdFooterLeft), ReadDocumentGroups); FCtrlTable.AddCtrl('footerr', Integer(rpdFooterRight), ReadDocumentGroups); FCtrlTable.AddCtrl('header', Integer(rpdHeader), ReadDocumentGroups); FCtrlTable.AddCtrl('headerl', Integer(rpdHeaderLeft), ReadDocumentGroups); FCtrlTable.AddCtrl('headerr', Integer(rpdHeaderRight), ReadDocumentGroups); FCtrlTable.AddCtrl('info', Integer(rpdInfo), ReadDocumentGroups); // color table ctrls FCtrlTable.AddCtrl('red', Integer(rpcRed), ReadColorGroup); FCtrlTable.AddCtrl('green', Integer(rpcGreen), ReadColorGroup); FCtrlTable.AddCtrl('blue', Integer(rpcBlue), ReadColorGroup); // field ctrls FCtrlTable.AddCtrl('field', Integer(rpfiField), ReadFieldGroup); FCtrlTable.AddCtrl('fldrslt', Integer(rpfiResult), ReadFieldGroup); // font table ctrls FCtrlTable.AddCtrl('f', Integer(rpfIndex), ReadFontGroup); FCtrlTable.AddCtrl('fcharset', Integer(rpfCharset), ReadFontGroup); FCtrlTable.AddCtrl('fprq', Integer(rpfPitch), ReadFontGroup); // list (override) table ctrls FCtrlTable.AddCtrl('list', Integer(rplList), ReadListGroup); FCtrlTable.AddCtrl('listoverride', Integer(rplListOverride), ReadListGroup); FCtrlTable.AddCtrl('listlevel', Integer(rplListLevel), ReadListGroup); FCtrlTable.AddCtrl('listid', Integer(rplListId), ReadListGroup); FCtrlTable.AddCtrl('listtext', Integer(rplListText), ReadListGroup); FCtrlTable.AddCtrl('levelstartat', Integer(rplLevelStartAt), ReadListGroup); FCtrlTable.AddCtrl('levelnfc', Integer(rplLevelNumberType), ReadListGroup); FCtrlTable.AddCtrl('leveljc', Integer(rplLevelJustify), ReadListGroup); FCtrlTable.AddCtrl('leveltext', Integer(rplLevelText), ReadListGroup); FCtrlTable.AddCtrl('pntext', Integer(rplPnText), ReadListGroup); // paragraph formatting ctrls FCtrlTable.AddCtrl('pard', Integer(rppParD), ReadParaFormatting); FCtrlTable.AddCtrl('fi', Integer(rppIndentFirst), ReadParaFormatting); FCtrlTable.AddCtrl('li', Integer(rppIndentLeft), ReadParaFormatting); FCtrlTable.AddCtrl('ri', Integer(rppIndentRight), ReadParaFormatting); FCtrlTable.AddCtrl('sb', Integer(rppIndentTop), ReadParaFormatting); FCtrlTable.AddCtrl('sa', Integer(rppIndentBottom), ReadParaFormatting); FCtrlTable.AddCtrl('ql', Integer(rppAlignLeft), ReadParaFormatting); FCtrlTable.AddCtrl('qc', Integer(rppAlignCenter), ReadParaFormatting); FCtrlTable.AddCtrl('qr', Integer(rppAlignRight), ReadParaFormatting); FCtrlTable.AddCtrl('qj', Integer(rppAlignJustify), ReadParaFormatting); FCtrlTable.AddCtrl('cbpat', Integer(rppBackColor), ReadParaFormatting); FCtrlTable.AddCtrl('nowwrap', Integer(rppNoWordWrap), ReadParaFormatting); FCtrlTable.AddCtrl('brdrb', Integer(rppBorderBottom), ReadParaFormatting); FCtrlTable.AddCtrl('brdrl', Integer(rppBorderLeft), ReadParaFormatting); FCtrlTable.AddCtrl('brdrr', Integer(rppBorderRight), ReadParaFormatting); FCtrlTable.AddCtrl('brdrt', Integer(rppBorderTop), ReadParaFormatting); FCtrlTable.AddCtrl('box', Integer(rppBorderAll), ReadParaFormatting); FCtrlTable.AddCtrl('brdrw', Integer(rppBorderWidth), ReadParaFormatting); FCtrlTable.AddCtrl('brdrnone', Integer(rppBorderNone), ReadParaFormatting); FCtrlTable.AddCtrl('brdrradius', Integer(rppBorderRadius), ReadParaFormatting); FCtrlTable.AddCtrl('brdrcf', Integer(rppBorderColor), ReadParaFormatting); FCtrlTable.AddCtrl('sl', Integer(rppLineSpacing), ReadParaFormatting); FCtrlTable.AddCtrl('slmult', Integer(rppLineSpacingMode), ReadParaFormatting); FCtrlTable.AddCtrl('par', Integer(rppPar), ReadParaFormatting); FCtrlTable.AddCtrl('ls', Integer(rppListIndex), ReadParaFormatting); FCtrlTable.AddCtrl('ilvl', Integer(rppListLevel), ReadParaFormatting); FCtrlTable.AddCtrl('lsstartat', Integer(rppListStartAt), ReadParaFormatting); // picture group ctrls FCtrlTable.AddCtrl('pict', Integer(rpiPict), ReadPictureGroup); FCtrlTable.AddCtrl('jpegblip', Integer(rpiJpeg), ReadPictureGroup); FCtrlTable.AddCtrl('pngblip', Integer(rpiPng), ReadPictureGroup); FCtrlTable.AddCtrl('emfblip', Integer(rpiEmf), ReadPictureGroup); FCtrlTable.AddCtrl('wmetafile', Integer(rpiWmf), ReadPictureGroup); FCtrlTable.AddCtrl('picw', Integer(rpiWidth), ReadPictureGroup); FCtrlTable.AddCtrl('pich', Integer(rpiHeight), ReadPictureGroup); FCtrlTable.AddCtrl('piccropb', Integer(rpiCropBottom), ReadPictureGroup); FCtrlTable.AddCtrl('piccropl', Integer(rpiCropLeft), ReadPictureGroup); FCtrlTable.AddCtrl('piccropr', Integer(rpiCropRight), ReadPictureGroup); FCtrlTable.AddCtrl('piccropt', Integer(rpiCropTop), ReadPictureGroup); FCtrlTable.AddCtrl('picscalex', Integer(rpiScaleX), ReadPictureGroup); FCtrlTable.AddCtrl('picscaley', Integer(rpiScaleY), ReadPictureGroup); FCtrlTable.AddCtrl('picwgoal', Integer(rpiReqWidth), ReadPictureGroup); FCtrlTable.AddCtrl('pichgoal', Integer(rpiReqHeight), ReadPictureGroup); // shape ctrls FCtrlTable.AddCtrl('shp', Integer(rpsShape), ReadShapeGroup); FCtrlTable.AddCtrl('shpbottom', Integer(rpsBottom), ReadShapeGroup); FCtrlTable.AddCtrl('shpleft', Integer(rpsLeft), ReadShapeGroup); FCtrlTable.AddCtrl('shpright', Integer(rpsRight), ReadShapeGroup); FCtrlTable.AddCtrl('shptop', Integer(rpsTop), ReadShapeGroup); FCtrlTable.AddCtrl('shpbxcolumn', Integer(rpsXColumn), ReadShapeGroup); FCtrlTable.AddCtrl('shpbypara', Integer(rpsYPara), ReadShapeGroup); FCtrlTable.AddCtrl('shpwr', Integer(rpsWrap), ReadShapeGroup); FCtrlTable.AddCtrl('shpwrk', Integer(rpsWrapSide), ReadShapeGroup); FCtrlTable.AddCtrl('sn', Integer(rpsSn), ReadShapeGroup); FCtrlTable.AddCtrl('sv', Integer(rpsSv), ReadShapeGroup); FCtrlTable.AddCtrl('shptxt', Integer(rpsShapeText), ReadShapeGroup); // special character ctrls FCtrlTable.AddCtrl('tab', Integer(rpscTab), ReadSpecialCharacter); FCtrlTable.AddCtrl('lquote', Integer(rpscLQuote), ReadSpecialCharacter); FCtrlTable.AddCtrl('rquote', Integer(rpscRQuote), ReadSpecialCharacter); FCtrlTable.AddCtrl('ldblquote', Integer(rpscLDblQuote), ReadSpecialCharacter); FCtrlTable.AddCtrl('rdblquote', Integer(rpscRDblQuote), ReadSpecialCharacter); FCtrlTable.AddCtrl('endash', Integer(rpscEnDash), ReadSpecialCharacter); FCtrlTable.AddCtrl('emdash', Integer(rpscEmDash), ReadSpecialCharacter); FCtrlTable.AddCtrl('bullet', Integer(rpscBullet), ReadSpecialCharacter); FCtrlTable.AddCtrl('~', Integer(rpscNBSP), ReadSpecialCharacter); FCtrlTable.AddCtrl('emspace', Integer(rpscEmSpace), ReadSpecialCharacter); FCtrlTable.AddCtrl('enspace', Integer(rpscEnSpace), ReadSpecialCharacter); FCtrlTable.AddCtrl('''', Integer(rpscAnsiChar), ReadSpecialCharacter); FCtrlTable.AddCtrl('u', Integer(rpscUnicodeChar), ReadSpecialCharacter); // table formatting ctrls FCtrlTable.AddCtrl('trowd', Integer(rptbRowBegin), ReadTableFormatting); FCtrlTable.AddCtrl('intbl', Integer(rptbRowBegin), ReadTableFormatting); FCtrlTable.AddCtrl('cell', Integer(rptbCellEnd), ReadTableFormatting); FCtrlTable.AddCtrl('row', Integer(rptbRowEnd), ReadTableFormatting); FCtrlTable.AddCtrl('lastrow', Integer(rptbLastRow), ReadTableFormatting); FCtrlTable.AddCtrl('trpaddb', Integer(rptbRowPaddBottom), ReadTableFormatting); FCtrlTable.AddCtrl('trpaddl', Integer(rptbRowPaddLeft), ReadTableFormatting); FCtrlTable.AddCtrl('trpaddr', Integer(rptbRowPaddRight), ReadTableFormatting); FCtrlTable.AddCtrl('trpaddt', Integer(rptbRowPaddTop), ReadTableFormatting); FCtrlTable.AddCtrl('trgaph', Integer(rptbPaddAll), ReadTableFormatting); FCtrlTable.AddCtrl('clbrdrb', Integer(rptbBorderBottom), ReadTableFormatting); FCtrlTable.AddCtrl('clbrdrl', Integer(rptbBorderLeft), ReadTableFormatting); FCtrlTable.AddCtrl('clbrdrr', Integer(rptbBorderRight), ReadTableFormatting); FCtrlTable.AddCtrl('clbrdrt', Integer(rptbBorderTop), ReadTableFormatting); FCtrlTable.AddCtrl('clpadb', Integer(rptbCellPaddBottom), ReadTableFormatting); FCtrlTable.AddCtrl('clpadl', Integer(rptbCellPaddLeft), ReadTableFormatting); FCtrlTable.AddCtrl('clpadr', Integer(rptbCellPaddRight), ReadTableFormatting); FCtrlTable.AddCtrl('clpadt', Integer(rptbCellPaddTop), ReadTableFormatting); // FCtrlTable.AddCtrl('brdrw', Integer(rptbBorderWidth), ReadTableFormatting); // see ReadParaFormatting // FCtrlTable.AddCtrl('brdrnone', Integer(rptbBorderNone), ReadTableFormatting); // see ReadParaFormatting // FCtrlTable.AddCtrl('brdrcf', Integer(rptbBorderColor), ReadParaFormatting); // see ReadParaFormatting FCtrlTable.AddCtrl('clcbpat', Integer(rptbBackColor), ReadTableFormatting); FCtrlTable.AddCtrl('clmgf', Integer(rptbHorzMergeBegin), ReadTableFormatting); FCtrlTable.AddCtrl('clhmrg', Integer(rptbHorzMerge), ReadTableFormatting); FCtrlTable.AddCtrl('clvmgf', Integer(rptbVertMergeBegin), ReadTableFormatting); FCtrlTable.AddCtrl('clvmrg', Integer(rptbVertMerge), ReadTableFormatting); FCtrlTable.AddCtrl('clwWidth', Integer(rptbCellWidth), ReadTableFormatting); FCtrlTable.AddCtrl('cellx', Integer(rptbCellX), ReadTableFormatting); // text formatting ctrls FCtrlTable.AddCtrl('plain', Integer(rptPlain), ReadTextFormatting); // FCtrlTable.AddCtrl('f', Integer(rptFontIndex), ReadTextFormatting); see ReadFontGroup FCtrlTable.AddCtrl('b', Integer(rptBold), ReadTextFormatting); FCtrlTable.AddCtrl('i', Integer(rptItalic), ReadTextFormatting); FCtrlTable.AddCtrl('ul', Integer(rptUnderline), ReadTextFormatting); FCtrlTable.AddCtrl('strike', Integer(rptStrikeout), ReadTextFormatting); FCtrlTable.AddCtrl('caps', Integer(rptCaps), ReadTextFormatting); FCtrlTable.AddCtrl('scaps', Integer(rptSmallCaps), ReadTextFormatting); FCtrlTable.AddCtrl('fs', Integer(rptFontSize), ReadTextFormatting); FCtrlTable.AddCtrl('cf', Integer(rptForeColor), ReadTextFormatting); FCtrlTable.AddCtrl('cb', Integer(rptBackColor), ReadTextFormatting); FCtrlTable.AddCtrl('highlight', Integer(rptBackColor), ReadTextFormatting); FCtrlTable.AddCtrl('sub', Integer(rptSubscript), ReadTextFormatting); FCtrlTable.AddCtrl('super', Integer(rptSuperscript), ReadTextFormatting); end; procedure TKMemoRTFReader.AddText(const APart: TKString); var S: TKString; begin S := APart; while (FIgnoreChars > 0) and (S <> '') do begin Delete(S, 1, 1); Dec(FIgnoreChars); end; if S <> '' then begin if FActiveState.TextStyle.StyleChanged then FlushText; if FActiveText = nil then begin FActiveText := TKMemoTextBlock.Create; FActiveText.TextStyle.Assign(FActiveState.TextStyle); end; FActiveState.TextStyle.StyleChanged := False; FActiveString := FActiveString + S; end; end; procedure TKMemoRTFReader.AddTextToNumberingFormat(const APart: TKString); var S: TKString; begin if APart <> '' then begin S := APart; while (FIgnoreChars > 0) and (S <> '') do begin Delete(S, 1, 1); Dec(FIgnoreChars); end; if S <> '' then begin if Ord(S[1]) < $20 then ActiveListLevel.NumberingFormat.AddItem(Ord(S[1]), '') else ActiveListLevel.NumberingFormat.AddItem(-1, S); end; end; end; procedure TKMemoRTFReader.ApplyFont(ATextStyle: TKMemoTextStyle; AFontIndex: Integer); var Font: TFont; begin Font := FFontTable.GetFont(AFontIndex); if Font <> nil then begin ATextStyle.Font.Name := Font.Name; ATextStyle.Font.Charset := Font.Charset; ATextStyle.Font.Pitch := Font.Pitch; end; end; procedure TKMemoRTFReader.ApplyHighlight(ATextStyle: TKMemoTextStyle; AHighlightCode: Integer); var Color: TColor; begin Color := HighlightCodeToColor(AHighlightCode); if Color <> clNone then ATextStyle.Brush.Color := Color else ATextStyle.Brush.Style := bsClear; end; procedure TKMemoRTFReader.FlushColor; begin if FActiveColor <> nil then FColorTable.Add(FActiveColor) else FColorTable.Add(ActiveColor); FActiveColor := nil; end; procedure TKMemoRTFReader.FlushContainer; begin if FActiveContainer <> nil then begin FActiveBlocks := FActiveContainer.ParentBlocks; FAtIndex := FIndexStack.PopValue; FActiveBlocks.AddAt(FActiveContainer, FAtIndex); Inc(FAtIndex); FActiveContainer := nil; end; end; procedure TKMemoRTFReader.FlushFont; begin if FActiveFont <> nil then begin FFontTable.Add(FActiveFont); FActiveFont := nil; end; end; procedure TKMemoRTFReader.FlushHyperlink; begin FlushText; FActiveURL := ''; end; procedure TKMemoRTFReader.FlushImage; begin if FActiveImage <> nil then begin FActiveBlocks.AddAt(FActiveImage, FAtIndex); Inc(FAtIndex); FActiveImage := nil; end; end; procedure TKMemoRTFReader.FlushList; begin if FActiveList <> nil then begin if FActiveList.Levels.Count > 0 then begin FListTable.Add(FActiveList); FActiveList := nil; end else FreeAndNil(FActiveList); end; end; procedure TKMemoRTFReader.FlushListLevel; var NFItem: TKMemoNumberingFormatItem; S: TKString; begin if FActiveListLevel <> nil then begin // fixup numbering format FActiveListLevel.NumberingFormat.Delete(0); // first item should be length, remove it NFItem := FActiveListLevel.NumberingFormat[FActiveListLevel.NumberingFormat.Count - 1]; S := NFItem.Text; // last item should be string and end with a semicolon, remove it if S[Length(S)] = ';' then begin System.Delete(S, Length(S), 1); NFItem.Text := S; end; ActiveList.Levels.Add(FActiveListLevel); FActiveListLevel := nil; end; end; procedure TKMemoRTFReader.FlushListOverride; begin if FActiveListOverride <> nil then begin FListTable.Overrides.Add(FActiveListOverride); FActiveListOverride := nil; end; end; procedure TKMemoRTFReader.FlushParagraph; var PA: TKMemoParagraph; begin PA := FActiveBlocks.AddParagraph(FAtIndex); PA.TextStyle.Assign(FActiveState.TextStyle); PA.ParaStyle.Assign(FActiveState.ParaStyle); Inc(FAtIndex); FActiveParaBorder := alNone; end; procedure TKMemoRTFReader.FlushShape; var State: TKMemoRTFState; begin if FActiveShape <> nil then begin case FActiveShape.ContentType of sctImage: begin // image was inside shape if FActiveImage <> nil then begin // position always relative FActiveImage.Position := mbpRelative; // shape positioning tags override the image size/scale tags (MS Word behavior) if FActiveShape.ContentPosition.Width > 0 then FActiveImage.ScaleX := MulDiv(FActiveShape.ContentPosition.Width, 100, FActiveImage.NativeOrExplicitWidth); if FActiveShape.ContentPosition.Height > 0 then FActiveImage.ScaleY := MulDiv(FActiveShape.ContentPosition.Height, 100, FActiveImage.NativeOrExplicitHeight); if FActiveShape.HorzPosCode = 2 then FActiveImage.LeftOffset := FActiveShape.ContentPosition.Left; if FActiveShape.VertPosCode = 2 then FActiveImage.TopOffset := FActiveShape.ContentPosition.Top; FActiveImage.ImageStyle.Assign(FActiveShape.Style); FlushImage; end; end; sctRectangle: begin // currently only document background supported, look if it is the case State := FStack.Peek; if (State <> nil) and (State.Group = rgPageBackground) then begin if FActiveShape.FillBlip then begin if FActiveImage <> nil then begin if FMemo <> nil then FMemo.Background.Image.Assign(FActiveImage.Image); FreeAndNil(FActiveImage); end; end else if FMemo <> nil then FMemo.Colors.BkGnd := FActiveShape.Style.Brush.Color; end; end; sctTextBox: begin if FActiveContainer <> nil then begin // container was inside shape ActiveContainer.Position := mbpRelative; ActiveContainer.Clip := True; ActiveContainer.FixedWidth := True; if not FActiveShape.FitToText then ActiveContainer.FixedHeight := True; if FActiveShape.HorzPosCode = 2 then ActiveContainer.LeftOffset := FActiveShape.ContentPosition.Left; if FActiveShape.VertPosCode = 2 then ActiveContainer.TopOffset := FActiveShape.ContentPosition.Top; ActiveContainer.RequiredWidth := FActiveShape.ContentPosition.Right - FActiveShape.ContentPosition.Left; ActiveContainer.RequiredHeight := FActiveShape.ContentPosition.Bottom - FActiveShape.ContentPosition.Top; ActiveContainer.BlockStyle.Assign(FActiveShape.Style); FlushContainer; end; end; sctText: begin // unformatted text was inside shape FlushText; end; end; FreeAndNil(FActiveShape); end; end; procedure TKMemoRTFReader.FlushTable; begin if FActiveTable <> nil then begin FActiveTable.FixupCellSpanFromRTF; FActiveTable.FixupBorders; FActiveBlocks := FActiveTable.ParentBlocks; FActiveTable.Parent := nil; FActiveTable.UnlockUpdate; FAtIndex := FIndexStack.PopValue; if not FActiveBlocks.InsideOfTable then // no support for nested tables yet begin FActiveBlocks.AddAt(FActiveTable, FAtIndex); Inc(FAtIndex); end else FActiveTable.Free; FActiveTable := nil; FActiveTableRow := nil; FActiveTableCell := nil; end; end; procedure TKMemoRTFReader.FlushText; var Block: TKMemoHyperlink; begin if FActiveText <> nil then begin if FActiveString <> '' then begin FActiveText.InsertString(FActiveString); FActiveString := ''; end; if FActiveText.TextStyle.Font.Name = 'Symbol' then begin FActiveText.TextStyle.Font.Name := 'Arial'; FActiveText.TextStyle.Font.Charset := 0; end; if FActiveURL <> '' then begin TrimWhiteSpaces(FActiveURL, cWordBreaks); Block := TKMemoHyperlink.Create; Block.Assign(FActiveText); Block.URL := FActiveURL; FreeAndNil(FActiveText); FActiveText := Block; end; FActiveBlocks.AddAt(FActiveText, FAtIndex); Inc(FAtIndex); FActiveText := nil; end; end; function TKMemoRTFReader.GetActiveColor: TKMemoRTFColor; begin if FActiveColor = nil then FActiveColor := TKMemoRTFColor.Create; Result := FActiveColor; end; function TKMemoRTFReader.GetActiveContainer: TKMemoContainer; begin if FActiveContainer = nil then FActiveContainer := TKMemoContainer.Create; Result := FActiveContainer; end; function TKMemoRTFReader.GetActiveFont: TKMemoRTFFont; begin if FActiveFont = nil then FActiveFont := TKMemoRTFFont.Create; Result := FActiveFont; end; function TKMemoRTFReader.GetActiveImage: TKMemoImageBlock; begin if FActiveImage = nil then FActiveImage := TKMemoImageBlock.Create; Result := FActiveImage; end; function TKMemoRTFReader.GetActiveList: TKMemoRTFList; begin if FActiveList = nil then FActiveList := TKMemoRTFList.Create(nil); Result := FActiveList; end; function TKMemoRTFReader.GetActiveListLevel: TKMemoRTFListLevel; begin if FActiveListLevel = nil then FActiveListLevel := TKMemoRTFListLevel.Create; Result := FActiveListLevel; end; function TKMemoRTFReader.GetActiveListOverride: TKMemoDictionaryItem; begin if FActiveListOverride = nil then FActiveListOverride := TKMemoDictionaryItem.Create; Result := FActiveListOverride; end; function TKMemoRTFReader.GetActiveShape: TKMemoRTFShape; begin if FActiveShape = nil then FActiveShape := TKMemoRTFShape.Create; Result := FActiveShape; end; function TKMemoRTFReader.GetActiveTable: TKMemoTable; begin if FActiveTable = nil then FActiveTable := TKMemoTable.Create; Result := FActiveTable; end; function TKMemoRTFReader.HighlightCodeToColor(AValue: Integer): TColor; begin // it seems that highlight color is taken from color table, is it correct? case AValue of 1: Result := clBlack; 2: Result := clBlue; 3: Result := clAqua; // cyan 4: Result := clLime; // green 5: Result := clFuchsia; // magenta 6: Result := clRed; 7: Result := clYellow; 9: Result := clNavy; 10: Result := clTeal; // dark cyan 11: Result := clGreen; // dark green 12: Result := clPurple; // dark magenta 13: Result := clMaroon; // dark red 14: Result := clOlive; // dark yellow 15: Result := clGray; // dark gray 16: Result := clSilver; // light gray else Result := clNone; end; end; procedure TKMemoRTFReader.LoadFromFile(const AFileName: TKString; AActiveBlocks: TKMemoBlocks; AtIndex: TKMemoSelectionIndex); var Stream: TMemoryStream; begin if FileExists(AFileName) then begin Stream := TMemoryStream.Create; try Stream.LoadFromFile(AFileName); LoadFromStream(Stream, AActiveBlocks, AtIndex); finally Stream.Free; end; end; end; procedure TKMemoRTFReader.LoadFromStream(AStream: TStream; AActiveBlocks: TKMemoBlocks; AtIndex: TKMemoSelectionIndex); begin try if AActiveBlocks <> nil then begin FActiveBlocks := AActiveBlocks.SplitForInsert(AtIndex, FAtIndex); FActiveBlocks.LockUpdate; try FActiveColor := nil; FActiveContainer := nil; FActiveFont := nil; FActiveImage := nil; FActiveImageClass := nil; FActiveList := nil; FActiveListLevel := nil; FActiveListOverride := nil; FActiveParaBorder := alNone; FActiveShape := nil; FActiveState := TKMemoRTFState.Create; FActiveState.Group := rgUnknown; // we wait for file header if FMemo <> nil then begin FActiveState.ParaStyle.Assign(FMemo.ParaStyle); FActiveState.TextStyle.Assign(FMemo.TextStyle); end; FActiveString := ''; FActiveTable := nil; FActiveTableBorder := alNone; FActiveTableCell := nil; FActiveTableCol := -1; FActiveTableColCount := 0; FActiveTableRow := nil; FActiveText := nil; FColorTable.Clear; FDefaultFontIndex := 0; FIgnoreChars := 0; FStream := AStream; try ReadStream; finally FlushText; FlushShape; FlushImage; FlushTable; FActiveState.Free; if FMemo <> nil then FListTable.AssignToListTable(FMemo.ListTable, FFontTable); FActiveBlocks.ConcatEqualBlocks; FActiveBlocks.FixEmptyBlocks; end; finally FActiveBlocks.UnlockUpdate; end; end; except KFunctions.Error(sErrMemoLoadFromRTF); end; end; function TKMemoRTFReader.ParamToBool(const AValue: AnsiString): Boolean; begin Result := Boolean(StrToIntDef(string(AValue), 0)); end; function TKMemoRTFReader.ParamToColor(const AValue: AnsiString): TColor; begin Result := ColorRecToColor(MakeColorRec(StrToIntDef(string(AValue), 0))); end; function TKMemoRTFReader.ParamToEMU(const AValue: AnsiString): Integer; begin Result := EMUToPoints(StrToIntDef(string(AValue), 0)); end; function TKMemoRTFReader.ParamToInt(const AValue: AnsiString): Integer; begin Result := StrToIntDef(string(AValue), 0); end; procedure TKMemoRTFReader.PopFromStack(ACtrl: Integer; var AText: AnsiString; AParam: Integer); var State: TKMemoRTFState; begin State := FStack.Peek; if State <> nil then begin // flush shapes, images and other embedded objects to memo if FActiveState.Group = rgShape then begin // standard shape group FlushShape end else if FActiveState.Group = rgShapePict then begin // image inside of shppict group (Word 97 and newer images) FlushText; if FActiveImage <> nil then begin if FActiveShape <> nil then FActiveImage.ImageStyle.Assign(FActiveShape.Style); FlushImage; end; end else if (FActiveState.Group = rgPicture) and (State.Group in [rgNone, rgTextBox]) then begin // standalone image outside of shppict and shape group (e.g. results of embedded objects) FlushText; FlushImage; end else if (FActiveState.Group = rgTextBox) and (State.Group = rgShapeInst) then begin // text shape inside of shpinst group FlushText; end else if FActiveState.Group = rgField then begin // we only support hyperlinks now FlushHyperlink; end else if (FActiveState.Group = rgListLevel) and (State.Group = rgList) then begin FlushListLevel; end else if (FActiveState.Group = rgList) and (State.Group = rgListTable) then begin FlushList; end else if (FActiveState.Group = rgListOverride) and (State.Group = rgListOverrideTable) then begin FlushListOverride; end; FActiveState.Free; FActiveState := FStack.Pop; end; end; procedure TKMemoRTFReader.PushToStack(ACtrl: Integer; var AText: AnsiString; AParam: Integer); var State: TKMemoRTFState; begin FStack.Push(FActiveState); State := TKMemoRTFState.Create; State.Assign(FActiveState); FActiveState := State; end; function TKMemoRTFReader.ReadNext(out ACtrl, AText: AnsiString; out AParam: Int64): Boolean; procedure ReadText(var AText: AnsiString; AChar: AnsiChar); begin repeat if (AChar <> cCR) and (AChar <> cLF) then AText := AText + AChar; Result := FStream.Read(AChar, 1) > 0; until CharInSetEx(AChar, ['{', '}', '\']) or not Result; if Result then FStream.Seek(-1, soFromCurrent); end; var C: AnsiChar; ParamStr: AnsiString; Code: Integer; begin AParam := MaxInt; ACtrl := ''; AText := ''; Result := FStream.Read(C, 1) > 0; if C = '\' then begin FStream.Read(C, 1); if CharInSetEx(C, cLetters) then begin // control word repeat ACtrl := ACtrl + C; Result := FStream.Read(C, 1) > 0; until not (Result and CharInSetEx(C, cLetters)); if (C = '-') or CharInSetEx(C, cNumbers) then begin // control word parameter ParamStr := ''; repeat ParamStr := ParamStr + C; Result := FStream.Read(C, 1) > 0; until not (Result and CharInSetEx(C, cNumbers)); AParam := StrToIntDef(TKString(ParamStr), 0); if Result and (C <> ' ') then FStream.Seek(-1, soFromCurrent); end else if Result and (C <> ' ') then FStream.Seek(-1, soFromCurrent); end else begin ACtrl := C; //control symbol if C = '''' then begin //hexadecimal value - special symbol SetLength(ParamStr, 2); Result := FStream.Read(ParamStr[1], 2) = 2; if Result then AParam := HexStrToInt(string(ParamStr), Length(ParamStr), False, Code); end else if CharInSetEx(C, ['{', '}', '\']) then begin AText := C; // control symbol is printable character ACtrl := ''; end; end; if FStream.Read(C, 1) > 0 then begin if CharInSetEx(C, ['{', '}', '\']) then FStream.Seek(-1, soFromCurrent) else ReadText(AText, C); end; end else if CharInSetEx(C, ['{', '}', ';']) then ACtrl := C // group else ReadText(AText, C); end; procedure TKMemoRTFReader.ReadColorGroup(ACtrl: Integer; var AText: AnsiString; AParam: Integer); begin if FActiveState.Group = rgColorTable then begin case TKMemoRTFColorProp(ACtrl) of rpcRed: ActiveColor.Red := Byte(AParam); rpcGreen: ActiveColor.Green := Byte(AParam); rpcBlue: ActiveColor.Blue := Byte(AParam); end; if AText = ';' then begin FlushColor; AText := ''; // we used the text as end of the color record end; end; end; procedure TKMemoRTFReader.ReadDocumentGroups(ACtrl: Integer; var AText: AnsiString; AParam: Integer); begin if FActiveState.Group = rgNone then case TKMemoRTFDocumentProp(ACtrl) of rpdFooter, rpdFooterLeft, rpdFooterRight: FActiveState.Group := rgFooter; rpdHeader, rpdHeaderLeft, rpdHeaderRight: FActiveState.Group := rgHeader; rpdInfo: FActiveState.Group := rgInfo; end; end; procedure TKMemoRTFReader.ReadFieldGroup(ACtrl: Integer; var AText: AnsiString; AParam: Integer); begin case TKMemoRTFFieldProp(ACtrl) of rpfiField: begin FlushText; FActiveState.Group := rgField; end; rpfiResult: begin FlushText; FActiveState.Group := rgFieldResult; end else case FActiveState.Group of rgFieldInst: begin if AText <> '' then begin if Pos(cRTFHyperlink, string(AText)) = 1 then begin Delete(AText, 1, Length(cRTFHyperlink)); FActiveURL := TKString(AText); end else begin if FActiveURL <> '' then FActiveURL := FActiveURL + TKString(AText); end; AText := ''; end; end; end; end; end; procedure TKMemoRTFReader.ReadFontGroup(ACtrl: Integer; var AText: AnsiString; AParam: Integer); var I: Integer; S: TKString; begin case FActiveState.Group of rgFontTable: begin case TKMemoRTFFontProp(ACtrl) of rpfIndex: ActiveFont.FFontIndex := AParam; rpfCharSet: ActiveFont.Font.Charset := AParam; rpfPitch: begin case AParam of 1: ActiveFont.Font.Pitch := fpFixed; 2: ActiveFont.Font.Pitch := fpVariable; else ActiveFont.Font.Pitch := fpDefault; end; end; end; if AText <> '' then begin S := TKString(AText); I := Pos(';', S); if I > 0 then Delete(S, I, 1); ActiveFont.Font.Name := S; FlushFont; AText := ''; // we used the text as font name end end; rgNone, rgTextBox, rgFieldResult: begin case TKMemoRTFFontProp(ACtrl) of rpfIndex: ReadTextFormatting(Integer(rptFontIndex), AText, AParam); end; end; rgListLevel: begin case TKMemoRTFFontProp(ACtrl) of rpfIndex: ReadListGroup(Integer(rplLevelFontIndex), AText, AParam); end; end; end; end; procedure TKMemoRTFReader.ReadHeaderGroup(ACtrl: Integer; var AText: AnsiString; AParam: Integer); begin if FActiveState.Group = rgUnknown then begin case TKMemoRTFheaderProp(ACtrl) of rphRtf: FActiveState.Group := rgNone; end; end else if FActiveState.Group = rgNone then case TKMemoRTFheaderProp(ACtrl) of rphCodePage: FDefaultCodePage := AParam; rphDefaultFont: FDefaultFontIndex := AParam; rphIgnoreCharsAfterUnicode: FIgnoreCharsAfterUnicode := AParam; rphFontTable: FActiveState.Group := rgFontTable; rphColorTable: FActiveState.Group := rgColorTable; rphStyleSheet: FActiveState.Group := rgStyleSheet; end; end; procedure TKMemoRTFReader.ReadListGroup(ACtrl: Integer; var AText: AnsiString; AParam: Integer); begin case FActiveState.Group of rgListTable: case TKMemoRTFListProp(ACtrl) of rplList: FActiveState.Group := rgList; end; rgList: case TKMemoRTFListProp(ACtrl) of rplListLevel: FActiveState.Group := rgListLevel; rplListId: ActiveList.ID := AParam; end; rgListLevel: case TKMemoRTFListProp(ACtrl) of rplLevelText: FActiveState.Group := rgListLevelText; rplLevelStartAt: ActiveListLevel.StartAt := AParam; rplLevelNumberType: ActiveListLevel.NumberType := AParam; rplLevelJustify: ActiveListLevel.Justify := AParam; rplLevelFontIndex: ActiveListLevel.FontIndex := AParam; rplLevelFirstIndent: ActiveListLevel.FirstIndent := TwipsToPixelsX(AParam); rplLevelLeftIndent: ActiveListLevel.LeftIndent := TwipsToPixelsX(AParam); end; rgListOverrideTable: case TKMemoRTFListProp(ACtrl) of rplListOverride: FActiveState.Group := rgListOverride; end; rgListOverride: case TKMemoRTFListProp(ACtrl) of rplListId: ActiveListOverride.Value := AParam; rplListIndex: ActiveListOverride.Index := AParam; end; rgListLevelText: AddTextToNumberingFormat(string(AText)); else case TKMemoRTFListProp(ACtrl) of rplListText, rplPnText: FActiveState.Group := rgUnknown; // ignore text // Note: ignore old Word 95 'pntext' tag as well. We do not support // old Word 95 numbering style (so IMO it should not be ignored) // but some documents mix '\pntext' with '\lsN' control words. // This has the effect that the numbering is displayed twice if '\pntext' // is not ignored. end; end; end; procedure TKMemoRTFReader.ReadParaFormatting(ACtrl: Integer; var AText: AnsiString; AParam: Integer); begin case FActiveState.Group of rgNone, rgTextBox, rgFieldResult: case TKMemoRTFParaProp(ACtrl) of rppParD: if FMemo <> nil then FActiveState.ParaStyle.Assign(FMemo.ParaStyle); rppIndentFirst: FActiveState.ParaStyle.FirstIndent := TwipsToPixelsX(AParam); rppIndentBottom: FActiveState.ParaStyle.BottomPadding := TwipsToPixelsY(AParam); rppIndentLeft: FActiveState.ParaStyle.LeftPadding := TwipsToPixelsX(AParam); rppIndentRight: FActiveState.ParaStyle.RightPadding := TwipsToPixelsX(AParam); rppIndentTop: FActiveState.ParaStyle.TopPadding := TwipsToPixelsY(AParam); rppAlignLeft: FActiveState.ParaStyle.HAlign := halLeft; rppAlignCenter: FActiveState.ParaStyle.HAlign := halCenter; rppAlignRight: FActiveState.ParaStyle.HAlign := halRight; rppAlignJustify: FActiveState.ParaStyle.HAlign := halJustify; rppBackColor: FActiveState.ParaStyle.Brush.Color := FColorTable.GetColor(AParam); rppNoWordWrap: FActiveState.ParaStyle.WordWrap := False; rppBorderBottom: FActiveParaBorder := alBottom; rppBorderLeft: FActiveParaBorder := alLeft; rppBorderRight: FActiveParaBorder := alRight; rppBorderTop: FActiveParaBorder := alTop; rppBorderAll: FActiveParaBorder := alClient; rppBorderWidth: case FActiveParaBorder of alBottom: FActiveState.ParaStyle.BorderWidths.Bottom := TwipsToPixelsY(AParam); alLeft: FActiveState.ParaStyle.BorderWidths.Left := TwipsToPixelsX(AParam); alRight: FActiveState.ParaStyle.BorderWidths.Right := TwipsToPixelsX(AParam); alTop: FActiveState.ParaStyle.BorderWidths.Top := TwipsToPixelsY(AParam); alClient: FActiveState.ParaStyle.BorderWidth := TwipsToPixelsX(AParam); else if FActiveTableBorder <> alNone then ReadTableFormatting(Integer(rptbBorderWidth), AText, AParam) end; rppBorderNone: case FActiveParaBorder of alBottom: FActiveState.ParaStyle.BorderWidths.Bottom := 0; alLeft: FActiveState.ParaStyle.BorderWidths.Left := 0; alRight: FActiveState.ParaStyle.BorderWidths.Right := 0; alTop: FActiveState.ParaStyle.BorderWidths.Top := 0; alClient: FActiveState.ParaStyle.BorderWidth := 0; else if FActiveTableBorder <> alNone then ReadTableFormatting(Integer(rptbBorderNone), AText, AParam) end; rppBorderRadius: FActiveState.ParaStyle.BorderRadius := TwipsToPixelsX(AParam); rppBorderColor: begin if FActiveParaBorder <> alNone then FActiveState.ParaStyle.BorderColor := FColorTable.GetColor(AParam) else if FActiveTableBorder <> alNone then ReadTableFormatting(Integer(rptbBorderColor), AText, AParam) end; rppLineSpacing: begin FActiveState.ParaStyle.LineSpacingValue := TwipsToPixelsY(AParam); FActiveState.ParaStyle.LineSpacingFactor := AParam / 240; end; rppLineSpacingMode: begin if AParam = 0 then FActiveState.ParaStyle.LineSpacingMode := lsmValue else FActiveState.ParaStyle.LineSpacingMode := lsmFactor end; rppPar: begin FlushText; FlushParagraph; end; rppListIndex: FActiveState.ParaStyle.NumberingList := FListTable.IDByIndex(AParam); rppListLevel: FActiveState.ParaStyle.NumberingListLevel := AParam; rppListStartAt: FActiveState.ParaStyle.NumberStartAt := AParam; end; rgListLevel: case TKMemoRTFParaProp(ACtrl) of rppIndentFirst: ReadListgroup(Integer(rplLevelFirstIndent), AText, AParam); rppIndentLeft: ReadListgroup(Integer(rplLevelLeftIndent), AText, AParam); end; rgListOverride: case TKMemoRTFParaProp(ACtrl) of rppListIndex: ReadListgroup(Integer(rplListIndex), AText, AParam); end; end; end; procedure TKMemoRTFReader.ReadPictureGroup(ACtrl: Integer; var AText: AnsiString; AParam: Integer); var S: AnsiString; MS: TMemoryStream; Image: TGraphic; Tmp: Integer; begin if FActiveState.Group in [rgShapeInst, rgShapePict, rgNone, rgTextBox] then begin case TKMemoRTFImageProp(ACtrl) of rpiPict: begin FActiveState.Group := rgPicture; end; end; end else if FActiveState.Group in [rgPicture] then begin case TKMemoRTFImageProp(ACtrl) of rpiJPeg: FActiveImageClass := TJpegImage; {$IFDEF USE_PNG_SUPPORT} rpiPng: FActiveImageClass := TKPngImage; {$ENDIF} {$IFDEF MSWINDOWS} rpiEmf: begin FActiveImageClass := TKMetafile; FActiveImageIsEMF := True; end; rpiWmf: begin FActiveImageClass := TKMetafile; FActiveImageIsEMF := False; end; {$ENDIF} rpiWidth: ActiveImage.ExplicitWidth := TwipsToPixelsX(AParam); rpiHeight: ActiveImage.ExplicitHeight := TwipsToPixelsY(AParam); rpiCropBottom: ActiveImage.Crop.Bottom := TwipsToPixelsY(AParam); rpiCropLeft: ActiveImage.Crop.Left := TwipsToPixelsX(AParam); rpiCropRight: ActiveImage.Crop.Right := TwipsToPixelsX(AParam); rpiCropTop: ActiveImage.Crop.Top := TwipsToPixelsY(AParam); rpiScaleX: begin if AParam > 0 then ActiveImage.ScaleX := AParam; end; rpiScaleY: begin if AParam > 0 then ActiveImage.ScaleY := AParam; end; rpiReqWidth: if ActiveImage.ExplicitWidth > 0 then begin Tmp := MulDiv(TwipsToPixelsX(AParam), 100, ActiveImage.ExplicitWidth); if Tmp < ActiveImage.ScaleX then ActiveImage.ScaleX := Tmp; end; rpiReqHeight: if ActiveImage.ExplicitHeight > 0 then begin Tmp := MulDiv(TwipsToPixelsY(AParam), 100, ActiveImage.ExplicitHeight); if Tmp < ActiveImage.ScaleY then ActiveImage.ScaleY := Tmp; end; end; if AText <> '' then begin if FActiveImageClass <> nil then begin S := AText; if DigitsToBinStr(S) then begin S := BinStrToBinary(S); try MS := TMemoryStream.Create; try MS.Write(S[1], Length(S)); MS.Seek(0, soFromBeginning); Image := FActiveImageClass.Create; try {$IFDEF MSWINDOWS} if Image is TKMetafile then begin //if not FActiveImageIsEMF then MS.SaveToFile('test.wmf'); TKMetafile(Image).CopyOnAssign := False; // we will destroy this instance anyway... TKMetafile(Image).Enhanced := FActiveImageIsEMF; TKmetafile(Image).LoadFromStream(MS); if not FActiveImageIsEMF then begin // WMF extent could be incorrect here, so use RTF info TKMetafile(Image).Width := PixelsToTwipsX(ActiveImage.ExplicitWidth); TKMetafile(Image).Height := PixelsToTwipsY(ActiveImage.ExplicitHeight); end; end else {$ENDIF} Image.LoadFromStream(MS); ActiveImage.Image := Image; finally Image.Free; end; finally MS.Free; end; except KFunctions.Error(sErrMemoLoadImageFromRTF); end; end; FActiveImageClass := nil; end; AText := ''; // we used the text as image data end; end; end; procedure TKMemoRTFReader.ReadShapeGroup(ACtrl: Integer; var AText: AnsiString; AParam: Integer); begin case TKMemoRTFShapeProp(ACtrl) of rpsShape: FActiveState.Group := rgShape; end; if FActiveState.Group in [rgShapeInst, rgShapePict, rgPicProp] then case TKMemoRTFShapeProp(ACtrl) of rpsBottom: ActiveShape.ContentPosition.Bottom := TwipsToPixelsY(AParam); rpsLeft: ActiveShape.ContentPosition.Left := TwipsToPixelsX(AParam); rpsRight: ActiveShape.ContentPosition.Right := TwipsToPixelsX(AParam); rpsTop: ActiveShape.ContentPosition.Top := TwipsToPixelsY(AParam); rpsXColumn: ActiveShape.HorzPosCode := 2; // we silently assume posrelh always comes later rpsYPara: ActiveShape.VertPosCode := 2; // we silently assume posrelv always comes later rpsWrap: ActiveShape.Wrap := AParam; rpsWrapSide: ActiveShape.WrapSide := AParam; rpsSn: ActiveShape.CtrlName := AText; rpsSv: begin ActiveShape.CtrlValue := AText; // do different things according to CtrlName property if ActiveShape.CtrlName = 'posrelh' then begin ActiveShape.HorzPosCode := ParamToInt(AText); end else if ActiveShape.CtrlName = 'posrelv' then begin ActiveShape.VertPosCode := ParamToInt(AText); end else if ActiveShape.CtrlName = 'fFitShapeToText' then ActiveShape.FitToText := True else if ActiveShape.CtrlName = 'fFitTextToShape' then ActiveShape.FitToShape := True else if ActiveShape.CtrlName = 'fFilled' then begin if not ParamToBool(AText) then ActiveShape.Style.Brush.Style := bsClear; end else if ActiveShape.CtrlName = 'fillColor' then ActiveShape.Style.Brush.Color := ParamToColor(AText) else if ActiveShape.CtrlName = 'fillBlip' then ActiveShape.FillBlip := True else if ActiveShape.CtrlName = 'fLine' then begin if not ParamToBool(AText) then ActiveShape.Style.BorderWidth := 0; end else if ActiveShape.CtrlName = 'lineColor' then ActiveShape.Style.BorderColor := ParamToColor(AText) else if ActiveShape.CtrlName = 'lineWidth' then ActiveShape.Style.BorderWidth := ParamToEMU(AText) else if ActiveShape.CtrlName = 'shapeType' then begin // supported shape types case StrToIntDef(string(ActiveShape.CtrlValue), 0) of 1: ActiveShape.ContentType := sctRectangle; 75: ActiveShape.ContentType := sctImage; 202: begin ActiveShape.ContentType := sctTextBox; ActiveShape.Style.ContentPadding.AssignFromValues(5, 5, 5, 5); //default padding for text box end; end; end; end; rpsShapeText: begin // this keyword starts the actual text box contents FlushText; ActiveContainer.Parent := FActiveBlocks; FActiveBlocks := ActiveContainer.Blocks; FIndexStack.PushValue(FAtIndex); FAtIndex := 0; FActiveState.Group := rgTextBox; end; end; end; procedure TKMemoRTFReader.ReadSpecialCharacter(ACtrl: Integer; var AText: AnsiString; AParam: Integer); var S: TKString; CodePage: Integer; SetIgnoreChars: Boolean; begin SetIgnoreChars := False; S := ''; // we must suppose here selected font supports these Unicode characters case TKMemoRTFSpecialCharProp(ACtrl) of rpscTab: S := #9; // tab is rendered with an arrow symbol rpscLquote: S := UnicodeToNativeUTF(#$2018); rpscRQuote: S := UnicodeToNativeUTF(#$2019); rpscLDblQuote: S := UnicodeToNativeUTF(#$201C); rpscRDblQuote: S := UnicodeToNativeUTF(#$201D); rpscEnDash: S := UnicodeToNativeUTF(#$2013); rpscEmDash: S := UnicodeToNativeUTF(#$2014); rpscBullet: S := UnicodeToNativeUTF(#$2022); rpscNBSP: S := ' '; // nonbreaking spaces not supported rpscEmSpace: S := ' '; rpscEnSpace: S := ' '; rpscAnsiChar: begin if AParam < $20 then S := Chr(AParam) else begin if FActiveState.TextStyle.Font.Name = 'Symbol' then S := UnicodeToNativeUTF(WideChar(AdobeSymbolToUTF16(AParam))) else begin if FActiveState.TextStyle.Font.Charset = 0 then CodePage := FDefaultCodePage else CodePage := CharSetToCP(FActiveState.TextStyle.Font.Charset); S := AnsiStringToString(AnsiChar(AParam), CodePage); end; end; end; rpscUnicodeChar: begin S := UnicodeToNativeUTF(WideChar(AParam)); SetIgnoreChars := True; end; end; case FActiveState.Group of rgNone, rgTextBox, rgFieldResult: AddText(S); rgListLevelText: AddTextToNumberingFormat(S); end; if SetIgnoreChars and (FActiveState.Group <> rgUnknown) then FIgnoreChars := FIgnoreCharsAfterUnicode; end; procedure TKMemoRTFReader.ReadStream; var Ctrl: AnsiString; Text: AnsiString; Param: Int64; CtrlItem: TKMemoRTFCtrl; begin while FStream.Position < FStream.Size do begin ReadNext(Ctrl, Text, Param); if (Ctrl <> '') or (Text <> '') then begin if Ctrl <> '' then begin CtrlItem := FCtrlTable.FindByCtrl(Ctrl); if CtrlItem <> nil then CtrlItem.Method(CtrlItem.Code, Text, Param); end; if Text <> '' then begin // if Method did not use Text use it according to active group case FActiveState.Group of rgColorTable: ReadColorGroup(Integer(rpcNone), Text, 0); rgFieldInst: ReadFieldGroup(Integer(rpfiNone), Text, 0); rgFontTable: ReadFontGroup(Integer(rpfNone), Text, 0); rgPicture: ReadPictureGroup(Integer(rpiNone), Text, 0); rgListLevelText: ReadListGroup(Integer(rplNone), Text, 0); rgNone, rgTextBox, rgFieldResult: AddText(TKString(Text)); end; end; end; end; end; procedure TKMemoRTFReader.ReadTableFormatting(ACtrl: Integer; var AText: AnsiString; AParam: Integer); var I, Value: Integer; Cell: TKMemoTableCell; begin if FActiveState.Group in [rgNone, rgTextBox] then case TKMemoRTFTableProp(ACtrl) of rptbRowBegin: begin if FActiveTableColCount = 0 then begin FlushText; if FActiveTable = nil then begin ActiveTable.LockUpdate; ActiveTable.Parent := FActiveBlocks; // needs a parent to correctly update ActiveTable.RowCount := 1; ActiveTable.ColCount := 1; FActiveTableColCount := 1; FActiveTableRow := ActiveTable.Rows[ActiveTable.RowCount - 1]; FActiveBlocks := FActiveTableRow.Cells[FActiveTableColCount - 1].Blocks; // starting new cell FIndexStack.PushValue(FAtIndex); FAtIndex := 0; FActiveTableCellXPos := 0; FActiveTableLastRow := False; end; end else if (FActiveTableRow <> nil) and (FActiveTableRow.CellCount > 1) then begin // this block comes again after definition of the row and is used to read row/cell properties (at least Word saves this) // we don't support reading cell properties before entire row is defined with /cell control words FActiveTableCol := 0; FActiveTableCell := FActiveTableRow.Cells[FActiveTableCol]; end end; rptbCellEnd: if FActiveTableRow <> nil then begin FlushText; Cell := FActiveTableRow.Cells[FActiveTableColCount - 1]; Cell.ParaStyle.Assign(FActiveState.ParaStyle); Inc(FActiveTableColCount); FActiveTableRow.CellCount := FActiveTableColCount; FActiveBlocks := FActiveTableRow.Cells[FActiveTableColCount - 1].Blocks; // starting new cell FAtIndex := 0; end; rptbRowEnd: if FActiveTableRow <> nil then begin // delete previously started cell if empty if FActiveTableRow.Cells[FActiveTableColCount - 1].Blocks.Count = 0 then FActiveTableRow.CellCount := FActiveTableRow.CellCount - 1; if FActiveTableLastRow then begin FlushTable; FActiveTableLastRow := False; FActiveTableColCount := 0; end else begin ActiveTable.RowCount := ActiveTable.RowCount + 1; ActiveTable.ColCount := Max(ActiveTable.ColCount, FActiveTableRow.CellCount); FActiveTableRow := ActiveTable.Rows[ActiveTable.RowCount - 1]; FActiveTableColCount := 1; FActiveTableRow.CellCount := FActiveTableColCount; FActiveBlocks := FActiveTableRow.Cells[FActiveTableColCount - 1].Blocks; // starting new cell FAtIndex := 0; FActiveTableCellXPos := 0; end; FActiveTableCol := -1; FActiveTableCell := nil; FActiveTableBorder := alNone; end; rptbLastRow: FActiveTableLastRow := True; end; // read row/cell formatting (if any) if (FActiveTableRow <> nil) and (FActiveTableCell <> nil) then case TKMemoRTFTableProp(ACtrl) of rptbPaddAll: begin // we silently assume this will come before other rptbRowPaddxx ctrls Value := TwipsToPixelsX(AParam); for I := 0 to FActiveTableRow.CellCount - 1 do FActiveTableRow.Cells[I].BlockStyle.ContentPadding.AssignFromValues(Value, Value, Value, Value); end; rptbRowPaddBottom: begin FActiveTableRowPadd.Bottom := TwipsToPixelsY(AParam); for I := 0 to FActiveTableRow.CellCount - 1 do FActiveTableRow.Cells[I].BlockStyle.BottomPadding := FActiveTableRowPadd.Bottom; end; rptbRowPaddLeft: begin FActiveTableRowPadd.Left := TwipsToPixelsX(AParam); for I := 0 to FActiveTableRow.CellCount - 1 do FActiveTableRow.Cells[I].BlockStyle.LeftPadding := FActiveTableRowPadd.Left; end; rptbRowPaddRight: begin FActiveTableRowPadd.Right := TwipsToPixelsX(AParam); for I := 0 to FActiveTableRow.CellCount - 1 do FActiveTableRow.Cells[I].BlockStyle.RightPadding := FActiveTableRowPadd.Right; end; rptbRowPaddTop: begin FActiveTableRowPadd.Top := TwipsToPixelsY(AParam); for I := 0 to FActiveTableRow.CellCount - 1 do FActiveTableRow.Cells[I].BlockStyle.TopPadding := FActiveTableRowPadd.Top; end; rptbBorderBottom: FActiveTableBorder := alBottom; rptbBorderLeft: FActiveTableBorder := alLeft; rptbBorderRight: FActiveTableBorder := alRight; rptbBorderTop: FActiveTableBorder := alTop; rptbBorderWidth: begin case FActiveTableBorder of alBottom: FActiveTableCell.RequiredBorderWidths.Bottom := TwipsToPixelsY(AParam); alLeft: FActiveTableCell.RequiredBorderWidths.Left := TwipsToPixelsX(AParam); alRight: FActiveTableCell.RequiredBorderWidths.Right := TwipsToPixelsX(AParam); alTop: FActiveTableCell.RequiredBorderWidths.Top := TwipsToPixelsY(AParam); end; end; rptbBorderNone: begin case FActiveTableBorder of alBottom: FActiveTableCell.RequiredBorderWidths.Bottom := 0; alLeft: FActiveTableCell.RequiredBorderWidths.Left := 0; alRight: FActiveTableCell.RequiredBorderWidths.Right := 0; alTop: FActiveTableCell.RequiredBorderWidths.Top := 0; end; end; rptbBorderColor: FActiveTableCell.BlockStyle.BorderColor := FColorTable.GetColor(AParam); // no support for different colors for different borders rptbBackColor: FActiveTableCell.BlockStyle.Brush.Color := FColorTable.GetColor(AParam); rptbHorzMerge: FActiveTableCell.ColSpan := 0; // indicate for later fixup rptbVertMerge: FActiveTableCell.RowSpan := 0; // indicate for later fixup rptbCellPaddBottom: FActiveTableCell.BlockStyle.BottomPadding := TwipsToPixelsY(AParam); rptbCellPaddLeft: FActiveTableCell.BlockStyle.LeftPadding := TwipsToPixelsX(AParam); rptbCellPaddRight: FActiveTableCell.BlockStyle.RightPadding := TwipsToPixelsX(AParam); rptbCellPaddTop: FActiveTableCell.BlockStyle.TopPadding := TwipsToPixelsY(AParam); rptbCellWidth: begin FActiveTableCell.FixedWidth := True; FActiveTableCell.RequiredWidth := TwipsToPixelsX(AParam); end; rptbCellX: begin // this command comes as the last for current cell Value := FActiveTableCellXPos; FActiveTableCellXPos := TwipsToPixelsX(AParam); FActiveTableCell.RequiredWidth := FActiveTableCellXPos - Value; Inc(FActiveTableCol); if FActiveTableCol < FActiveTableRow.CellCount then FActiveTableCell := FActiveTableRow.Cells[FActiveTableCol] else FActiveTableCell := nil; // error in RTF, ignore next properties end; end; end; procedure TKMemoRTFReader.ReadTextFormatting(ACtrl: Integer; var AText: AnsiString; AParam: Integer); begin if FActiveState.Group in [rgNone, rgTextBox, rgFieldResult] then case TKMemoRTFTextProp(ACtrl) of rptPlain: begin if FMemo <> nil then FActiveState.TextStyle.Assign(FMemo.TextStyle); end; rptFontIndex: ApplyFont(FActiveState.TextStyle, AParam); rptBold: begin if AParam = 0 then FActiveState.TextStyle.Font.Style := FActiveState.TextStyle.Font.Style - [fsBold] else FActiveState.TextStyle.Font.Style := FActiveState.TextStyle.Font.Style + [fsBold]; end; rptItalic: begin if AParam = 0 then FActiveState.TextStyle.Font.Style := FActiveState.TextStyle.Font.Style - [fsItalic] else FActiveState.TextStyle.Font.Style := FActiveState.TextStyle.Font.Style + [fsItalic]; end; rptUnderline: begin if AParam = 0 then FActiveState.TextStyle.Font.Style := FActiveState.TextStyle.Font.Style - [fsUnderline] else FActiveState.TextStyle.Font.Style := FActiveState.TextStyle.Font.Style + [fsUnderline]; end; rptStrikeout: begin if AParam = 0 then FActiveState.TextStyle.Font.Style := FActiveState.TextStyle.Font.Style - [fsStrikeout] else FActiveState.TextStyle.Font.Style := FActiveState.TextStyle.Font.Style + [fsStrikeout]; end; rptCaps: FActiveState.TextStyle.Capitals := tcaNormal; rptSmallCaps: FActiveState.TextStyle.Capitals := tcaSmall; rptFontSize: FActiveState.TextStyle.Font.Size := DivUp(AParam, 2); rptForeColor: FActiveState.TextStyle.Font.Color := FColorTable.GetColor(AParam); rptBackColor: FActiveState.TextStyle.Brush.Color := FColorTable.GetColor(AParam); rptSubscript: FActiveState.TextStyle.ScriptPosition := tpoSubscript; rptSuperscript: FActiveState.TextStyle.ScriptPosition := tpoSuperscript; end; end; procedure TKMemoRTFReader.ReadUnknownGroup(ACtrl: Integer; var AText: AnsiString; AParam: Integer); begin if not (FActiveState.Group in [rgInfo, rgHeader, rgFooter]) then case TKMemoRTFUnknownProp(ACtrl) of rpuUnknownSym: FActiveState.Group := rgUnknown; rpuNonShapePict: FActiveState.Group := rgUnknown; // we ignore this picture end; if FActiveState.Group = rgUnknown then case TKMemoRTFUnknownProp(ACtrl) of rpuFieldInst: FActiveState.Group := rgFieldInst; // field inside text rpuShapeInst: FActiveState.Group := rgShapeInst; // picture inside text rpuShapePict: FActiveState.Group := rgShapePict; // picture inside text rpuPageBackground: FActiveState.Group := rgPageBackground; // this is the page background, read it rpuPicProp: FActiveState.Group := rgPicProp; // non shape picture has some shape properties, read them rpuListTable: FActiveState.Group := rgListTable; rpuListOverrideTable: FActiveState.Group := rgListOverrideTable; end; end; { TKMemoRTFWriter } constructor TKMemoRTFWriter.Create(AMemo: TKCustomMemo); begin inherited; FGroupLevel := 0; FReadableOutput := False; FColorTable := TKMemoRTFColorTable.Create; FFontTable := TKMemoRTFFontTable.Create; FListTable := TKMemoRTFListTable.Create; FSelectedOnly := False; FStream := nil; end; destructor TKMemoRTFWriter.Destroy; begin FColorTable.Free; FFontTable.Free; FListTable.Free; inherited; end; function TKMemoRTFWriter.BoolToParam(AValue: Boolean): AnsiString; begin Result := AnsiString(IntToStr(Integer(AValue))); end; function TKMemoRTFWriter.CanSave(ABlock: TKMemoBlock): Boolean; begin Result := not FSelectedOnly or (ABlock <> nil) and (ABlock.SelLength > 0); end; function TKMemoRTFWriter.ColorToHighlightCode(AValue: TColor): Integer; begin // we save highlight color as reference to color table, is it correct? case AValue of clBlack: Result := 1; clBlue: Result := 2; clAqua: Result := 3; // cyan clLime: Result := 4; // green clFuchsia: Result := 5; // magenta clRed: Result := 6; clYellow: Result := 7; clNavy: Result := 9; clTeal: Result := 10; // dark cyan clGreen: Result := 11; // dark green clPurple: Result := 12; // dark magenta clMaroon: Result := 13; // dark red clOlive: Result := 14; // dark yellow clGray: Result := 15; // dark gray clSilver: Result := 16; // light gray else Result := 0; end; end; function TKMemoRTFWriter.ColorToParam(AValue: TColor): AnsiString; begin Result := AnsiString(IntToStr(ColorToColorRec(Avalue).Value)); end; function TKMemoRTFWriter.EMUToParam(AValue: Integer): AnsiString; begin Result := AnsiString(IntToStr(PointsToEMU(AValue))); end; procedure TKMemoRTFWriter.FillColorTable(ABlocks: TKMemoBlocks); var I: Integer; Block: TKmemoBlock; begin if ABlocks <> nil then begin for I := 0 to ABlocks.Count - 1 do begin Block := Ablocks[I]; if CanSave(Block) then begin if Block is TKMemoTextBlock then begin FColorTable.AddColor(TKmemoTextBlock(Block).TextStyle.Brush.Color); FColorTable.AddColor(TKmemoTextBlock(Block).TextStyle.Font.Color); if Block is TKMemoParagraph then begin FColorTable.AddColor(TKMemoParagraph(Block).ParaStyle.Brush.Color); FColorTable.AddColor(TKMemoParagraph(Block).ParaStyle.BorderColor); end; end else if Block is TKMemoContainer then begin FColorTable.AddColor(TKmemoContainer(Block).BlockStyle.Brush.Color); FColorTable.AddColor(TKmemoContainer(Block).BlockStyle.BorderColor); if Block is TKMemoTable then begin FColorTable.AddColor(TKmemoTable(Block).CellStyle.Brush.Color); FColorTable.AddColor(TKmemoTable(Block).CellStyle.BorderColor); end; FillColorTable(TKmemoContainer(Block).Blocks); end; end; end; end; end; procedure TKMemoRTFWriter.FillFontTable(ABlocks: TKMemoBlocks); var I: Integer; Block: TKmemoBlock; begin if ABlocks <> nil then begin for I := 0 to ABlocks.Count - 1 do begin Block := Ablocks[I]; if CanSave(Block) then begin if Block is TKMemoTextBlock then FFontTable.AddFont(TKmemoTextBlock(Block).TextStyle.Font) else if Block is TKmemoContainer then FillFontTable(TKmemoContainer(Block).Blocks); end; end; end; end; procedure TKMemoRTFWriter.SaveToFile(const AFileName: TKString; ASelectedOnly: Boolean); var Stream: TMemoryStream; begin Stream := TMemoryStream.Create; try SaveToStream(Stream, ASelectedOnly); Stream.SaveToFile(AFileName); finally Stream.Free; end; end; procedure TKMemoRTFWriter.SaveToStream(AStream: TStream; ASelectedOnly: Boolean; AActiveBlocks: TKMemoBlocks); var ActiveBlocks, Blocks1, Blocks2, SavedBlocks1: TKMemoBlocks; LocalIndex: TKMemoSelectionIndex; begin try FStream := AStream; FSelectedOnly := ASelectedOnly; if AActiveBlocks <> nil then ActiveBlocks := AActiveBlocks else ActiveBlocks := FMemo.ActiveBlocks; if ActiveBlocks <> nil then begin if FSelectedOnly then begin // find common parent blocks for the selection and use this instead of main blocks Blocks1 := ActiveBlocks.IndexToBlocks(ActiveBlocks.SelStart, LocalIndex); Blocks2 := ActiveBlocks.IndexToBlocks(ActiveBlocks.SelEnd, LocalIndex); SavedBlocks1 := Blocks1; while Blocks1 <> Blocks2 do begin Blocks1 := Blocks1.ParentBlocks; if Blocks1 = nil then begin Blocks2 := Blocks2.ParentBlocks; if Blocks2 <> nil then Blocks1 := SavedBlocks1; end; end; // If the parent blocks are maintained by a container (eg. a table) which // is placed in the text then take the outermost non-container blocks placed in the text // or a container with relative or absolute position. while (Blocks1.Parent is TKMemoContainer) and (Blocks1.Parent.Position = mbpText) do Blocks1 := Blocks1.ParentBlocks; ActiveBlocks := Blocks1; end; ActiveBlocks.ConcatEqualBlocks; FCodePage := SystemCodepage; WriteGroupBegin; try WriteHeader(ActiveBlocks); WriteBackground; WriteBody(ActiveBlocks, False); finally WriteGroupEnd; end; end; except KFunctions.Error(sErrMemoSaveToRTF); end; end; procedure TKMemoRTFWriter.WriteBackground; var Shape: TKMemoRTFShape; begin if not FSelectedOnly and (FMemo <> nil) and ((FMemo.Colors.BkGnd <> clWindow) or (FMemo.Background.Image.Graphic <> nil)) then begin WriteCtrlParam('viewbksp', 1); WriteGroupBegin; try WriteUnknownGroup; WriteCtrl('background'); WriteSpace; Shape := TKmemoRTFShape.Create; try Shape.ContentType := sctRectangle; Shape.FitToShape := False; Shape.FitToText := False; Shape.Style.WrapMode := wrUnknown; Shape.Style.Brush.Color := FMemo.Colors.BkGnd; Shape.Style.FillBlip := FMemo.Background.Image.Graphic; Shape.Background := True; Shape.HorzPosCode := 0; Shape.VertPosCode := 0; WriteShape(Shape, False); finally Shape.Free; end; finally WriteGroupEnd; end; end; end; procedure TKMemoRTFWriter.WriteBody(ABlocks: TKMemoBlocks; AInsideOfTable: Boolean); var I: Integer; Block: TKMemoBlock; PA: TKMemoParagraph; IsParagraph: Boolean; URL: TKString; begin if ABlocks <> nil then begin URL := ''; IsParagraph := False; for I := 0 to ABlocks.Count - 1 do begin Block := ABlocks[I]; if CanSave(Block) then begin if Block is TKMemoHyperlink then begin if URL <> TKMemoHyperlink(Block).URL then begin if URL <> '' then WriteHyperlinkEnd; WriteHyperlinkBegin(TKMemoHyperlink(Block)); URL := TKMemoHyperlink(Block).URL; end; WriteTextBlock(TKMemoTextBlock(Block), FSelectedOnly) end else begin if URL <> '' then begin WriteHyperlinkEnd; URL := ''; end; if IsParagraph then begin PA := ABlocks.GetNearestParagraphBlock(I); if PA <> nil then WriteListText(PA.NumberBlock); IsParagraph := False; end; if Block is TKMemoParagraph then begin if not AInsideOfTable or (I < ABlocks.Count - 1) then WriteParagraph(TKMemoParagraph(Block), AInsideOfTable); IsParagraph := True; end else if Block is TKMemoTextBlock then WriteTextBlock(TKMemoTextBlock(Block), FSelectedOnly) else if Block is TKMemoImageBlock then WriteImageBlock(TKMemoImageBlock(Block), AInsideOfTable) else if Block is TKMemoContainer then begin if Block is TKMemoTable then WriteTable(TKMemoTable(Block)) else if Block.Position <> mbpText then WriteContainer(TKMemoContainer(Block), AInsideOfTable) else WriteBody(TKMemoContainer(Block).Blocks, AInsideOfTable) // just save the contents end; end; end; end; if URL <> '' then WriteHyperlinkEnd; end; end; procedure TKMemoRTFWriter.WriteColorTable; var I: Integer; ColorRec: TKColorRec; begin WriteGroupBegin; try WriteCtrl('colortbl'); // WriteSemicolon; // no default color, write all colors explictly for I := 0 to FColorTable.Count - 1 do begin ColorRec := FColorTable[I].ColorRec; WriteCtrlParam('red', ColorRec.R); WriteCtrlParam('green', ColorRec.G); WriteCtrlParam('blue', ColorRec.B); WriteSemiColon; end; finally WriteGroupEnd; end; end; procedure TKMemoRTFWriter.WriteContainer(ABlock: TKMemoContainer; AInsideTable: Boolean); var Shape: TKMemoRTFShape; begin // write generic container - write as RTF text box Shape := TKMemoRTFShape.Create; try Shape.ContentType := sctTextBox; Shape.Block := ABlock; Shape.ContentPosition.Left := ABlock.LeftOffset; Shape.ContentPosition.Top := ABlock.TopOffset; Shape.ContentPosition.Right := ABlock.LeftOffset + ABlock.RequiredWidth; Shape.ContentPosition.Bottom := ABlock.TopOffset + ABlock.RequiredHeight; Shape.FitToText := not ABlock.FixedHeight; Shape.HorzPosCode := 2; // position by column, we don't support any other Shape.VertPosCode := 2; // position by paragraph, we don't support any other Shape.Style.Assign(ABlock.BlockStyle); WriteShape(Shape, AInsideTable); finally Shape.Free; end; end; procedure TKMemoRTFWriter.WriteCtrl(const ACtrl: AnsiString); begin WriteString('\' + ACtrl); end; procedure TKMemoRTFWriter.WriteCtrlParam(const ACtrl: AnsiString; AParam: Integer); begin WriteString(AnsiString(Format('\%s%d', [ACtrl, AParam]))); end; procedure TKMemoRTFWriter.WriteFontTable; var I, Pitch, Charset: Integer; begin WriteGroupBegin; try WriteCtrl('fonttbl'); for I := 0 to FFontTable.Count - 1 do begin WriteGroupBegin; try WriteCtrlParam('f', I); Charset := FFontTable[I].Font.Charset; {if Charset = 0 then Charset := CPToCharset(FCodePage); // don't override charset, it is still important for certain fonts!} WriteCtrlParam('fcharset', Charset); case FFontTable[I].Font.Pitch of fpFixed: Pitch := 1; fpVariable: Pitch := 2; else Pitch := 0; end; WriteCtrlParam('fprq', Pitch); WriteSpace; WriteString(AnsiString(FFontTable[I].Font.Name)); WriteSemiColon; finally WriteGroupEnd; end; end; finally WriteGroupEnd; end; end; procedure TKMemoRTFWriter.WriteGroupBegin; begin if FReadableOutput and (FStream.Size > 0) then WriteString(cCR+cLF); WriteString('{'); Inc(FGroupLevel); end; procedure TKMemoRTFWriter.WriteGroupEnd; begin Dec(FGroupLevel); WriteString('}'); end; procedure TKMemoRTFWriter.WriteHeader(ABlocks: TKMemoBlocks); begin if FMemo <> nil then begin FFontTable.AddFont(FMemo.TextStyle.Font); FListTable.AssignFromListTable(FMemo.ListTable, FFontTable); end; FillFontTable(ABlocks); FillColorTable(ABlocks); WriteCtrl('rtf1'); WriteCtrl('ansi'); WriteCtrlParam('ansicpg', FCodePage); if FFontTable.Count > 0 then WriteCtrlParam('deff', 0); WriteCtrlParam('uc', 1); WriteFontTable; WriteColorTable; WriteListTable; end; procedure TKMemoRTFWriter.WriteHyperlinkBegin(ABlock: TKMemoHyperlink); begin WriteGroupBegin; WriteCtrl('field'); WriteGroupBegin; try WriteUnknownGroup; WriteCtrl('fldinst'); WriteSpace; WriteString(cRTFHyperlink); WriteSpace; WriteUnicodeString(TKMemoHyperLink(ABlock).URL); finally WriteGroupEnd; end; WriteGroupBegin; WriteCtrl('fldrslt'); end; procedure TKMemoRTFWriter.WriteHyperlinkEnd; begin WriteGroupEnd; WriteGroupEnd; end; procedure TKMemoRTFWriter.WriteImage(ABlock: TKmemoImageBlock); begin WriteCtrlParam('picw', PixelsToTwipsX(ABlock.NativeOrExplicitWidth)); WriteCtrlParam('pich', PixelsToTwipsY(ABlock.NativeOrExplicitHeight)); WriteCtrlParam('picscalex', MulDiv(ABlock.ScaleWidth, 100, ABlock.NativeOrExplicitWidth)); WriteCtrlParam('picscaley', MulDiv(ABlock.ScaleHeight, 100, ABlock.NativeOrExplicitHeight)); WriteCtrlParam('picwgoal', PixelsToTwipsX(ABlock.ScaleWidth)); WriteCtrlParam('pichgoal', PixelsToTwipsY(ABlock.ScaleHeight)); WriteCtrlParam('piccropb', PixelsToTwipsY(ABlock.Crop.Bottom)); WriteCtrlParam('piccropl', PixelsToTwipsX(ABlock.Crop.Left)); WriteCtrlParam('piccropr', PixelsToTwipsX(ABlock.Crop.Right)); WriteCtrlParam('piccropt', PixelsToTwipsY(ABlock.Crop.Top)); WritePicture(ABlock.Image); end; procedure TKMemoRTFWriter.WriteImageBlock(ABlock: TKmemoImageBlock; AInsideTable: Boolean); var Shape: TKMemoRTFShape; begin // write generic container - write as RTF text box Shape := TKMemoRTFShape.Create; try Shape.ContentType := sctImage; Shape.FitToShape := False; Shape.FitToText := False; Shape.Style.Assign(ABlock.ImageStyle); if ABlock.Position = mbpText then begin WriteGroupBegin; try WriteUnknownGroup; WriteCtrl('shppict'); WriteGroupBegin; try WriteCtrl('pict'); WriteGroupBegin; try WriteUnknownGroup; WriteCtrl('picprop'); WriteShapeProperties(Shape); finally WriteGroupEnd; end; WriteImage(ABlock); finally WriteGroupEnd; end; finally WriteGroupEnd; end; end else begin Shape.Block := ABlock; Shape.ContentPosition.Left := ABlock.LeftOffset; Shape.ContentPosition.Top := ABlock.TopOffset; Shape.ContentPosition.Right := ABlock.LeftOffset + ABlock.ScaleWidth + ABlock.ImageStyle.LeftPadding + ABlock.ImageStyle.RightPadding; Shape.ContentPosition.Bottom := ABlock.TopOffset + ABlock.ScaleHeight + ABlock.ImageStyle.TopPadding + ABlock.ImageStyle.BottomPadding; Shape.HorzPosCode := 2; // we don't support any other Shape.VertPosCode := 2; // we don't support any other WriteShape(Shape, AInsideTable); end; finally Shape.Free; end; end; procedure TKMemoRTFWriter.WriteListTable; var I, J, K, Len: Integer; Item: TKMemoRTFList; Level: TKMemoRTFListLevel; NFItem: TKMemoNumberingFormatItem; OverrideItem: TKMemoDictionaryItem; begin // first write list table WriteGroupBegin; try WriteUnknownGroup; WriteCtrl('listtable'); for I := 0 to FListTable.Count - 1 do begin Item := FListTable[I]; WriteGroupBegin; try WriteCtrl('list'); for J := 0 to Item.Levels.Count - 1 do begin Level := Item.Levels[J]; WriteGroupBegin; try WriteCtrl('listlevel'); WriteCtrlParam('levelnfc', Level.NumberType); WriteCtrlParam('levelstartat', Level.StartAt); WriteGroupBegin; try WriteCtrl('leveltext'); for K := 0 to Level.NumberingFormat.Count - 1 do begin NFItem := Level.NumberingFormat[K]; if (NFItem.Level >= 0) and (NFItem.Text = '') then WriteString(AnsiString(Format('\''%.2x', [NFItem.Level]))) else WriteUnicodeString(NFItem.Text) end; WriteSemiColon; finally WriteGroupEnd; end; WriteGroupBegin; try WriteCtrl('levelnumbers'); Len := 1; for K := 1 to Level.NumberingFormat.Count - 1 do begin NFItem := Level.NumberingFormat[K]; if (NFItem.Level >= 0) and (NFItem.Text = '') then begin WriteString(AnsiString(Format('\''%.2x', [Len]))); Inc(Len); end else Inc(Len, StringLength(NFItem.Text)); end; WriteSemiColon; finally WriteGroupEnd; end; if Level.FontIndex >= 0 then WriteCtrlParam('f', Level.FontIndex); WriteCtrlParam('fi', PixelsToTwipsX(Level.FirstIndent)); WriteCtrlParam('li', PixelsToTwipsX(Level.LeftIndent)); finally WriteGroupEnd; end; end; WriteCtrlParam('listid', Item.ID); finally WriteGroupEnd; end; end; finally WriteGroupEnd; end; // next write list override table WriteGroupBegin; try WriteUnknownGroup; WriteCtrl('listoverridetable'); for I := 0 to FListTable.Overrides.Count - 1 do begin OverrideItem := FListTable.Overrides[I]; WriteGroupBegin; try WriteCtrl('listoverride'); WriteCtrlParam('listid', OverrideItem.Value); WriteCtrlParam('ls', OverrideItem.Index); finally WriteGroupEnd; end; end; finally WriteGroupEnd; end; end; procedure TKMemoRTFWriter.WriteListText(ANumberBlock: TKMemoTextBlock); begin if ANumberBlock <> nil then begin WriteGroupBegin; try WriteCtrl('listtext'); WriteTextBlock(ANumberBlock, False); finally WriteGroupEnd; end; end; end; procedure TKMemoRTFWriter.WriteParagraph(ABlock: TKMemoParagraph; AInsideTable: Boolean); begin WriteGroupBegin; try WriteParaStyle(ABlock.ParaStyle); WriteTextStyle(ABlock.TextStyle); if AinsideTable then WriteCtrl('intbl'); WriteCtrl('par'); finally WriteGroupEnd; end; end; procedure TKMemoRTFWriter.WriteParaStyle(AParaStyle: TKMemoParaStyle); begin WriteCtrl('pard'); // always store complete paragraph properties if AParaStyle.FirstIndent <> 0 then WriteCtrlParam('fi', PixelsToTwipsX(AParaStyle.FirstIndent)); if AParaStyle.LeftPadding <> 0 then WriteCtrlParam('li', PixelsToTwipsX(AParaStyle.LeftPadding)); if AParaStyle.RightPadding <> 0 then WriteCtrlParam('ri', PixelsToTwipsX(AParaStyle.RightPadding)); if AParaStyle.TopPadding <> 0 then WriteCtrlParam('sb', PixelsToTwipsY(AParaStyle.TopPadding)); if AParaStyle.BottomPadding <> 0 then WriteCtrlParam('sa', PixelsToTwipsY(AParaStyle.BottomPadding)); case AParaStyle.HAlign of halLeft: WriteCtrl('ql'); halCenter: WriteCtrl('qc'); halRight: WriteCtrl('qr'); halJustify: WriteCtrl('qj'); end; if AParaStyle.Brush.Style <> bsClear then WriteCtrlParam('cbpat', FColorTable.GetIndex(AParaStyle.Brush.Color)); if not AParaStyle.WordWrap then WriteCtrl('nowwrap'); if AParaStyle.BorderWidths.NonZero then begin if AParaStyle.BorderWidths.Bottom > 0 then begin WriteCtrl('brdrb'); WriteCtrlParam('brdrw', PixelsToTwipsY(AParaStyle.BorderWidths.Bottom)) end; if AParaStyle.BorderWidths.Left > 0 then begin WriteCtrl('brdrl'); WriteCtrlParam('brdrw', PixelsToTwipsX(AParaStyle.BorderWidths.Left)) end; if AParaStyle.BorderWidths.Right > 0 then begin WriteCtrl('brdrr'); WriteCtrlParam('brdrw', PixelsToTwipsX(AParaStyle.BorderWidths.Right)) end; if AParaStyle.BorderWidths.Top > 0 then begin WriteCtrl('brdrt'); WriteCtrlParam('brdrw', PixelsToTwipsY(AParaStyle.BorderWidths.Top)) end; end else begin if AParaStyle.BorderWidth > 0 then begin WriteCtrl('box'); WriteCtrlParam('brdrw', PixelsToTwipsX(AParaStyle.BorderWidth)) end; if AParaStyle.BorderRadius > 0 then WriteCtrlParam('brdrradius', PixelsToTwipsX(AParaStyle.BorderRadius)) end; if AParaStyle.BorderColor <> clNone then WriteCtrlParam('brdrcf', FColorTable.GetIndex(AParaStyle.BorderColor)); if AParaStyle.LineSpacingValue <> 0 then begin if AParaStyle.LineSpacingMode = lsmValue then begin WriteCtrlParam('sl', PixelsToTwipsY(AParaStyle.LineSpacingValue)); WriteCtrlParam('slmult', 0) end else begin WriteCtrlParam('sl', Round(AParaStyle.LineSpacingFactor * 240)); WriteCtrlParam('slmult', 1) end; end; if AParaStyle.NumberingList <> cInvalidListID then WriteCtrlParam('ls', FListTable.FindByID(AParaStyle.NumberingList)); if AParaStyle.NumberingListLevel >= 0 then WriteCtrlParam('ilvl', AParaStyle.NumberingListLevel); if AParaStyle.NumberStartAt > 0 then WriteCtrlParam('lsstartat', AParaStyle.NumberStartAt); end; procedure TKMemoRTFWriter.WritePicture(AImage: TGraphic); var MS: TMemoryStream; S, ImgData: AnsiString; begin if AImage <> nil then begin if AImage is TJPegImage then WriteCtrl('jpegblip') {$IFDEF USE_PNG_SUPPORT} else if AImage is TKPngImage then WriteCtrl('pngblip') {$ENDIF} {$IFDEF MSWINDOWS} else if AImage is TKMetafile then begin if TKMetafile(AImage).Enhanced then WriteCtrl('emfblip') else WriteCtrlParam('wmetafile', 8); end {$ENDIF} ; MS := TMemoryStream.Create; try AImage.SaveToStream(MS); MS.Seek(0, soFromBeginning); SetLength(S, MS.Size); MS.Read(S[1], MS.Size); finally MS.Free; end; WriteSpace; ImgData := BinaryToDigits(S); WriteString(ImgData); end; end; procedure TKMemoRTFWriter.WriteSemiColon; begin WriteString(';'); end; procedure TKMemoRTFWriter.WriteShape(AShape: TKMemoRTFShape; AInsideTable: Boolean); begin WriteGroupBegin; try WriteCtrl('shp'); WriteGroupBegin; try WriteUnknownGroup; WriteCtrl('shpinst'); WriteCtrlParam('shpbottom', PixelsToTwipsY(Ashape.ContentPosition.Bottom)); WriteCtrlParam('shpleft', PixelsToTwipsX(Ashape.ContentPosition.Left)); WriteCtrlParam('shpright', PixelsToTwipsX(Ashape.ContentPosition.Right)); WriteCtrlParam('shptop', PixelsToTwipsY(Ashape.ContentPosition.Top)); case AShape.HorzPosCode of 1: WriteCtrl('shpbxpage'); 2: WriteCtrl('shpbxcolumn'); else WriteCtrl('shpbxmargin'); end; case AShape.VertPosCode of 1: WriteCtrl('shpbypage'); 2: WriteCtrl('shpbypara'); else WriteCtrl('shpbymargin'); end; WriteCtrlParam('shpfhdr', 0); WriteCtrlParam('shpwr', AShape.Wrap); WriteCtrlParam('shpwrk', AShape.WrapSide); WriteShapeProperties(AShape); case AShape.ContentType of sctImage: if AShape.Block <> nil then begin WriteGroupBegin; try WriteCtrl('sp'); WriteShapePropName('pib'); WriteGroupBegin; try WriteCtrl('sv'); WriteSpace; WriteGroupBegin; try WriteCtrl('pict'); WriteImage(AShape.Block as TKMemoImageBlock); finally WriteGroupEnd; end; finally WriteGroupEnd; end; finally WriteGroupEnd; end; end; sctRectangle: if AShape.Style.FillBlip <> nil then begin WriteShapeProp('fillType', '3'); WriteGroupBegin; try WriteCtrl('sp'); WriteShapePropName('fillBlip'); WriteGroupBegin; try WriteCtrl('sv'); WriteSpace; WriteGroupBegin; try WriteCtrl('pict'); WritePicture(AShape.Style.FillBlip); finally WriteGroupEnd; end; finally WriteGroupEnd; end; finally WriteGroupEnd; end; end; sctTextbox: if AShape.Block <> nil then begin WriteGroupBegin; try WriteCtrl('shptxt'); WriteBody((AShape.Block as TKMemoContainer).Blocks, AInsideTable); finally WriteGroupEnd; end; end; end; finally WriteGroupEnd; end; finally WriteGroupEnd; end; end; procedure TKMemoRTFWriter.WriteShapeProp(const APropName, APropValue: AnsiString); begin WriteGroupBegin; try WriteCtrl('sp'); WriteShapePropName(APropName); WriteShapePropValue(APropValue); finally WriteGroupEnd; end; end; procedure TKMemoRTFWriter.WriteShapeProperties(AShape: TKMemoRTFShape); var B: Boolean; begin B := AShape.Style.Brush.Style <> bsClear; case AShape.ContentType of sctImage: WriteShapeProp('shapeType', '75'); sctRectangle: WriteShapeProp('shapeType', '1'); sctTextbox: WriteShapeProp('shapeType', '202'); end; if AShape.FitToShape then WriteShapeProp('fFitTextToShape', BoolToParam(True)); if AShape.FitToText then WriteShapeProp('fFitShapeToText', BoolToParam(True)); WriteShapeProp('fFilled', BoolToParam(B)); if B then WriteShapeProp('fillColor', ColorToParam(AShape.Style.Brush.Color)); B := AShape.Style.BorderWidth > 0; WriteShapeProp('fLine', BoolToParam(B)); if B then begin WriteShapeProp('lineColor', ColorToParam(AShape.Style.BorderColor)); WriteShapeProp('lineWidth', EMUToParam(AShape.Style.BorderWidth)); end; if AShape.Background then WriteShapeProp('fBackground', BoolToParam(True)); end; procedure TKMemoRTFWriter.WriteShapePropName(const APropName: AnsiString); begin WriteGroupBegin; try WriteCtrl('sn'); WriteSpace; WriteString(APropName); finally WriteGroupEnd; end; end; procedure TKMemoRTFWriter.WriteShapePropValue(const APropValue: AnsiString); begin WriteGroupBegin; try WriteCtrl('sv'); WriteSpace; WriteString(APropValue); finally WriteGroupEnd; end; end; procedure TKMemoRTFWriter.WriteSpace; begin WriteString(' '); end; procedure TKMemoRTFWriter.WriteString(const AText: AnsiString); begin FStream.Write(AText[1], Length(AText)); end; procedure TKMemoRTFWriter.WriteTable(ABlock: TKMemoTable); var I, J, SavedRow, SavedRowCount: Integer; Row: TKMemoTableRow; Cell: TKMemoTableCell; begin SavedRowCount := 0; for I := 0 to ABlock.RowCount - 1 do begin Row := ABlock.Rows[I]; if CanSave(Row) then Inc(SavedRowCount); end; SavedRow := 0; for I := 0 to ABlock.RowCount - 1 do begin Row := ABlock.Rows[I]; if CanSave(Row) then begin WriteCtrl('trowd'); WriteTableRowProperties(ABlock, I, SavedRow); for J := 0 to Row.CellCount - 1 do begin Cell := Row.Cells[J]; if Cell.ColSpan >= 0 then begin WriteParaStyle(Cell.ParaStyle); if (Cell.Blocks.Count > 0) and ((Cell.Blocks.Count > 1) or not(Cell.Blocks[0] is TKmemoParagraph)) then begin WriteGroupBegin; try WriteBody(Cell.Blocks, True); finally WriteGroupEnd; end; end; WriteCtrl('cell'); end; end; WriteGroupBegin; try WriteCtrl('trowd'); WriteTableRowProperties(ABlock, I, SavedRow); if SavedRow = SavedRowCount - 1 then WriteCtrl('lastrow'); WriteCtrl('row'); finally WriteGroupEnd; end; Inc(SavedRow); end; end; end; procedure TKMemoRTFWriter.WriteTableRowProperties(ATable: TKMemoTable; ARowIndex, ASavedRowIndex: Integer); procedure WriteBorderWidth(AWidth: Integer); begin if AWidth <> 0 then begin WriteCtrl('brdrs'); WriteCtrlParam('brdrw', PixelsToTwipsX(AWidth)) end else WriteCtrl('brdrnone'); end; var Cell: TKMemoTableCell; Row: TKMemoTableRow; I, W, XPos: Integer; RowPadd: TRect; begin WriteCtrlParam('irow', ASavedRowIndex); Xpos := 0; Row := ATable.Rows[ARowIndex]; RowPadd := CreateEmptyRect; for I := 0 to Row.CellCount - 1 do begin Cell := Row.Cells[I]; RowPadd.Bottom := Max(RowPadd.Bottom, Cell.BlockStyle.BottomPadding); RowPadd.Left := Max(RowPadd.Left, Cell.BlockStyle.LeftPadding); RowPadd.Right := Max(RowPadd.Right, Cell.BlockStyle.RightPadding); RowPadd.Top := Max(RowPadd.Top, Cell.BlockStyle.TopPadding); end; WriteCtrlParam('trpaddb', PixelsToTwipsY(RowPadd.Bottom)); WriteCtrlParam('trpaddl', PixelsToTwipsX(RowPadd.Left)); WriteCtrlParam('trpaddr', PixelsToTwipsX(RowPadd.Right)); WriteCtrlParam('trpaddt', PixelsToTwipsY(RowPadd.Top)); for I := 0 to Row.CellCount - 1 do begin Cell := Row.Cells[I]; if Cell.ColSpan >= 0 then begin if Cell.BlockStyle.BottomPadding <> RowPadd.Bottom then WriteCtrlParam('clpadb', PixelsToTwipsY(RowPadd.Bottom)); if Cell.BlockStyle.LeftPadding <> RowPadd.Left then WriteCtrlParam('clpadl', PixelsToTwipsX(RowPadd.Left)); if Cell.BlockStyle.RightPadding <> RowPadd.Right then WriteCtrlParam('clpadr', PixelsToTwipsX(RowPadd.Right)); if Cell.BlockStyle.TopPadding <> RowPadd.Top then WriteCtrlParam('clpadt', PixelsToTwipsY(RowPadd.Top)); if Cell.RowSpan > 1 then WriteCtrl('clvmgf') else if Cell.RowSpan <= 0 then WriteCtrl('clvmrg'); WriteCtrl('clbrdrb'); WriteBorderWidth(Cell.RequiredBorderWidths.Bottom); WriteCtrlParam('brdrcf', FColorTable.GetIndex(Cell.BlockStyle.BorderColor)); WriteCtrl('clbrdrl'); WriteBorderWidth(Cell.RequiredBorderWidths.Left); WriteCtrlParam('brdrcf', FColorTable.GetIndex(Cell.BlockStyle.BorderColor)); WriteCtrl('clbrdrr'); WriteBorderWidth(Cell.RequiredBorderWidths.Right); WriteCtrlParam('brdrcf', FColorTable.GetIndex(Cell.BlockStyle.BorderColor)); WriteCtrl('clbrdrt'); WriteBorderWidth(Cell.RequiredBorderWidths.Top); WriteCtrlParam('brdrcf', FColorTable.GetIndex(Cell.BlockStyle.BorderColor)); if Cell.BlockStyle.Brush.Style <> bsClear then WriteCtrlParam('clcbpat', FColorTable.GetIndex(Cell.BlockStyle.Brush.Color)); W := Max(ATable.CalcTotalCellWidth(I, ARowIndex), 5); WriteCtrlParam('clwWidth', PixelsToTwipsX(W)); Inc(Xpos, W); WriteCtrlParam('cellx', PixelsToTwipsX(XPos)); end; end; end; procedure TKMemoRTFWriter.WriteTextBlock(ABlock: TKMemoTextBlock; ASelectedOnly: Boolean); var S: TKString; begin WriteGroupBegin; try if ASelectedOnly then S := ABlock.SelText else S := ABlock.Text; WriteTextStyle(ABlock.TextStyle); WriteSpace; WriteUnicodeString(S); finally WriteGroupEnd; end; end; procedure TKMemoRTFWriter.WriteTextStyle(ATextStyle: TKMemoTextStyle); begin WriteCtrlParam('f', FFontTable.GetIndex(ATextStyle.Font)); if fsBold in ATextStyle.Font.Style then WriteCtrl('b'); if fsItalic in ATextStyle.Font.Style then WriteCtrl('i'); if fsUnderline in ATextStyle.Font.Style then WriteCtrl('ul'); if fsStrikeout in ATextStyle.Font.Style then WriteCtrl('strike'); case ATextStyle.Capitals of tcaNormal: WriteCtrl('caps'); tcaSmall: WriteCtrl('scaps'); end; WriteCtrlParam('fs', ATextStyle.Font.Size * 2); if ATextStyle.Font.Color <> clNone then WriteCtrlParam('cf', FColorTable.GetIndex(ATextStyle.Font.Color)); if ATextStyle.Brush.Style <> bsClear then WriteCtrlParam('highlight', FColorTable.GetIndex(ATextStyle.Brush.Color)); case ATextStyle.ScriptPosition of tpoSuperscript: WriteCtrl('super'); tpoSubscript: WriteCtrl('sub'); end; end; procedure TKMemoRTFWriter.WriteUnicodeString(const AText: TKString); var I: Integer; UnicodeValue: SmallInt; WasAnsi: Boolean; S, Ansi: AnsiString; C: TKChar; begin S := ''; for I := 1 to StringLength(AText) do begin {$IFDEF FPC} C := LazUTF8.UTF8Copy(AText, I, 1); if Length(C) = 1 then {$ELSE} C := AText[I]; if Ord(C) < $80 then {$ENDIF} begin if C = #9 then S := AnsiString(Format('%s\tab ', [S])) else if (C = '\') or (C = '{') or (C = '}') then S := AnsiString(Format('%s\%s', [S, TKString(C)])) else S := S + AnsiString(C) end else begin WasAnsi := False; if FCodePage <> 0 then begin // first try Ansi codepage conversion for better backward compatibility Ansi := StringToAnsiString(C, FCodePage); if (Length(Ansi) = 1) and (Ansi <> #0) then begin S := AnsiString(Format('%s\''%.2x', [S, Ord(Ansi[1])])); WasAnsi := True; end; end; if not WasAnsi then begin // next store as Unicode character UnicodeValue := Ord(NativeUTFToUnicode(C)); S := AnsiString(Format('%s\u%d\''3F', [S, UnicodeValue])); end; end; end; if S <> '' then WriteString(S); end; procedure TKMemoRTFWriter.WriteUnknownGroup; begin WriteCtrl('*'); end; end. tomboy-ng_0.39-1/kcontrols/source/kmemo.pas0000644000175000017500000163074214346341266020601 0ustar dbannondbannon{ @abstract(This file is part of the KControls component suite for Delphi and Lazarus.) @author(Tomas Krysl) Copyright (c) 2020 Tomas Krysl

License:
This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html. } unit kmemo; // lowercase name because of Lazarus/Linux {$include kcontrols.inc} {$WEAKPACKAGEUNIT ON} interface uses {$IFDEF FPC} LCLType, LCLIntf, LMessages, LCLProc, LResources, {$ELSE} Windows, Messages, {$ENDIF} SysUtils, Classes, Graphics, Controls, Contnrs, Types, ActnList, ExtCtrls, StdCtrls, Forms, KFunctions, KControls, KGraphics, KEditCommon; const { Minimum for the @link(TKCustomMemo.UndoLimit) property. } cUndoLimitMin = 100; { Maximum for the @link(TKCustomMemo.UndoLimit) property. } cUndoLimitMax = 10000; { Default value for the @link(TKCustomMemo.UndoLimit) property. } cUndoLimitDef = 1000; { Minimum for the @link(TKCustomMemo.ScrollPadding) property. } cScrollPaddingMin = 0; { Maximum for the @link(TKCustomMemo.ScrollPadding) property. } cScrollPaddingMax = 1000; { Default value for the @link(TKCustomMemo.ScrollPadding) property. } cScrollPaddingDef = 30; { Minimum for the @link(TKCustomMemo.ScrollSpeed) property. } cScrollSpeedMin = 50; { Maximum for the @link(TKCustomMemo.ScrollSpeed) property. } cScrollSpeedMax = 1000; { Default value for the @link(TKCustomMemo.ScrollSpeed) property. } cScrollSpeedDef = 100; { Default value for the @link(TKMemoColors.BkGnd) color property. } cBkGndDef = clWindow; { Default value for the @link(TKMemoColors.InactiveCaretBkGnd) color property. } cInactiveCaretBkGndDef = clBlack; { Default value for the @link(TKMemoColors.InactiveCaretSelBkGnd) color property. } cInactiveCaretSelBkGndDef = clBlack; { Default value for the @link(TKMemoColors.InactiveCaretSelText) color property. } cInactiveCaretSelTextDef = clYellow; { Default value for the @link(TKMemoColors.InactiveCaretText) color property. } cInactiveCaretTextDef = clYellow; { Default value for the @link(TKMemoColors.SelBkGnd) color property. } cSelBkGndDef = clGrayText; { Default value for the @link(TKMemoColors.SelBkGndFocused) color property. } cSelBkGndFocusedDef = clHighlight; { Default value for the @link(TKMemoColors.SelText) color property. } cSelTextDef = clHighlightText; { Default value for the @link(TKMemoColors.SelTextFocused) color property. } cSelTextFocusedDef = clHighlightText; { Index for the @link(TKMemoColors.BkGnd) color property. } ciBkGnd = TKColorIndex(0); { Index for the @link(TKMemoColors.InactiveCaretBkGnd) color property. } ciInactiveCaretBkGnd = TKColorIndex(1); { Index for the @link(TKMemoColors.InactiveCaretSelBkGnd) color property. } ciInactiveCaretSelBkGnd = TKColorIndex(2); { Index for the @link(TKMemoColors.InactiveCaretSelText) color property. } ciInactiveCaretSelText = TKColorIndex(3); { Index for the @link(TKMemoColors.InactiveCaretText) color property. } ciInactiveCaretText = TKColorIndex(4); { Index for the @link(TKMemoColors.SelBkGnd) color property. } ciSelBkGnd = TKColorIndex(5); { Index for the @link(TKMemoColors.SelBkGndFocused) color property. } ciSelBkGndFocused = TKColorIndex(6); { Index for the @link(TKMemoColors.SelText) color property. } ciSelText = TKColorIndex(7); { Index for the @link(TKMemoColors.SelTextFocused) color property. } ciSelTextFocused = TKColorIndex(8); { Maximum color array index. } ciMemoColorsMax = ciSelTextFocused; { Specifies invalid or unassigned numbering list identifier. } cInvalidListID = -1; { Default step for horizontal scrolling. } cHorzScrollStepDef = 4; { Default step for vertical scrolling. } cVertScrollStepDef = 10; { Threshold for starting a block dragging operation by mouse. } cMouseDragThreshold = 5; { Default value for the @link(TKMemo.Height) property. } cHeight = 200; { Default value for the @link(TKMemo.Width) property. } cWidth = 300; { Default value for the @link(TKMemo.MaxWordLength) property. } cMaxWordLengthDef = 50; { This is the character for paragraph visualisation. } cNewLineChar = #$B6; { This is the character for space visualisation. } cSpaceChar = #$B7; { This is the character for tab visualisation. } cTabChar = #$2192; { These are Bullet Characters. } cTriangleBullet = #$2023; cRoundBullet = #$2022; cArrowTwoBullet = #$21A6; // https://en.wikipedia.org/wiki/Arrows_(Unicode_block) cArrowOneBullet = #$21A3; // https://en.wikipedia.org/wiki/Arrows_(Unicode_block) cCircleBullet = #$2218; // https://en.wikipedia.org/wiki/Mathematical_Operators_(Unicode_block) { Default characters used to break the text words. } cDefaultWordBreaks = [cNULL, cSPACE, '/', '\', ';', ':', '(', ')', '[', ']', '.', ',', '?', '!']; { Format for clipboard operations. } cRichText = 'Rich Text Format'; { Default value for the @link(TKMemo.Options) property. } cKMemoOptionsDef = [eoGroupUndo, eoScrollWindow]; type TKCustomMemo = class; TKMemoLineIndex = type Integer; TKMemoTotalLineIndex = type Integer; TKMemoBlockIndex = type Integer; TKMemoSelectionIndex = type Integer; TKMemoWordIndex = type Integer; TKMemoLinePosition = ( eolInside, eolEnd ); TKMemoBlockPosition = ( { Block is placed in the text. } mbpText, { Block has a position relative to an anchor. } mbpRelative, { Block has absolute position in the document. } mbpAbsolute ); { Declares memo states - possible values for the @link(TKCustomHexEditor.States) property (protected). } TKMemoState = ( { Caret is created. } elCaretCreated, { Caret is visible. } elCaretVisible, { Caret is being updated. } elCaretUpdate, { Ignore following WM_CHAR message. } elIgnoreNextChar, { Buffer modified. } elModified, { Mouse captured. } elMouseCapture, { Mouse captured and dragging a block. } elMouseDrag, { Mouse captured and ready for dragging a block. } elMouseDragInit, { Overwrite mode active. } elOverwrite, { Content is being printed or previewed. } elPrinting, { Read only editor. } elReadOnly ); { Hex editor states can be arbitrary combined. } TKMemoStates = set of TKMemoState; TKMemoUpdateReason = ( { recalculate line info and extent. } muContent, { continue previous line info and extent calculation. } muContentAddOnly, { recalculate extent. } muExtent, { selection changed. } muSelection, { selection changed and scroll operation is required to reflect the change. } muSelectionScroll ); TKMemoUpdateReasons = set of TKMemoUpdateReason; TKMemoIndexObject = class(TKObject) private FIndex: Integer; public constructor Create; override; procedure Assign(ASource: TKObject); override; function EqualProperties(ASource: TKObject): Boolean; override; property Index: Integer read FIndex write FIndex; end; TKMemoIndexObjectList = class(TKObjectList) private function GetItem(Index: Integer): TKMemoIndexObject; procedure SetItem(Index: Integer; const Value: TKMemoIndexObject); public procedure AddItem(AValue: Integer); procedure SetSize(ACount: Integer); virtual; property Items[Index: Integer]: TKMemoIndexObject read GetItem write SetItem; default; end; TKMemoIndexObjectStack = class(TStack) public function Push(AObject: TKMemoIndexObject): TKMemoIndexObject; function Pop: TKMemoIndexObject; function Peek: TKMemoIndexObject; procedure PushValue(Value: Integer); function PopValue: Integer; end; TKMemoDictionaryItem = class(TKObject) private FIndex, FValue: Integer; public constructor Create; override; procedure Assign(ASource: TKObject); override; function EqualProperties(ASource: TKObject): Boolean; override; property Index: Integer read FIndex write FIndex; property Value: Integer read FValue write FValue; end; TKMemoDictionary = class(TKObjectList) private function GetItem(Index: Integer): TKMemoDictionaryItem; procedure SetItem(Index: Integer; const Value: TKMemoDictionaryItem); public procedure AddItem(AIndex, AValue: Integer); function FindItem(AIndex: Integer): TKMemoDictionaryItem; function GetValue(AIndex, ADefault: Integer): Integer; procedure SetValue(AIndex, AValue: Integer); property Items[Index: Integer]: TKMemoDictionaryItem read GetItem write SetItem; default; end; TKMemoParaNumbering = (pnuNone, pnuTriangleBullets, pnuBullets, pnuCircleBullets, pnuArrowOneBullets, pnuArrowTwoBullets, pnuArabic, pnuLetterLo, pnuLetterHi, pnuRomanLo, pnuRomanHi); // punBullets retained for compatibility with previous versions of KMemo TKMemoNumberingFormatItem = class(TKObject) private FLevel: Integer; FText: TKString; public constructor Create; override; procedure Assign(ASource: TKObject); override; property Level: Integer read FLevel write FLevel; property Text: TKString read FText write FText; end; TKMemoNumberingFormat = class(TKObjectList) private function GetItem(Index: Integer): TKMemoNumberingFormatItem; procedure SetItem(Index: Integer; const Value: TKMemoNumberingFormatItem); function GetLevelCount: Integer; public procedure AddItem(ALevel: Integer; const AText: TKString); procedure Defaults(ANumbering: TKMemoParaNumbering; ALevelIndex: Integer); procedure InsertItem(AAt, ALevel: Integer; const AText: TKString); property Items[Index: Integer]: TKMemoNumberingFormatItem read GetItem write SetItem; default; property LevelCount: Integer read GetLevelCount; end; TKMemoListLevels = class; TKMemoListLevel = class(TKObject) private FFirstIndent: Integer; FNumbering: TKMemoParaNumbering; FNumberingFont: TFont; FNumberingFormat: TKMemoNumberingFormat; FNumberStartAt: Integer; FLeftIndent: Integer; FLevelCounter: Integer; procedure SetNumbering(const Value: TKMemoParaNumbering); procedure SetNumberStartAt(const Value: Integer); procedure SetFirstIndent(const Value: Integer); procedure SetLeftPadding(const Value: Integer); protected FNumberingFontChanged: Boolean; procedure FontChanged(Sender: TObject); procedure Changed; virtual; public constructor Create; override; destructor Destroy; override; procedure Assign(ASource: TKObject); override; property LevelCounter: Integer read FLevelCounter write FLevelCounter; property FirstIndent: Integer read FFirstIndent write SetFirstIndent; property LeftIndent: Integer read FLeftIndent write SetLeftPadding; property Numbering: TKMemoParaNumbering read FNumbering write SetNumbering; property NumberingFont: TFont read FNumberingFont; property NumberingFontChanged: Boolean read FNumberingFontChanged; property NumberingFormat: TKMemoNumberingFormat read FNumberingFormat; property NumberStartAt: Integer read FNumberStartAt write SetNumberStartAt; end; TKMemoList = class; TKMemoListLevels = class(TKObjectList) private FParent: TKMemoList; function GetItem(Index: Integer): TKMemoListLevel; procedure SetItem(Index: Integer; const Value: TKMemoListLevel); public constructor Create; override; procedure Changed(ALevel: TKMemoListLevel); virtual; procedure ClearLevelCounters(AFromLevel: Integer); virtual; property Items[Index: Integer]: TKMemoListLevel read GetItem write SetItem; default; property Parent: TKMemoList read FParent write FParent; end; TKMemoListTable = class; TKMemoList = class(TKObject) private FID: Integer; FLevels: TKMemoListLevels; protected procedure ParentChanged; override; public constructor Create; override; destructor Destroy; override; procedure Assign(ASource: TKObject); override; procedure LevelChanged(ALevel: TKMemoListLevel); virtual; property ID: Integer read FID write FID; property Levels: TKMemoListLevels read FLevels; end; TKMemoListChangedEvent = procedure(AList: TKMemoList; ALevel: TKMemoListLevel) of object; TKMemoListTable = class(TKObjectList) private FOnChanged: TKMemoListChangedEvent; function GetItem(Index: Integer): TKMemoList; procedure SetItem(Index: Integer; const Value: TKMemoList); protected FCallUpdate: Boolean; procedure CallAfterUpdate; override; procedure CallBeforeUpdate; override; procedure DoChanged(AList: TKMemoList; ALevel: TKMemoListLevel); virtual; public constructor Create; override; procedure ClearLevelCounters; function FindByID(AListID: Integer): TKMemoList; procedure ListChanged(AList: TKMemoList; ALevel: TKMemoListLevel); virtual; function ListByNumbering(AListID, ALevelIndex: Integer; ANumbering: TKMemoParaNumbering): TKMemoList; virtual; function NextID: Integer; property Items[Index: Integer]: TKMemoList read GetItem write SetItem; default; property OnChanged: TKMemoListChangedEvent read FOnChanged write FOnChanged; end; TKMemoBackground = class(TKPersistent) private FImage: TPicture; FRepeatX: Boolean; FRepeatY: Boolean; FColor: TColor; FOnChanged: TNotifyEvent; procedure SetImage(const Value: TPicture); procedure SetRepeatX(const Value: Boolean); procedure SetRepeatY(const Value: Boolean); procedure SetColor(const Value: TColor); protected procedure ImageChanged(Sender: TObject); procedure Update; override; public constructor Create; override; destructor Destroy; override; procedure Assign(ASource: TPersistent); override; procedure Clear; property OnChanged: TNotifyEvent read FOnChanged write FOnChanged; published property Color: TColor read FColor write SetColor default clNone; property Image: TPicture read FImage write SetImage; property RepeatX: Boolean read FRepeatX write SetRepeatX default True; property RepeatY: Boolean read FRepeatY write SetRepeatY default True; end; TKMemoScriptCapitals = (tcaNone, tcaNormal, tcaSmall); TKMemoScriptPosition = (tpoNormal, tpoSuperscript, tpoSubscript); { TKMemoTextStyle } TKMemoTextStyle = class(TKPersistent) private FAllowBrush: Boolean; FBrush: TBrush; FCapitals: TKMemoScriptCapitals; FChangeable: Boolean; FFont: TFont; FScriptPosition: TKMemoScriptPosition; FStyleChanged: Boolean; FOnChanged: TNotifyEvent; procedure SetAllowBrush(const Value: Boolean); procedure SetBrush(const Value: TBrush); procedure SetCapitals(const Value: TKMemoScriptCapitals); procedure SetFont(const Value: TFont); procedure SetScriptPosition(const Value: TKMemoScriptPosition); protected FBrushChanged: Boolean; FFontChanged: Boolean; procedure BrushChanged(Sender: TObject); procedure FontChanged(Sender: TObject); procedure PropsChanged; virtual; procedure Update; override; public constructor Create; override; destructor Destroy; override; procedure Assign(ASource: TPersistent); override; procedure Defaults; virtual; function EqualProperties(ASource: TKMemoTextStyle): Boolean; virtual; procedure NotifyChange(AValue: TKMemoTextStyle); virtual; property AllowBrush: Boolean read FAllowBrush write SetAllowBrush; property Capitals: TKMemoScriptCapitals read FCapitals write SetCapitals; property Changeable: Boolean read FChangeable write FChangeable; property Brush: TBrush read FBrush write SetBrush; property Font: TFont read FFont write SetFont; property ScriptPosition: TKMemoScriptPosition read FScriptPosition write SetScriptPosition; property StyleChanged: Boolean read FStyleChanged write FStyleChanged; property OnChanged: TNotifyEvent read FOnChanged write FOnChanged; end; TKMemoBlockWrapMode = ( { Text wraps around block bounding rectangle on both sides. } wrAround, { Text wraps around block bounding rectangle only on left side. } wrAroundLeft, { Text wraps around block bounding rectangle only on right side. } wrAroundRight, { Text wraps tightly around block. } wrTight, { Text wraps tightly around block only on left side. } wrTightLeft, { Text wraps tightly around block only on right side. } wrTightRight, { Text does not wrap around block on left or right side. } wrTopBottom, { Text wraps as block was not present. } wrNone, { Text wrap not specified. } wrUnknown ); TKMemoBlockStyleChangedEvent = procedure(Sender: TObject; AReasons: TKMemoUpdateReasons) of object; { TKMemoBlockStyle } TKMemoBlockStyle = class(TKPersistent) private FBrush: TBrush; FBorderRadius: Integer; FBorderColor: TColor; FBorderWidth: Integer; FBorderWidths: TKRect; FChangeable: Boolean; FStyleChanged: Boolean; FContentMargin: TKRect; FContentPadding: TKRect; FFillBlip: TGraphic; FHAlign: TKHAlign; FWrapMode: TKMemoBlockWrapMode; FOnChanged: TKMemoBlockStyleChangedEvent; function GetBottomPadding: Integer; function GetLeftPadding: Integer; function GetRightPadding: Integer; function GetTopPadding: Integer; procedure SetBottomPadding(const Value: Integer); procedure SetBorderColor(const Value: TColor); procedure SetBorderRadius(const Value: Integer); procedure SetBorderWidth(const Value: Integer); procedure SetBorderWidths(const Value: TKRect); procedure SetBrush(const Value: TBrush); procedure SetContentPadding(const Value: TKRect); procedure SetFillBlip(const Value: TGraphic); procedure SetHAlign(const Value: TKHAlign); procedure SetLeftPadding(const Value: Integer); procedure SetRightPadding(const Value: Integer); procedure SetTopPadding(const Value: Integer); procedure SetWrapMode(const Value: TKMemoBlockWrapMode); procedure SetContentMargin(const Value: TKRect); function GetBottomMargin: Integer; function GetLeftMargin: Integer; function GetRightMargin: Integer; function GetTopMargin: Integer; procedure SetBottomMargin(const Value: Integer); procedure SetLeftMargin(const Value: Integer); procedure SetRightMargin(const Value: Integer); procedure SetTopMargin(const Value: Integer); function GetBottomBorderWidth: Integer; function GetLeftBorderWidth: Integer; function GetRightBorderWidth: Integer; function GetTopBorderWidth: Integer; function GetAllPaddingsBottom: Integer; function GetAllPaddingsLeft: Integer; function GetAllPaddingsRight: Integer; function GetAllPaddingsTop: Integer; protected FUpdateReasons: TKMemoUpdateReasons; procedure BrushChanged(Sender: TObject); procedure PropsChanged(AReasons: TKMemoUpdateReasons); virtual; procedure Update; override; public constructor Create; override; destructor Destroy; override; procedure Assign(ASource: TPersistent); override; function BorderRect(const ARect: TRect): TRect; virtual; function InteriorRect(const ARect: TRect): TRect; virtual; procedure Defaults; virtual; function MarginRect(const ARect: TRect): TRect; virtual; procedure NotifyChange(AValue: TKMemoBlockStyle); virtual; procedure PaintBox(ACanvas: TCanvas; const ARect: TRect); virtual; property AllPaddingsBottom: Integer read GetAllPaddingsBottom; property AllPaddingsLeft: Integer read GetAllPaddingsLeft; property AllPaddingsRight: Integer read GetAllPaddingsRight; property AllPaddingsTop: Integer read GetAllPaddingsTop; property BottomBorderWidth: Integer read GetBottomBorderWidth; property BottomMargin: Integer read GetBottomMargin write SetBottomMargin; property BottomPadding: Integer read GetBottomPadding write SetBottomPadding; property BorderRadius: Integer read FBorderRadius write SetBorderRadius; property BorderColor: TColor read FBorderColor write SetBorderColor; property BorderWidth: Integer read FBorderWidth write SetBorderWidth; property BorderWidths: TKRect read FBorderWidths write SetBorderWidths; property Brush: TBrush read FBrush write SetBrush; property Changeable: Boolean read FChangeable write FChangeable; property ContentMargin: TKRect read FContentMargin write SetContentMargin; property ContentPadding: TKRect read FContentPadding write SetContentPadding; property FillBlip: TGraphic read FFillBlip write SetFillBlip; property HAlign: TKHAlign read FHAlign write SetHAlign; property LeftBorderWidth: Integer read GetLeftBorderWidth; property LeftMargin: Integer read GetLeftMargin write SetLeftMargin; property LeftPadding: Integer read GetLeftPadding write SetLeftPadding; property RightBorderWidth: Integer read GetRightBorderWidth; property RightMargin: Integer read GetRightMargin write SetRightMargin; property RightPadding: Integer read GetRightPadding write SetRightPadding; property StyleChanged: Boolean read FStyleChanged write FStyleChanged; property TopBorderWidth: Integer read GetTopBorderWidth; property TopMargin: Integer read GetTopMargin write SetTopMargin; property TopPadding: Integer read GetTopPadding write SetTopPadding; property WrapMode: TKMemoBlockWrapMode read FWrapMode write SetWrapMode; property OnChanged: TKMemoBlockStyleChangedEvent read FOnChanged write FOnChanged; end; TKMemoLineSpacingMode = (lsmFactor, lsmValue); TKMemoParaStyle = class(TKMemoBlockStyle) private FFirstIndent: Integer; FLineSpacingFactor: Double; FLineSpacingMode: TKMemoLineSpacingMode; FLineSpacingValue: Integer; FNumberingList: Integer; FNumberingListLevel: Integer; FNumberStartAt: Integer; FWordWrap: Boolean; procedure SetFirstIndent(const Value: Integer); procedure SetLineSpacingFactor(const Value: Double); procedure SetLineSpacingMode(const Value: TKMemoLineSpacingMode); procedure SetLineSpacingValue(const Value: Integer); procedure SetNumberingList(const Value: Integer); procedure SetNumberingListLevel(const Value: Integer); procedure SetNumberStartAt(const Value: Integer); procedure SetWordWrap(const Value: Boolean); public procedure Assign(ASource: TPersistent); override; procedure Defaults; override; procedure SetNumberingListAndLevel(AListID, ALevelIndex: Integer); virtual; property FirstIndent: Integer read FFirstIndent write SetFirstIndent; property LineSpacingFactor: Double read FLineSpacingFactor write SetLineSpacingFactor; property LineSpacingMode: TKMemoLineSpacingMode read FLineSpacingMode write SetLineSpacingMode; property LineSpacingValue: Integer read FLineSpacingValue write SetLineSpacingValue; property NumberingList: Integer read FNumberingList write SetNumberingList; property NumberingListLevel: Integer read FNumberingListLevel write SetNumberingListLevel; property NumberStartAt: Integer read FNumberStartAt write SetNumberStartAt; property WordWrap: Boolean read FWordWrap write SetWordWrap; end; { This class represents one line in the memo. } TKMemoLine = class(TObject) private FEndBlock: TKMemoBlockIndex; FEndIndex: TKMemoSelectionIndex; FEndWord: TKMemoWordIndex; FExtent: TPoint; FPosition: TPoint; FStartBlock: TKMemoBlockIndex; FStartIndex: TKMemoSelectionIndex; FStartWord: TKMemoWordIndex; function GetLineRect: TRect; public constructor Create; property EndBlock: TKMemoBlockIndex read FEndBlock write FEndBlock; property EndIndex: TKMemoSelectionIndex read FEndIndex write FEndIndex; property EndWord: TKMemoWordIndex read FEndWord write FEndWord; property Extent: TPoint read FExtent write FExtent; property LineRect: TRect read GetLineRect; property Position: TPoint read FPosition write FPosition; property StartBlock: TKMemoBlockIndex read FStartBlock write FStartBlock; property StartIndex: TKMemoSelectionIndex read FStartIndex write FStartIndex; property StartWord: TKMemoWordIndex read FStartWord write FStartWord; end; TKMemoLines = class(TObjectList) private function GetItem(Index: TKMemoLineIndex): TKMemoLine; procedure SetItem(Index: TKMemoLineIndex; const Value: TKMemoLine); public property Items[Index: TKMemoLineIndex]: TKMemoLine read GetItem write SetItem; default; end; { This class represents one single word or part of a word (sometimes even a single letter). } TKMemoWord = class(TObject) private FBaseLine: Integer; FBottomPadding: Integer; FClipped: Boolean; FExtent: TPoint; FEndIndex: TKMemoSelectionIndex; FPosition: TPoint; FStartIndex: TKMemoSelectionIndex; FTopPadding: Integer; public constructor Create; procedure Clear; property BaseLine: Integer read FBaseLine write FBaseLine; property BottomPadding: Integer read FBottomPadding write FBottomPadding; property Clipped: Boolean read FClipped write FClipped; property EndIndex: TKMemoSelectionIndex read FEndIndex write FEndIndex; property Extent: TPoint read FExtent write FExtent; property Position: TPoint read FPosition write FPosition; property StartIndex: TKMemoSelectionIndex read FStartIndex write FStartIndex; property TopPadding: Integer read FTopPadding write FTopPadding; end; TKMemoWordList = class(TObjectList) private function GetItem(Index: TKMemoWordIndex): TKMemoWord; procedure SetItem(Index: TKMemoWordIndex; const Value: TKMemoWord); public property Items[Index: TKMemoWordIndex]: TKMemoWord read GetItem write SetItem; default; end; TKMemoBlock = class; TKMemoBlocks = class; IKMemoNotifier = interface(IInterface) function BlockClick(ABlock: TKMemoBlock): Boolean; function BlockDblClick(ABlock: TKMemoBlock): Boolean; procedure BlockFreeNotification(ABlock: TKMemoBlock); procedure BlocksFreeNotification(ABlocks: TKMemoBlocks); function EditBlock(ABlock: TKMemoBlock): Boolean; function GetActiveBlocks: TKMemoBlocks; function GetDefaultTextStyle: TKMemoTextStyle; function GetDefaultParaStyle: TKMemoParaStyle; function GetDrawSingleChars: Boolean; function GetLinePosition: TKMemoLinePosition; function GetListTable: TKMemoListTable; function GetMemo: TKCustomMemo; function GetMaxWordLength: TKMemoSelectionIndex; function GetPaintSelection: Boolean; function GetPixelsPerInchX: Integer; function GetPixelsPerInchY: Integer; function GetPrinting: Boolean; function GetReadOnly: Boolean; procedure GetSelColors(out Foreground, Background: TColor); function GetSelectedBlock: TKMemoBlock; function GetShowFormatting: Boolean; function GetWordBreaks: TKSysCharSet; function GetWrapSingleChars: Boolean; function HasFocus: Boolean; function SelectBlock(ABlock: TKMemoBlock; APosition: TKSizingGripPosition): Boolean; procedure SetReqMouseCursor(ACursor: TCursor); end; TKMemoMouseAction = (maMove, maLeftDown, maLeftUp, maRightDown, maRightUp, maMidDown, maMidUp); TKMemoDoubleClickState = (mdblNone, mdblClicked, mdblClickedAndHandled); TKMemoBlockClass = class of TKMemoBlock; TKMemoBlock = class(TKObject) private FClickOnMouseUp: Boolean; FOffset: TPoint; FPosition: TKMemoBlockPosition; FOnClick: TNotifyEvent; FOnDblClick: TNotifyEvent; function GetBoundsRect: TRect; function GetMemoNotifier: IKMemoNotifier; function GetPaintSelection: Boolean; function GetParentBlocks: TKMemoBlocks; function GetPrinting: Boolean; function GetReadOnly: Boolean; procedure SetPosition(const Value: TKMemoBlockPosition); protected FDoubleClickState: TKMemoDoubleClickState; FMouseCaptureWord: TKMemoWordIndex; function Click: Boolean; virtual; function DblClick: Boolean; virtual; procedure CallAfterUpdate; override; procedure CallBeforeUpdate; override; procedure SizingGripsDraw(ACanvas: TCanvas; const ARect: TRect); virtual; function SizingGripsCursor(const ARect: TRect; const APoint: TPoint): TCursor; virtual; function SizingGripsPosition(const ARect: TRect; const APoint: TPoint): TKSizingGripPosition; virtual; function ContentLength: TKMemoSelectionIndex; virtual; function GetBottomPadding: Integer; virtual; function GetCanAddText: Boolean; virtual; function GetWrapMode: TKMemoBlockWrapMode; virtual; function GetDefaultTextStyle: TKMemoTextStyle; virtual; function GetDefaultParaStyle: TKMemoParaStyle; virtual; function GetHeight: Integer; virtual; function GetLeft: Integer; virtual; function GetParaStyle: TKMemoParaStyle; virtual; function GetParentRootBlocks: TKMemoBlocks; virtual; function GetResizable: Boolean; virtual; procedure GetSelColors(out Foreground, Background: TColor); virtual; function GetSelEnd: TKMemoSelectionIndex; virtual; function GetSelLength: TKMemoSelectionIndex; virtual; function GetSelStart: TKMemoSelectionIndex; virtual; function GetSelText: TKString; virtual; function GetShowFormatting: Boolean; virtual; function GetSizingRect: TRect; virtual; function GetText: TKString; virtual; function GetTop: Integer; virtual; function GetTopPadding: Integer; virtual; function GetWidth: Integer; virtual; function GetWordBaseLine(Index: TKMemoWordIndex): Integer; virtual; function GetWordBottomPadding(Index: TKMemoWordIndex): Integer; virtual; function GetWordBoundsRect(Index: TKMemoWordIndex): TRect; virtual; function GetWordBreakable(Index: TKMemoWordIndex): Boolean; virtual; function GetWordClipped(Index: TKMemoWordIndex): Boolean; virtual; function GetWordCount: Integer; virtual; function GetWordHeight(Index: TKMemoWordIndex): Integer; virtual; function GetWordLeft(Index: TKMemoWordIndex): Integer; virtual; function GetWordLength(Index: TKMemoWordIndex): TKMemoSelectionIndex; virtual; function GetWordLengthWOWS(Index: TKMemoWordIndex): TKMemoSelectionIndex; virtual; function GetWordRect(Index: TKMemoWordIndex): TRect; virtual; function GetWords(Index: TKMemoWordIndex): TKString; virtual; function GetWordTop(Index: TKMemoWordIndex): Integer; virtual; function GetWordTopPadding(Index: TKMemoWordIndex): Integer; virtual; function GetWordWidth(Index: TKMemoWordIndex): Integer; virtual; function PixelsPerInchX: Integer; virtual; function PixelsPerInchY: Integer; virtual; procedure SetResizable(const Value: Boolean); virtual; procedure SetLeftOffset(const Value: Integer); virtual; procedure SetTopOffset(const Value: Integer); virtual; procedure SetWordBaseLine(Index: TKMemoWordIndex; const Value: Integer); virtual; procedure SetWordBottomPadding(Index: TKMemoWordIndex; const Value: Integer); virtual; procedure SetWordClipped(Index: TKMemoWordIndex; const Value: Boolean); virtual; procedure SetWordHeight(Index: TKMemoWordIndex; const Value: Integer); virtual; procedure SetWordLeft(Index: TKMemoWordIndex; const Value: Integer); virtual; procedure SetWordTop(Index: TKMemoWordIndex; const Value: Integer); virtual; procedure SetWordTopPadding(Index: TKMemoWordIndex; const Value: Integer); virtual; procedure SetWordWidth(Index: TKMemoWordIndex; const Value: Integer); virtual; procedure Update(AReasons: TKMemoUpdateReasons); virtual; public constructor Create; override; destructor Destroy; override; function ActiveBlocks: TKMemoBlocks; virtual; procedure Assign(ASource: TKObject); override; procedure AssignAttributes(ABlock: TKMemoBlock); virtual; function CalcAscent(ACanvas: TCanvas): Integer; virtual; function CanAdd(ABlock: TKMemoBlock): Boolean; virtual; procedure ClearSelection(ATextOnly: Boolean); virtual; function Concat(ABlock: TKMemoBlock): Boolean; virtual; function EqualProperties(ASource: TKObject): Boolean; override; procedure GetWordIndexes(AIndex: TKMemoSelectionIndex; out ASt, AEn: TKMemoSelectionIndex); virtual; function IndexToRect(ACanvas: TCanvas; AIndex: TKMemoSelectionIndex; ACaret: Boolean): TRect; virtual; function InsertParagraph(AIndex: TKMemoSelectionIndex): Boolean; virtual; function InsertString(const AText: TKString; At: TKMemoSelectionIndex = -1): Boolean; virtual; function MeasureExtent(ACanvas: TCanvas; ARequiredWidth: Integer): TPoint; virtual; procedure NotifyDefaultTextChange; virtual; procedure NotifyDefaultParaChange; virtual; procedure NotifyOptionsChange; virtual; procedure NotifyPrintBegin; virtual; procedure NotifyPrintEnd; virtual; procedure PaintToCanvas(ACanvas: TCanvas; ALeft, ATop: Integer); virtual; function PointToIndex(ACanvas: TCanvas; const APoint: TPoint; AOutOfArea, ASelectionExpanding: Boolean; out APosition: TKMemoLinePosition): TKMemoSelectionIndex; virtual; function RealLeftOffset: Integer; function RealTopOffset: Integer; procedure Resize(ANewWidth, ANewHeight: Integer); virtual; procedure RestoreUpdateState(AValue: TKMemoUpdateReasons); virtual; function SaveUpdateState: TKMemoUpdateReasons; virtual; procedure SelectAll; virtual; function Select(ASelStart, ASelLength: TKMemoSelectionIndex; ADoScroll: Boolean): Boolean; virtual; function SelectableLength(ALocalCalc: Boolean = False): TKMemoSelectionIndex; virtual; function SelectedBlock: TKMemoBlock; virtual; function Split(At: TKMemoSelectionIndex; AllowEmpty: Boolean = False): TKMemoBlock; virtual; function WordIndexToRect(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; AIndex: TKMemoSelectionIndex; ACaret: Boolean): TRect; virtual; function WordMeasureExtent(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; ARequiredWidth: Integer): TPoint; virtual; function WordMouseAction(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; AAction: TKMemoMouseAction; const APoint: TPoint; AShift: TShiftState): Boolean; virtual; procedure WordPaintToCanvas(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; ALeft, ATop: Integer); virtual; function WordPointToIndex(ACanvas: TCanvas; const APoint: TPoint; AWordIndex: TKMemoWordIndex; AOutOfArea, ASelectionExpanding: Boolean; out APosition: TKMemoLinePosition): TKMemoSelectionIndex; virtual; property BoundsRect: TRect read GetBoundsRect; property BottomPadding: Integer read GetBottomPadding; property CanAddText: Boolean read GetCanAddText; property ClickOnMouseUp: Boolean read FClickOnMouseUp write FClickOnMouseUp; property DefaultTextStyle: TKMemoTextStyle read GetDefaultTextStyle; property DefaultParaStyle: TKMemoParaStyle read GetDefaultParaStyle; property Height: Integer read GetHeight; property Left: Integer read GetLeft; property LeftOffset: Integer read FOffset.X write SetLeftOffset; property MemoNotifier: IKMemoNotifier read GetMemoNotifier; property PaintSelection: Boolean read GetPaintSelection; property ParaStyle: TKMemoParaStyle read GetParaStyle; property ParentBlocks: TKMemoBlocks read GetParentBlocks; property ParentRootBlocks: TKMemoBlocks read GetParentRootBlocks; property Position: TKMemoBlockPosition read FPosition write SetPosition; property Printing: Boolean read GetPrinting; property ReadOnly: Boolean read GetReadOnly; property Resizable: Boolean read GetResizable write SetResizable; property SelEnd: TKMemoSelectionIndex read GetSelEnd; property SelLength: TKMemoSelectionIndex read GetSelLength; property SelStart: TKMemoSelectionIndex read GetSelStart; property SelText: TKString read GetSelText; property ShowFormatting: Boolean read GetShowFormatting; property SizingRect: TRect read GetSizingRect; property Text: TKString read GetText; property Top: Integer read GetTop; property TopOffset: Integer read FOffset.Y write SetTopOffset; property TopPadding: Integer read GetTopPadding; property Width: Integer read GetWidth; property WordCount: Integer read GetWordCount; property WordBaseLine[Index: TKMemoWordIndex]: Integer read GetWordBaseLine write SetWordBaseLine; property WordBreakable[Index: TKMemoWordIndex]: Boolean read GetWordBreakable; property WordBottomPadding[Index: TKMemoWordIndex]: Integer read GetWordBottomPadding write SetWordBottomPadding; property WordBoundsRect[Index: TKMemoWordIndex]: TRect read GetWordBoundsRect; property WordClipped[Index: TKMemoWordIndex]: Boolean read GetWordClipped write SetWordClipped; property WordHeight[Index: TKMemoWordIndex]: Integer read GetWordHeight write SetWordHeight; property WordLeft[Index: TKMemoWordIndex]: Integer read GetWordLeft write SetWordLeft; property WordLength[Index: TKMemoWordIndex]: TKMemoSelectionIndex read GetWordLength; property WordLengthWOWS[Index: TKMemoWordIndex]: TKMemoSelectionIndex read GetWordLengthWOWS; property WordRect[Index: TKMemoWordIndex]: TRect read GetWordRect; property Words[Index: TKMemoWordIndex]: TKString read GetWords; property WordTop[Index: TKMemoWordIndex]: Integer read GetWordTop write SetWordTop; property WordTopPadding[Index: TKMemoWordIndex]: Integer read GetWordTopPadding write SetWordTopPadding; property WordWidth[Index: TKMemoWordIndex]: Integer read GetWordWidth write SetWordWidth; property WrapMode: TKMemoBlockWrapMode read GetWrapMode; property OnClick: TNotifyEvent read FOnClick write FOnClick; property OnDblClick: TNotifyEvent read FOnDblClick write FOnDblClick; end; TKMemoSingleton = class(TKMemoBlock) private FSelEnd: TKMemoSelectionIndex; FSelStart: TKMemoSelectionIndex; protected function GetSelLength: TKMemoSelectionIndex; override; function GetSelStart: TKMemoSelectionIndex; override; public constructor Create; override; function Select(ASelStart, ASelLength: TKMemoSelectionIndex; ADoScroll: Boolean): Boolean; override; end; TKMemoWordBreakStyle = (wbsLastWordChar, wbsFirstWordChar, wbsEveryWord, wbsEveryChar); TKMemoTextBlock = class(TKMemoSingleton) private FText: TKString; FTextStyle: TKMemoTextStyle; FWordBreakStyle: TKMemoWordBreakStyle; function GetWordBreaks: TKSysCharSet; procedure SetWordBreakStyle(const Value: TKMemoWordBreakStyle); protected FScriptVertOffset: Integer; FScriptFontHeight: Integer; FTextLength: Integer; FWordCount: Integer; FWords: TKMemoWordList; function ApplyFormatting(const AText: TKString): TKString; procedure ApplyTextStyle(ACanvas: TCanvas); virtual; function ContentLength: TKMemoSelectionIndex; override; function SingleCharWords: Boolean; virtual; function GetCanAddText: Boolean; override; function GetKerningDistance(ACanvas: TCanvas; const AChar1, AChar2: TKChar): Integer; function GetSelText: TKString; override; function GetText: TKString; override; function GetWordBaseLine(Index: TKMemoWordIndex): Integer; override; function GetWordBottomPadding(Index: TKMemoWordIndex): Integer; override; function GetWordBoundsRect(Index: TKMemoWordIndex): TRect; override; function GetWordBreakable(Index: TKMemoWordIndex): Boolean; override; function GetWordClipped(Index: TKMemoWordIndex): Boolean; override; function GetWordCount: Integer; override; function GetWordHeight(Index: TKMemoWordIndex): Integer; override; function GetWordLeft(Index: TKMemoWordIndex): Integer; override; function GetWordLength(Index: TKMemoWordIndex): TKMemoSelectionIndex; override; function GetWordLengthWOWS(Index: TKMemoWordIndex): TKMemoSelectionIndex; override; function GetWords(Index: TKMemoWordIndex): TKString; override; function GetWordTop(Index: TKMemoWordIndex): Integer; override; function GetWordTopPadding(Index: TKMemoWordIndex): Integer; override; function GetWordWidth(Index: TKMemoWordIndex): Integer; override; function IndexToTextIndex(const AText: TKString; AIndex: Integer): Integer; virtual; function InternalTextExtent(ACanvas: TCanvas; const AText: TKString): TSize; virtual; procedure InternalTextOutput(ACanvas: TCanvas; ALeft, ATop: Integer; const AText: TKString); virtual; function ModifiedTextExtent(ACanvas: TCanvas; const AText: TKString): TPoint; virtual; procedure ParentChanged; override; procedure SetText(const Value: TKString); virtual; procedure SetWordBaseLine(Index: TKMemoWordIndex; const Value: Integer); override; procedure SetWordBottomPadding(Index: TKMemoWordIndex; const Value: Integer); override; procedure SetWordClipped(Index: TKMemoWordIndex; const Value: Boolean); override; procedure SetWordHeight(Index: TKMemoWordIndex; const Value: Integer); override; procedure SetWordLeft(Index: TKMemoWordIndex; const Value: Integer); override; procedure SetWordTop(Index: TKMemoWordIndex; const Value: Integer); override; procedure SetWordTopPadding(Index: TKMemoWordIndex; const Value: Integer); override; procedure SetWordWidth(Index: TKMemoWordIndex; const Value: Integer); override; class procedure SplitText(const ASource: TKString; At: Integer; out APart1, APart2: TKString); function TextIndexToIndex(var AText: TKString; ATextIndex: Integer): Integer; virtual; procedure TextStyleChanged(Sender: TObject); procedure UpdateWords; virtual; public constructor Create; override; destructor Destroy; override; procedure Assign(ASource: TKObject); override; procedure AssignAttributes(ABlock: TKMemoBlock); override; function CalcAscent(ACanvas: TCanvas): Integer; override; function CalcDescent(ACanvas: TCanvas): Integer; virtual; procedure ClearSelection(ATextOnly: Boolean); override; function Concat(ABlock: TKMemoBlock): Boolean; override; function EqualProperties(ASource: TKObject): Boolean; override; procedure GetWordIndexes(AIndex: TKMemoSelectionIndex; out ASt, AEn: TKMemoSelectionIndex); override; function InsertString(const AText: TKString; At: TKMemoSelectionIndex = -1): Boolean; override; procedure NotifyDefaultTextChange; override; procedure NotifyOptionsChange; override; procedure NotifyPrintBegin; override; procedure NotifyPrintEnd; override; function Split(At: TKMemoSelectionIndex; AllowEmpty: Boolean = False): TKMemoBlock; override; function WordIndexToRect(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; AIndex: TKMemoSelectionIndex; ACaret: Boolean): TRect; override; function WordMeasureExtent(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; ARequiredWidth: Integer): TPoint; override; function WordMouseAction(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; AAction: TKMemoMouseAction; const APoint: TPoint; AShift: TShiftState): Boolean; override; procedure WordPaintToCanvas(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; ALeft, ATop: Integer); override; function WordPointToIndex(ACanvas: TCanvas; const APoint: TPoint; AWordIndex: TKMemoWordIndex; AOutOfArea, ASelectionExpanding: Boolean; out APosition: TKMemoLinePosition): TKMemoSelectionIndex; override; property Text: TKString read GetText write SetText; property TextStyle: TKMemoTextStyle read FTextStyle; property WordBreaks: TKSysCharSet read GetWordBreaks; property WordBreakStyle: TKMemoWordBreakStyle read FWordBreakStyle write SetWordBreakStyle; end; { TKMemoHyperlink } TKMemoHyperlink = class(TKMemoTextBlock) private FURL: TKString; protected function Click: Boolean; override; public constructor Create; override; procedure Assign(ASource: TKObject); override; procedure DefaultStyle; virtual; function WordMouseAction(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; AAction: TKMemoMouseAction; const APoint: TPoint; AShift: TShiftState): Boolean; override; property URL: TKString read FURL write FURL; end; TKMemoParagraph = class(TKMemoTextBlock) private FExtent: TPoint; FOrigin: TPoint; FParaStyle: TKMemoParaStyle; protected FNumberBlock: TKMemoTextBlock; function GetCanAddText: Boolean; override; function GetNumberBlock: TKMemoTextBlock; virtual; function GetNumbering: TKMemoParaNumbering; virtual; function GetNumberingList: TKMemoList; virtual; function GetNumberingListLevel: TKMemoListLevel; virtual; function GetParaStyle: TKMemoParaStyle; override; function GetWordBreakable(Index: TKMemoWordIndex): Boolean; override; procedure ParaStyleChanged(Sender: TObject; AReasons: TKMemoUpdateReasons); procedure SetNumbering(const Value: TKMemoParaNumbering); virtual; public constructor Create; override; destructor Destroy; override; procedure AssignAttributes(ABlock: TKMemoBlock); override; function Concat(ABlock: TKMemoBlock): Boolean; override; procedure NotifyDefaultParaChange; override; function Split(At: TKMemoSelectionIndex; AllowEmpty: Boolean = False): TKMemoBlock; override; procedure WordPaintToCanvas(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; ALeft, ATop: Integer); override; property Height: Integer read FExtent.Y write FExtent.Y; property Left: Integer read FOrigin.X write FOrigin.X; property Numbering: TKMemoParaNumbering read GetNumbering write SetNumbering; property NumberingList: TKMemoList read GetNumberingList; property NumberingListLevel: TKMemoListLevel read GetNumberingListLevel; property NumberBlock: TKMemoTextBlock read GetNumberBlock; property Top: Integer read FOrigin.Y write FOrigin.Y; property Width: Integer read FExtent.X write FExtent.X; end; TKMemoImageBlock = class(TKMemoSingleton) private FBaseLine: Integer; FCrop: TKRect; FCroppedImage: TKAlphaBitmap; FImageDPI: TPoint; FExtent: TPoint; // extent given by word processor FExplicitExtent: TPoint; // explicit extent FImage: TGraphic; FImageStyle: TKMemoBlockStyle; FOrigin: TPoint; FResizable: Boolean; FScale: TPoint; // scaled extent FWordBottomPadding: Integer; FWordTopPadding: Integer; function GetLogScaleX: Integer; function GetLogScaleY: Integer; procedure SetCrop(const Value: TKRect); procedure SetImage(const Value: TGraphic); procedure SetScaleHeight(const Value: Integer); procedure SetScaleWidth(const Value: Integer); procedure SetExplicitHeight(const Value: Integer); procedure SetExplicitWidth(const Value: Integer); procedure SetScaleX(const Value: Integer); procedure SetScaleY(const Value: Integer); procedure SetLogScaleX(const Value: Integer); procedure SetLogScaleY(const Value: Integer); protected FCalcBaseLine: Integer; FCreatingCroppedImage: Boolean; FMouseCapture: Boolean; FScaledRect: TRect; function ContentLength: TKMemoSelectionIndex; override; procedure CropChanged(Sender: TObject); function GetWrapMode: TKMemoBlockWrapMode; override; function GetImageHeight: Integer; virtual; function GetImageWidth: Integer; virtual; function GetNativeOrExplicitHeight: Integer; virtual; function GetNativeOrExplicitWidth: Integer; virtual; function GetResizable: Boolean; override; function GetScaleHeight: Integer; virtual; function GetScaleWidth: Integer; virtual; function GetSizingRect: TRect; override; function GetWordBottomPadding(Index: TKMemoWordIndex): Integer; override; function GetWordBoundsRect(Index: TKMemoWordIndex): TRect; override; function GetWordCount: Integer; override; function GetWordHeight(Index: TKMemoWordIndex): Integer; override; function GetWordLeft(Index: TKMemoWordIndex): Integer; override; function GetWordLength(Index: TKMemoWordIndex): TKMemoSelectionIndex; override; function GetWords(Index: TKMemoWordIndex): TKString; override; function GetWordTop(Index: TKMemoWordIndex): Integer; override; function GetWordTopPadding(Index: TKMemoWordIndex): Integer; override; function GetWordWidth(Index: TKMemoWordIndex): Integer; override; procedure ImageChanged(Sender: TObject); procedure ImageStyleChanged(Sender: TObject; AReasons: TKMemoUpdateReasons); function CroppedImage: TKAlphaBitmap; virtual; procedure SetResizable(const Value: Boolean); override; procedure SetWordBaseLine(Index: TKMemoWordIndex; const Value: Integer); override; procedure SetWordBottomPadding(Index: TKMemoWordIndex; const Value: Integer); override; procedure SetWordHeight(Index: TKMemoWordIndex; const Value: Integer); override; procedure SetWordLeft(Index: TKMemoWordIndex; const Value: Integer); override; procedure SetWordTop(Index: TKMemoWordIndex; const Value: Integer); override; procedure SetWordTopPadding(Index: TKMemoWordIndex; const Value: Integer); override; public constructor Create; override; destructor Destroy; override; procedure Assign(ASource: TKObject); override; procedure AssignAttributes(ABlock: TKMemoBlock); override; procedure AssignImage(ASource: TGraphic); virtual; function CalcAscent(ACanvas: TCanvas): Integer; override; function OuterRect(ACaret: Boolean): TRect; virtual; procedure LoadFromFile(const APath: string); virtual; procedure Resize(ANewWidth, ANewHeight: Integer); override; function WordIndexToRect(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; AIndex: TKMemoSelectionIndex; ACaret: Boolean): TRect; override; function WordMeasureExtent(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; ARequiredWidth: Integer): TPoint; override; function WordMouseAction(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; AAction: TKMemoMouseAction; const APoint: TPoint; AShift: TShiftState): Boolean; override; function WordPointToIndex(ACanvas: TCanvas; const APoint: TPoint; AWordIndex: TKMemoWordIndex; AOutOfArea, ASelectionExpanding: Boolean; out APosition: TKMemoLinePosition): TKMemoSelectionIndex; override; procedure WordPaintToCanvas(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; ALeft, ATop: Integer); override; property Crop: TKRect read FCrop write SetCrop; property Image: TGraphic read FImage write SetImage; property ImageDPIX: Integer read FImageDPI.X; property ImageDPIY: Integer read FImageDPI.Y; property ImageStyle: TKMemoBlockStyle read FImageStyle; property ImageHeight: Integer read GetImageHeight; property ImageWidth: Integer read GetImageWidth; property ExplicitHeight: Integer read FExplicitExtent.Y write SetExplicitHeight; property ExplicitWidth: Integer read FExplicitExtent.X write SetExplicitWidth; property NativeOrExplicitHeight: Integer read GetNativeOrExplicitHeight; property NativeOrExplicitWidth: Integer read GetNativeOrExplicitWidth; property LogScaleX: Integer read GetLogScaleX write SetLogScaleX; property LogScaleY: Integer read GetLogScaleY write SetLogScaleY; property ScaleHeight: Integer read GetScaleHeight write SetScaleHeight; property ScaleWidth: Integer read GetScaleWidth write SetScaleWidth; property ScaleX: Integer read FScale.X write SetScaleX; property ScaleY: Integer read FScale.Y write SetScaleY; end; { TKMemoContainer } TKMemoContainer = class(TKMemoBlock) private FBlocks: TKMemoBlocks; FBlockStyle: TKMemoBlockStyle; FClip: Boolean; FCurrentRequiredWidth: Integer; FCurrentRequiredHeight: Integer; FFixedHeight: Boolean; FFixedWidth: Boolean; FOrigin: TPoint; FRequiredHeight: Integer; FRequiredWidth: Integer; FResizable: Boolean; FWordBottomPadding: Integer; FWordTopPadding: Integer; procedure SetFixedHeight(const Value: Boolean); procedure SetFixedWidth(const Value: Boolean); procedure SetRequiredHeight(const Value: Integer); procedure SetRequiredWidth(const Value: Integer); procedure SetClip(const Value: Boolean); protected function AddRectOffset(const ARect: TRect): TRect; virtual; procedure AddSingleLine; virtual; procedure AddBlockLine(AStartBlock, AStartIndex, AEndBlock, AEndIndex, ALeft, ATop, AWidth, AHeight: Integer); virtual; procedure BlockStyleChanged(Sender: TObject; AReasons: TKMemoUpdateReasons); procedure ClearLines; virtual; function ContentLength: TKMemoSelectionIndex; override; procedure FixedHeightChanged; virtual; procedure FixedWidthChanged; virtual; function GetBottomPadding: Integer; override; function GetWrapMode: TKMemoBlockWrapMode; override; function GetCanAddText: Boolean; override; function GetResizable: Boolean; override; function GetSelLength: TKMemoSelectionIndex; override; function GetSelStart: TKMemoSelectionIndex; override; function GetSelText: TKString; override; function GetText: TKString; override; function GetTopPadding: Integer; override; function GetTotalLineCount: Integer; virtual; function GetTotalLineRect(Index: TKMemoTotalLineIndex): TRect; virtual; function GetWordBottomPadding(Index: TKMemoWordIndex): Integer; override; function GetWordBoundsRect(Index: TKMemoWordIndex): TRect; override; function GetWordCount: Integer; override; function GetWordHeight(Index: TKMemoWordIndex): Integer; override; function GetWordLeft(Index: TKMemoWordIndex): Integer; override; function GetWordLength(Index: TKMemoWordIndex): TKMemoSelectionIndex; override; function GetWords(Index: TKMemoWordIndex): TKString; override; function GetWordTop(Index: TKMemoWordIndex): Integer; override; function GetWordTopPadding(Index: TKMemoWordIndex): Integer; override; function GetWordWidth(Index: TKMemoWordIndex): Integer; override; procedure ParentChanged; override; procedure RequiredHeightChanged; virtual; procedure RequiredWidthChanged; virtual; procedure SetResizable(const Value: Boolean); override; procedure SetWordBottomPadding(Index: TKMemoWordIndex; const Value: Integer); override; procedure SetWordHeight(Index: TKMemoWordIndex; const Value: Integer); override; procedure SetWordLeft(Index: TKMemoWordIndex; const Value: Integer); override; procedure SetWordTop(Index: TKMemoWordIndex; const Value: Integer); override; procedure SetWordTopPadding(Index: TKMemoWordIndex; const Value: Integer); override; procedure SetWordWidth(Index: TKMemoWordIndex; const Value: Integer); override; public constructor Create; override; destructor Destroy; override; procedure Assign(ASource: TKObject); override; procedure AssignAttributes(ABlock: TKMemoBlock); override; function CalcAscent(ACanvas: TCanvas): Integer; override; function CanAdd(ABlock: TKMemoBlock): Boolean; override; procedure ClearSelection(ATextOnly: Boolean); override; function InsertParagraph(AIndex: TKMemoSelectionIndex): Boolean; override; function InsertString(const AText: TKString; At: TKMemoSelectionIndex = -1): Boolean; override; procedure NotifyDefaultParaChange; override; procedure NotifyDefaultTextChange; override; procedure NotifyPrintBegin; override; procedure NotifyPrintEnd; override; procedure Resize(ANewWidth, ANewHeight: Integer); override; function Select(ASelStart, ASelLength: TKMemoSelectionIndex; ADoScroll: Boolean): Boolean; override; procedure SetBlockExtent(AWidth, AHeight: Integer); virtual; procedure UpdateAttributes; virtual; function WordIndexToRect(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; AIndex: TKMemoSelectionIndex; ACaret: Boolean): TRect; override; function WordMeasureExtent(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; ARequiredWidth: Integer): TPoint; override; function WordMouseAction(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; AAction: TKMemoMouseAction; const APoint: TPoint; AShift: TShiftState): Boolean; override; function WordPointToIndex(ACanvas: TCanvas; const APoint: TPoint; AWordIndex: TKMemoWordIndex; AOutOfArea, ASelectionExpanding: Boolean; out APosition: TKMemoLinePosition): TKMemoSelectionIndex; override; procedure WordPaintToCanvas(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; ALeft, ATop: Integer); override; property Blocks: TKMemoBlocks read FBlocks; property BlockStyle: TKMemoBlockStyle read FBlockStyle; property Clip: Boolean read FClip write SetClip; property CurrentRequiredHeight: Integer read FCurrentRequiredHeight; property CurrentRequiredWidth: Integer read FCurrentRequiredWidth; property FixedHeight: Boolean read FFixedHeight write SetFixedHeight; property FixedWidth: Boolean read FFixedWidth write SetFixedWidth; property RequiredHeight: Integer read FRequiredHeight write SetRequiredHeight; property RequiredWidth: Integer read FRequiredWidth write SetRequiredWidth; property TotalLineCount: Integer read GetTotalLineCount; property TotalLineRect[Index: TKMemoTotalLineIndex]: TRect read GetTotalLineRect; end; TKMemoTable = class; TKMemoTableRow = class; { TKMemoTableCell } TKMemoTableCell = class(TKMemoContainer) private FParaStyle: TKMemoParaStyle; FRequiredBorderWidths: TKRect; FSpan: TKCellSpan; function GetColIndex: Integer; function GetParentRow: TKMemoTableRow; function GetParentTable: TKMemoTable; function GetRowIndex: Integer; protected function ContentLength: TKMemoSelectionIndex; override; function GetParaStyle: TKMemoParaStyle; override; procedure ParaStyleChanged(Sender: TObject; AReasons: TKMemoUpdateReasons); procedure RequiredBorderWidthsChanged(Sender: TObject); procedure SetColSpan(Value: Integer); virtual; procedure SetRowSpan(Value: Integer); virtual; procedure SetSpan(const Value: TKCellSpan); virtual; public constructor Create; override; destructor Destroy; override; procedure Assign(ASource: TKObject); override; function PointToIndex(ACanvas: TCanvas; const APoint: TPoint; AFirstRow, ALastRow, AOutOfArea, ASelectionExpanding: Boolean; out APosition: TKMemoLinePosition): TKMemoSelectionIndex; reintroduce; virtual; function WordMeasureExtent(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; ARequiredWidth: Integer): TPoint; override; procedure WordPaintToCanvas(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; ALeft, ATop: Integer); override; property ParentRow: TKMemoTableRow read GetParentRow; property ParentTable: TKMemoTable read GetParentTable; property RequiredBorderWidths: TKRect read FRequiredBorderWidths; property Span: TKCellSpan read FSpan write SetSpan; property ColIndex: Integer read GetColIndex; property ColSpan: Integer read FSpan.ColSpan write SetColSpan; property RowIndex: Integer read GetRowIndex; property RowSpan: Integer read FSpan.RowSpan write SetRowSpan; end; { TKMemoTableRow } TKMemoTableRow = class(TKMemoContainer) private function GetCells(Index: Integer): TKMemoTableCell; function GetCellCount: Integer; function GetParentTable: TKMemoTable; protected procedure FixedHeightChanged; override; function GetTotalLineCount: Integer; override; function GetTotalLineRect(Index: TKMemoTotalLineIndex): TRect; override; procedure RequiredHeightChanged; override; procedure SetCellCount(const Value: Integer); virtual; public constructor Create; override; destructor Destroy; override; function CanAdd(ABlock: TKMemoBlock): Boolean; override; property CellCount: Integer read GetCellCount write SetCellCount; property Cells[Index: Integer]: TKMemoTableCell read GetCells; property ParentTable: TKMemoTable read GetParentTable; end; TKMemoTable = class(TKMemoContainer) private FCellStyle: TKMemoBlockStyle; FColCount: Integer; FColWidths: TKMemoIndexObjectList; function GetCells(ACol, ARow: Integer): TKMemoTableCell; function GetCellSpan(ACol, ARow: Integer): TKCellSpan; function GetColWidths(Index: Integer): Integer; function GetRows(Index: Integer): TKMemoTableRow; function GetRowCount: Integer; function GetRowHeights(Index: Integer): Integer; procedure SetColCount(const Value: Integer); procedure SetRowCount(const Value: Integer); protected procedure InternalSetCellSpan(ACol, ARow: Integer; const Value: TKCellSpan); virtual; procedure SetCellSpan(ACol, ARow: Integer; Value: TKCellSpan); virtual; procedure SetColWidths(Index: Integer; const Value: Integer); virtual; procedure SetRowHeights(Index: Integer; const Value: Integer); virtual; procedure SetSize(AColCount, ARowCount: Integer); virtual; public constructor Create; override; destructor Destroy; override; procedure ApplyDefaultCellStyle; virtual; procedure Assign(ASource: TKObject); override; procedure AssignAttributes(ABlock: TKMemoBlock); override; function CanAdd(ABlock: TKMemoBlock): Boolean; override; function CalcTotalCellWidth(ACol, ARow: Integer): Integer; virtual; function CellValid(ACol, ARow: Integer): Boolean; virtual; function CellVisible(ACol, ARow: Integer): Boolean; virtual; function ColValid(ACol: Integer): Boolean; virtual; procedure FindBaseCell(ACol, ARow: Integer; out BaseCol, BaseRow: Integer); virtual; function FindCell(ACell: TKMemoTableCell; out ACol, ARow: Integer): Boolean; virtual; procedure FixupBorders; virtual; procedure FixupCellSpan; virtual; procedure FixupCellSpanFromRTF; virtual; function RowValid(ARow: Integer): Boolean; virtual; function WordMeasureExtent(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; ARequiredWidth: Integer): TPoint; override; function WordMouseAction(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; AAction: TKMemoMouseAction; const APoint: TPoint; AShift: TShiftState): Boolean; override; function WordPointToIndex(ACanvas: TCanvas; const APoint: TPoint; AWordIndex: TKMemoWordIndex; AOutOfArea, ASelectionExpanding: Boolean; out APosition: TKMemoLinePosition): TKMemoSelectionIndex; override; property Cells[ACol, ARow: Integer]: TKMemoTableCell read GetCells; property CellSpan[ACol, ARow: Integer]: TKCellSpan read GetCellSpan write SetCellSpan; property CellStyle: TKMemoBlockStyle read FCellStyle; property ColCount: Integer read FColCount write SetColCount; property ColWidths[Index: Integer]: Integer read GetColWidths write SetColWidths; property RowCount: Integer read GetRowCount write SetRowCount; property RowHeights[Index: Integer]: Integer read GetRowHeights write SetRowHeights; property Rows[Index: Integer]: TKMemoTableRow read GetRows; end; TKMemoMeasState = class(TObject) public CurBlockIndex, LastBlockIndex: TKMemoBlockIndex; CurWordIndex, LastWordIndex: TKMemoWordIndex; CurIndex, LastIndex: TKMemoSelectionIndex; CurTotalWord, LastTotalWord: TKMemoWordIndex; PosX, PosY, RightX, LineHeight, ParaWidth, ParaPosY, RequiredWidth: Integer; IsBreakable, IsParagraph: Boolean; CurParaStyle: TKMemoParaStyle; CurParagraph: TKMemoParagraph; procedure Clear; procedure Assign(AState: TKMemoMeasState); function Initialized: Boolean; end; TKMemoUpdateEvent = procedure(Reasons: TKMemoUpdateReasons) of object; TKMemoBlocks = class(TKObjectList) private FExtent: TPoint; FIgnoreParaMark: Boolean; FMemoNotifier: IKMemoNotifier; FParent: TKMemoBlock; FSelectableLength: TKMemoSelectionIndex; FSelEnd: TKMemoSelectionIndex; FSelStart: TKMemoSelectionIndex; FOnUpdate: TKMemoUpdateEvent; function GetBoundsRect: TRect; function GetEmpty: Boolean; function GetFirstBlock: TKMemoBlock; function GetItem(Index: TKMemoBlockIndex): TKMemoBlock; function GetLastBlock: TKMemoBlock; function GetLineCount: Integer; function GetParentBlocks: TKMemoBlocks; function GetParentMemo: TKCustomMemo; function GetRealSelEnd: TKMemoSelectionIndex; function GetRealSelLength: TKMemoSelectionIndex; function GetRealSelStart: TKMemoSelectionIndex; function GetSelLength: TKMemoSelectionIndex; procedure SetIgnoreParaMark(const Value: Boolean); procedure SetItem(Index: TKMemoBlockIndex; const Value: TKMemoBlock); procedure SetMemoNotifier(const Value: IKMemoNotifier); function IndexToInnerBlock(AIndex: TKMemoSelectionIndex): TKMemoBlock; protected FLines: TKMemoLines; FRelPos: TKMemoIndexObjectList; FState, FBackState: TKMemoMeasState; FUpdateReasons: TKMemoUpdateReasons; procedure CallBeforeUpdate; override; procedure CallAfterUpdate; override; procedure DoUpdate(AReasons: TKMemoUpdateReasons); function EOLToNormal(var AIndex: TKMemoSelectionIndex): Boolean; virtual; function GetDefaultTextStyle: TKMemoTextStyle; virtual; function GetDefaultParaStyle: TKMemoParaStyle; virtual; function GetLineBottom(ALineIndex: TKMemoLineIndex): Integer; virtual; function GetLineEndIndex(ALineIndex: TKMemoLineIndex): TKMemoSelectionIndex; virtual; function GetLineFloat(ALineIndex: TKMemoLineIndex): Boolean; virtual; function GetLineHeight(ALineIndex: TKMemoLineIndex): Integer; virtual; function GetLineInfo(ALineIndex: TKMemoLineIndex): TKMemoLine; function GetLineLeft(ALineIndex: TKMemoLineIndex): Integer; virtual; function GetLinePosition: TKMemoLinePosition; virtual; function GetLineRect(ALineIndex: TKMemoLineIndex): TRect; virtual; function GetLineRight(ALineIndex: TKMemoLineIndex): Integer; virtual; function GetLineText(ALineIndex: TKMemoLineIndex): TKString; virtual; function GetLineSize(ALineIndex: TKMemoLineIndex): Integer; virtual; function GetLineStartIndex(ALineIndex: TKMemoLineIndex): TKMemoSelectionIndex; virtual; function GetLineTop(ALineIndex: TKMemoLineIndex): Integer; virtual; function GetLineWidth(ALineIndex: TKMemoLineIndex): Integer; virtual; function GetMaxWordLength: TKMemoSelectionIndex; virtual; function GetSelectionHasPara: Boolean; virtual; function GetSelectionParaStyle: TKMemoParaStyle; virtual; function GetSelectionTextStyle: TKMemoTextStyle; virtual; function GetSelText: TKString; virtual; function GetShowFormatting: Boolean; virtual; function GetText: TKString; virtual; function GetTotalLeftOffset: Integer; virtual; function GetTotalLineCount: Integer; virtual; function GetTotalLineRect(Index: TKMemoTotalLineIndex): TRect; virtual; function GetTotalTopOffset: Integer; virtual; procedure GetWordIndexes(ABlockIndex: TKMemoBlockIndex; ALineIndex: TKMemoLineIndex; out AStart, AEnd: TKMemoWordIndex); virtual; function LineToRect(ACanvas: TCanvas; AIndex: TKMemoSelectionIndex; ALineIndex: TKMemoLineIndex; ACaret: Boolean): TRect; virtual; function NormalToEOL(var AIndex: TKMemoSelectionIndex): Boolean; virtual; procedure Notify(Ptr: Pointer; Action: TListNotification); override; procedure PaintLineBackground(ACanvas: TCanvas; ALineIndex: TKMemoLineIndex; ALeft, ATop: Integer); virtual; procedure PaintLineInfo(ACanvas: TCanvas; ALineIndex: TKMemoLineIndex; ALeft, ATop: Integer); virtual; function Select(ASelStart, ASelLength: TKMemoSelectionIndex; ADoScroll: Boolean = True; ATextOnly: Boolean = False): Boolean; virtual; procedure SetLineText(ALineIndex: TKMemoLineIndex; const AValue: TKString); virtual; procedure SetSelectionParaStyle(const Value: TKMemoParaStyle); virtual; procedure SetSelectionTextStyle(const Value: TKMemoTextStyle); virtual; procedure SetText(const AValue: TKString); procedure Update(AReasons: TKMemoUpdateReasons); virtual; public constructor Create; override; destructor Destroy; override; function AddAt(AObject: TKMemoBlock; At: TKMemoBlockIndex = -1): TKMemoBlockIndex; virtual; function AddContainer(At: TKMemoBlockIndex = -1): TKMemoContainer; function AddHyperlink(const AText, AURL: TKString; At: TKMemoBlockIndex = -1): TKMemoHyperlink; overload; function AddHyperlink(ABlock: TKMemoHyperlink; At: TKMemoBlockIndex = -1): TKMemoHyperlink; overload; function AddImageBlock(AImage: TPicture; At: TKMemoBlockIndex = -1): TKMemoImageBlock; overload; function AddImageBlock(const APath: TKString; At: TKMemoBlockIndex = -1): TKMemoImageBlock; overload; function AddParagraph(At: TKMemoBlockIndex = -1): TKMemoParagraph; function AddTable(At: TKMemoBlockIndex = -1): TKMemoTable; function AddTextBlock(const AText: TKString; At: TKMemoBlockIndex = -1): TKMemoTextBlock; procedure Assign(ASource: TKObjectList); override; function BlockIndexToBlock(ABlockIndex: TKMemoBlockIndex): TKMemoBlock; function BlockToIndex(ABlock: TKMemoBlock): TKMemoSelectionIndex; virtual; procedure Clear; override; procedure ClearSelection(ATextOnly: Boolean = True); virtual; procedure ConcatEqualBlocks; virtual; procedure DeleteBOL(At: TKMemoSelectionIndex); virtual; procedure DeleteChar(At: TKMemoSelectionIndex); virtual; procedure DeleteEOL(At: TKMemoSelectionIndex); virtual; procedure DeleteLastChar(At: TKMemoSelectionIndex); virtual; procedure DeleteLine(At: TKMemoSelectionIndex); virtual; procedure FixEmptyBlocks; virtual; procedure FixEOL(AIndex: TKMemoSelectionIndex; AAdjust: Boolean; var ALinePos: TKMemoLinePosition); virtual; function GetLastBlockByClass(ABlockIndex: TKMemoBlockIndex; AClass: TKMemoBlockClass): TKMemoBlock; virtual; function GetNearestAnchorBlockIndex(ABlockIndex: TKMemoBlockIndex): TKMemoBlockIndex; virtual; function GetNearestParagraphBlockIndex(ABlockIndex: TKMemoBlockIndex): TKMemoBlockIndex; function GetNearestParagraphBlock(ABlockIndex: TKMemoBlockIndex): TKMemoParagraph; function GetNearestWordIndexes(AIndex: TKMemoSelectionIndex; AAdjust: Boolean; AIncludeWhiteSpaces: Boolean; out AStart, AEnd: TKMemoSelectionIndex): Boolean; virtual; function GetNextBlockByClass(ABlockIndex: TKMemoBlockIndex; AClass: TKMemoBlockClass): TKMemoBlock; virtual; function GetPageCount(APageHeight: Integer): Integer; virtual; procedure GetPageData(APageHeight, APage: Integer; out AOffset, AHeight: Integer); virtual; function GetParentBlocksForBlock(ABlock: TKMemoBlock): TKMemoBlocks; virtual; procedure GetSelColors(out TextColor, Background: TColor); virtual; function IndexAboveLastLine(AIndex: TKMemoSelectionIndex; AAdjust: Boolean): Boolean; virtual; function IndexAtBeginningOfContainer(AIndex: TKMemoSelectionIndex; AAdjust: Boolean): Boolean; virtual; function IndexAtEndOfContainer(AIndex: TKMemoSelectionIndex; AAdjust: Boolean): Boolean; virtual; function IndexBelowFirstLine(AIndex: TKMemoSelectionIndex; AAdjust: Boolean): Boolean; virtual; function IndexToBlockIndex(AIndex: TKMemoSelectionIndex; out ALocalIndex: TKMemoSelectionIndex): TKMemoBlockIndex; virtual; function IndexToBlocks(AIndex: TKMemoSelectionIndex; out ALocalIndex: TKMemoSelectionIndex): TKMemoBlocks; virtual; function IndexToBlock(AIndex: TKMemoSelectionIndex; out ALocalIndex: TKMemoSelectionIndex): TKMemoBlock; virtual; function IndexToLineIndex(AIndex: TKMemoSelectionIndex): TKMemoLineIndex; virtual; function IndexToRect(ACanvas: TCanvas; AIndex: TKMemoSelectionIndex; ACaret, AAdjust: Boolean): TRect; virtual; function InsideOfTable: Boolean; virtual; procedure InsertChar(At: TKMemoSelectionIndex; const AValue: TKChar; AOverWrite: Boolean; ATextStyle: TKMemoTextStyle = nil); virtual; procedure InsertNewLine(At: TKMemoSelectionIndex); virtual; procedure InsertPlainText(AIndex: TKMemoSelectionIndex; const AValue: TKString); virtual; function InsertParagraph(AIndex: TKMemoSelectionIndex; AAdjust: Boolean): Boolean; virtual; function InsertString(AIndex: TKMemoSelectionIndex; AAdjust: Boolean; const AValue: TKString; ATextStyle: TKMemoTextStyle = nil): Boolean; virtual; function LastTextStyle(ABlockIndex: TKMemoBlockIndex): TKMemoTextStyle; virtual; function LineEndIndexByIndex(AIndex: TKMemoSelectionIndex; AAdjust, ASelectionExpanding: Boolean; out ALinePos: TKMemoLinePosition): TKMemoSelectionIndex; virtual; function LineStartIndexByIndex(AIndex: TKMemoSelectionIndex; AAdjust: Boolean; out ALinePos: TKMemoLinePosition): TKMemoSelectionIndex; virtual; procedure ListChanged(AList: TKMemoList; ALevel: TKMemoListLevel); virtual; procedure LoadFromRTFStream(AStream: TStream; AtIndex: TKMemoSelectionIndex = -1); virtual; procedure MeasureExtent(ACanvas: TCanvas; ARequiredWidth: Integer); virtual; function MouseAction(AAction: TKMemoMouseAction; ACanvas: TCanvas; const APoint: TPoint; AShift: TShiftState): Boolean; virtual; procedure NotifyDefaultParaChange; virtual; procedure NotifyDefaultTextChange; virtual; procedure NotifyOptionsChange; virtual; procedure NotifyPrintBegin; virtual; procedure NotifyPrintEnd; virtual; function NextIndexByCharCount(AIndex: TKMemoSelectionIndex; ACharCount: Integer): TKMemoSelectionIndex; function NextIndexByHorzExtent(ACanvas: TCanvas; AIndex: TKMemoSelectionIndex; AWidth: Integer; out ALinePos: TKMemoLinePosition): TKMemoSelectionIndex; virtual; function NextIndexByRowDelta(ACanvas: TCanvas; AIndex: TKMemoSelectionIndex; ARowDelta, ALeftPos: Integer; out ALinePos: TKMemoLinePosition): TKMemoSelectionIndex; virtual; function NextIndexByVertExtent(ACanvas: TCanvas; AIndex: TKMemoSelectionIndex; AHeight, ALeftPos: Integer; out ALinePos: TKMemoLinePosition): TKMemoSelectionIndex; virtual; function NextIndexByVertValue(ACanvas: TCanvas; AValue, ALeftPos: Integer; ADirection: Boolean; out ALinePos: TKMemoLinePosition): TKMemoSelectionIndex; virtual; function PointToBlocks(const APoint: TPoint): TKMemoBlocks; virtual; procedure PaintToCanvas(ACanvas: TCanvas; ALeft, ATop: Integer; const ARect: TRect); virtual; function PointToIndex(ACanvas: TCanvas; const APoint: TPoint; AOutOfArea, ASelectionExpanding: Boolean; out ALinePos: TKMemoLinePosition): TKMemoSelectionIndex; virtual; function PointToIndexOnLine(ACanvas: TCanvas; ALineIndex: TKMemoLineIndex; const APoint: TPoint; AOutOfArea, ASelectionExpanding: Boolean; out ALinePos: TKMemoLinePosition): TKMemoSelectionIndex; virtual; function PointToRelativeBlock(const APoint: TPoint): TKMemoBlock; virtual; procedure RestoreUpdateState(AValue: TKMemoUpdateReasons); virtual; procedure SaveToRTFStream(AStream: TStream; ASelectedOnly: Boolean = False); virtual; function SaveUpdateState: TKMemoUpdateReasons; virtual; procedure SetExtent(AWidth, AHeight: Integer); virtual; procedure SetRangeParaStyle(AFrom, ATo: TKMemoSelectionIndex; AStyle: TKMemoParaStyle); virtual; procedure SetRangeTextStyle(AFrom, ATo: TKMemoSelectionIndex; AStyle: TKMemoTextStyle); virtual; function SplitForInsert(AAtIndex: TKMemoSelectionIndex; out ABlockIndex: TKMemoBlockIndex): TKMemoBlocks; virtual; procedure UpdateAttributes; virtual; property BoundsRect: TRect read GetBoundsRect; property DefaultTextStyle: TKMemoTextStyle read GetDefaultTextStyle; property DefaultParaStyle: TKMemoParaStyle read GetDefaultParaStyle; property Empty: Boolean read GetEmpty; property FirstBlock: TKMemoBlock read GetFirstBlock; property Height: Integer read FExtent.Y; property IgnoreParaMark: Boolean read FIgnoreParaMark write SetIgnoreParaMark; property Items[Index: TKMemoBlockIndex]: TKMemoBlock read GetItem write SetItem; default; property LastBlock: TKMemoBlock read GetLastBlock; property LineBottom[ALineIndex: TKMemoLineIndex]: Integer read GetLineBottom; property LineCount: Integer read GetLineCount; property LineEndIndex[ALineIndex: TKMemoLineIndex]: TKMemoSelectionIndex read GetLineEndIndex; property LineFloat[ALineIndex: TKMemoLineIndex]: Boolean read GetLineFloat; property LineInfo[ALineIndex: TKMemoLineIndex]: TKMemoLine read GetLineInfo; property LineHeight[ALineIndex: TKMemoLineIndex]: Integer read GetLineHeight; property LineLeft[ALineIndex: TKMemoLineIndex]: Integer read GetLineLeft; property LineRight[ALineIndex: TKMemoLineIndex]: Integer read GetLineRight; property LineTop[ALineIndex: TKMemoLineIndex]: Integer read GetLineTop; property LineRect[ALineIndex: TKMemoLineIndex]: TRect read GetLineRect; property LineText[ALineIndex: TKMemoLineIndex]: TKString read GetLineText write SetLineText; property Lines: TKMemoLines read FLines; property LineSize[ALineIndex: TKMemoLineIndex]: Integer read GetLineSize; property LineStartIndex[ALineIndex: TKMemoLineIndex]: TKMemoSelectionIndex read GetLineStartIndex; property LineWidth[ALineIndex: TKMemoLineIndex]: Integer read GetLineWidth; property MemoNotifier: IKMemoNotifier read FMemoNotifier write SetMemoNotifier; property Parent: TKMemoBlock read FParent write FParent; property ParentBlocks: TKMemoBlocks read GetParentBlocks; property ParentMemo: TKCustomMemo read GetParentMemo; property RealSelEnd: TKMemoSelectionIndex read GetRealSelEnd; property RealSelLength: TKMemoSelectionIndex read GetRealSelLength; property RealSelStart: TKMemoSelectionIndex read GetRealSelStart; property SelectableLength: TKMemoSelectionIndex read FSelectableLength; property SelectionHasPara: Boolean read GetSelectionHasPara; property SelectionParaStyle: TKMemoParaStyle read GetSelectionParaStyle write SetSelectionParaStyle; property SelectionTextStyle: TKMemoTextStyle read GetSelectionTextStyle write SetSelectionTextStyle; property SelEnd: TKMemoSelectionIndex read FSelEnd; property SelLength: TKMemoSelectionIndex read GetSelLength; property SelStart: TKMemoSelectionIndex read FSelStart; property SelText: TKString read GetSelText; property ShowFormatting: Boolean read GetShowFormatting; property Text: TKString read GetText write SetText; property TotalLeftOffset: Integer read GetTotalLeftOffset; property TotalLineCount: Integer read GetTotalLineCount; property TotalLineRect[Index: TKMemoTotalLineIndex]: TRect read GetTotalLineRect; property TotalTopOffset: Integer read GetTotalTopOffset; property Width: Integer read FExtent.X; property OnUpdate: TKMemoUpdateEvent read FOnUpdate write FOnUpdate; end; { @abstract(Container for all colors used by @link(TKCustomMemo) class) This container allows to group many colors into one item in object inspector. Colors are accessible via published properties or several public Color* properties. } TKMemoColors = class(TKCustomColors) private protected { Returns the specific color according to ColorScheme. } function InternalGetColor(Index: TKColorIndex): TColor; override; { Returns color specification structure for given index. } function GetColorSpec(Index: TKColorIndex): TKColorSpec; override; { Returns maximum color index. } function GetMaxIndex: Integer; override; published { Hex editor client area background. } property BkGnd: TColor index ciBkGnd read GetColor write SetColor default cBkGndDef; { Inactive (memo without focus) caret background color - caret mark is not part of a selection. } property InactiveCaretBkGnd: TColor index ciInactiveCaretBkGnd read GetColor write SetColor default cInactiveCaretBkGndDef; { Inactive (memo without focus) caret background color - caret mark is part of a selection. } property InactiveCaretSelBkGnd: TColor index ciInactiveCaretSelBkGnd read GetColor write SetColor default cInactiveCaretSelBkGndDef; { Inactive (memo without focus) caret text color - caret mark is part of a selection. } property InactiveCaretSelText: TColor index ciInactiveCaretSelText read GetColor write SetColor default cInactiveCaretSelTextDef; { Inactive (memo without focus) caret text color - caret mark is not part of a selection. } property InactiveCaretText: TColor index ciInactiveCaretText read GetColor write SetColor default cInactiveCaretTextDef; { Selection background - inactive edit area. } property SelBkGnd: TColor index ciSelBkGnd read GetColor write SetColor default cSelBkGndDef; { Selection background - active edit area. } property SelBkGndFocused: TColor index ciSelBkGndFocused read GetColor write SetColor default cSelBkGndFocusedDef; { Selection text - inactive edit area. } property SelText: TColor index ciSelText read GetColor write SetColor default cSelTextDef; { Selection text - active edit area. } property SelTextFocused: TColor index ciSelTextFocused read GetColor write SetColor default cSelTextFocusedDef; end; { Declares possible values for the ItemKind member of the @link(TKMemoChangeItem) structure. } TKMemoChangeKind = ( { Save caret position only. } ckCaretPos, { Save inserted data to be able to delete it. } ckDelete, { Save deleted data to be able to insert it. } ckInsert ); { @abstract(Declares @link(TKMemoChangeList.OnChange) event handler)
    Parameters:
  • Sender - identifies the event caller
  • ItemReason - specifies the undo/redo reason
} TKMemoUndoChangeEvent = procedure(Sender: TObject; ItemReason: TKMemoChangeKind) of object; { @abstract(Declares the undo/redo item description structure used by the @link(TKMemoChangeList) class)
    Members:
  • Data - string needed to execute this item
  • EditArea - active edit area at the time this item was recorded
  • Group - identifies the undo/redo group. Some editor modifications produce a sequence of 2 or more undo items. This sequence is called undo/redo group and is always interpreted as a single undo/redo item. Moreover, if there is @link(eoGroupUndo) among @link(TKCustomMemo.Options), a single ecUndo or ecRedo command manipulates all following undo groups of the same kind as if they were a single undo/redo item.
  • GroupKind - kind of this undo group
  • ItemKind - kind of this item
  • SelEnd - end of the selection at the time this item was recorded
  • SelStart - start of the selection at the time this item was recorded
} TKMemoChangeItem = record Blocks: TKMemoBlocks; Group: Cardinal; GroupKind: TKMemoChangeKind; Inserted: Boolean; ItemKind: TKMemoChangeKind; Position: Integer; end; { Pointer to @link(TKMemoChangeItem). } PKMemoChangeItem = ^TKMemoChangeItem; { @abstract(Change (undo/redo item) list manager). } TKMemoChangeList = class(TList) private FEditor: TKCustomMemo; FGroup: Cardinal; FGroupUseLock: Integer; FGroupKind: TKMemoChangeKind; FIndex: Integer; FModifiedIndex: Integer; FLimit: Integer; FRedoList: TKMemoChangeList; FOnChange: TKMemoUndoChangeEvent; function GetModified: Boolean; procedure SetLimit(Value: Integer); procedure SetModified(Value: Boolean); protected { Redefined to properly destroy the items. } procedure Notify(Ptr: Pointer; Action: TListNotification); override; public { Performs necessary initializations
    Parameters:
  • AEditor - identifies the undo/redo list owner
  • RedoList - when this instance is used as undo list, specify a redo list to allow clear it at each valid AddChange call
} constructor Create(AEditor: TKCustomMemo; RedoList: TKMemoChangeList); { Inserts a undo/redo item
    Parameters:
  • ItemKind - specifies the undo/redo item reason. The change list doesn't allow to insert succesive crCaretPos items unless Inserted is True
  • Data - specifies the item data. Some items (crCaretPos) don't need to supply any data
  • Inserted - for the urInsert* items, specifies whether the item was recorded with @link(TKCustomMemo.InsertMode) on (True) or off (False). See ItemKind for crCaretPos behavior.
} procedure AddChange(ItemKind: TKMemoChangeKind; Inserted: Boolean = True); virtual; { Tells the undo list a new undo/redo group is about to be created. Each BeginGroup call must have a corresponding EndGroup call (use try-finally). BeginGroup calls may be nested, however, only the first call will create an undo/redo group. Use the GroupKind parameter to specify the reason of this group. } procedure BeginGroup(GroupKind: TKMemoChangeKind); virtual; { Informs whether there are any undo/redo items available - i.e. CanUndo/CanRedo. } function CanPeek: Boolean; { Clears the entire list - overriden to execute some adjustments. } procedure Clear; override; { Completes the undo/redo group. See @link(TKMemoChangeList.BeginGroup) for details. } procedure EndGroup; virtual; { Returns the topmost item to handle or inspect it. } function PeekItem: PKMemoChangeItem; { If there is no reason to handle an item returned by PeekItem, it has to be poked back with this function to become active for next undo/redo command. } procedure PokeItem; { For redo list only - each undo command creates a redo command with the same group information - see source. } procedure SetGroupData(Group: Integer; GroupKind: TKMemoChangeKind); { Specifies maximum number of items - not groups. } property Limit: Integer read FLimit write SetLimit; { For undo list only - returns True if undo list contains some items with regard to the @link(eoUndoAfterSave) option. } property Modified: Boolean read GetModified write SetModified; { Allows to call TKCustomMemo.@link(TKCustomMemo.OnChange) event. } property OnChange: TKMemoUndoChangeEvent read FOnChange write FOnChange; end; TKMemoRTFString = type string; TKMemoBlockNotifyEvent = procedure(Sender: TObject; ABlock: TKMemoBlock; var Result: Boolean) of object; { @abstract(Multi line text editor base component). } { TKCustomMemo } TKCustomMemo = class(TKCustomControl, IKMemoNotifier) private FActiveBlocks: TKMemoBlocks; FBackground: TKMemoBackground; FBlocks: TKMemoBlocks; FColors: TKMemoColors; FContentPadding: TKRect; FDisabledDrawStyle: TKEditDisabledDrawStyle; FKeyMapping: TKEditKeyMapping; FLeftPos: Integer; FListTable: TKMemoListTable; FMaxWordLength: TKMemoSelectionIndex; FMouseWheelAccumulator: Integer; FNewTextStyle: TKMemoTextStyle; FOptions: TKEditOptions; FParaStyle: TKMemoParaStyle; FRedoList: TKMemoChangeList; FRequiredContentWidth: Integer; FScrollBars: TScrollStyle; FScrollPadding: Integer; FScrollSpeed: Cardinal; FScrollTimer: TTimer; FStates: TKMemoStates; FTextStyle: TKMemoTextStyle; FTopPos: Integer; FUndoList: TKMemoChangeList; FWordBreaks: TKSysCharSet; FOnBlockClick: TKMemoBlockNotifyEvent; FOnBlockDblClick: TKMemoBlockNotifyEvent; FOnBlockEdit: TKMemoBlockNotifyEvent; FOnChange: TNotifyEvent; FOnDropFiles: TKEditDropFilesEvent; FOnReplaceText: TKEditReplaceTextEvent; function GetActiveBlock: TKMemoBlock; function GetActiveInnerBlock: TKMemoBlock; function GetActiveInnerBlocks: TKMemoBlocks; function GetCaretRect: TRect; function GetCaretVisible: Boolean; function GetContentHeight: Integer; function GetContentLeft: Integer; function GetContentRect: TRect; function GetContentTop: Integer; function GetContentWidth: Integer; function GetEmpty: Boolean; function GetInsertMode: Boolean; function GetModified: Boolean; function GetRelativeSelected: Boolean; function GetRequiredContentWidth: Integer; function GetRTF: TKMemoRTFString; function GetSelAvail: Boolean; function GetSelectableLength: TKMemoSelectionIndex; function GetSelectionHasPara: Boolean; function GetSelectionParaStyle: TKMemoParaStyle; function GetSelectionTextStyle: TKMemoTextStyle; function GetSelEnd: TKMemoSelectionIndex; function GetSelLength: TKMemoSelectionIndex; function GetSelStart: TKMemoSelectionIndex; function GetSelText: TKString; function GetText: TKString; function GetUndoLimit: Integer; function IsOptionsStored: Boolean; procedure ScrollTimerHandler(Sender: TObject); procedure SetActiveBlocks(const Value: TKMemoBlocks); procedure SetBackground(const Value: TKMemoBackground); procedure SetColors(Value: TKMemoColors); procedure SetContentPadding(const Value: TKRect); procedure SetDisabledDrawStyle(Value: TKEditDisabledDrawStyle); procedure SetLeftPos(Value: Integer); procedure SetMaxWordLength(const Value: TKMemoSelectionIndex); procedure SetModified(Value: Boolean); procedure SetNewTextStyle(const Value: TKMemoTextStyle); procedure SetOptions(const Value: TKEditOptions); procedure SetReadOnly(Value: Boolean); procedure SetRequiredContentWidth(const Value: Integer); procedure SetRTF(const Value: TKMemoRTFString); procedure SetScrollBars(Value: TScrollStyle); procedure SetScrollPadding(Value: Integer); procedure SetScrollSpeed(Value: Cardinal); procedure SetSelectionParaStyle(const Value: TKMemoParaStyle); procedure SetSelectionTextStyle(const Value: TKMemoTextStyle); procedure SetSelEnd(Value: TKMemoSelectionIndex); procedure SetSelLength(Value: TKMemoSelectionIndex); procedure SetSelStart(Value: TKMemoSelectionIndex); procedure SetText(const Value: TKString); procedure SetTopPos(Value: Integer); procedure SetUndoLimit(Value: Integer); procedure SetWordBreaks(const Value: TKSysCharSet); procedure CMEnabledChanged(var Msg: TLMessage); message CM_ENABLEDCHANGED; procedure CMSysColorChange(var Msg: TLMessage); message CM_SYSCOLORCHANGE; {$IFNDEF FPC} procedure EMGetSel(var Msg: TLMessage); message EM_GETSEL; procedure EMSetSel(var Msg: TLMessage); message EM_SETSEL; {$ENDIF} procedure WMClear(var Msg: TLMessage); message LM_CLEAR; procedure WMCopy(var Msg: TLMessage); message LM_COPY; procedure WMCut(var Msg: TLMessage); message LM_CUT; {$IFNDEF FPC} // no way to get filenames in Lazarus inside control (why??) procedure WMDropFiles(var Msg: TLMessage); message LM_DROPFILES; {$ENDIF} procedure WMEraseBkgnd(var Msg: TLMessage); message LM_ERASEBKGND; procedure WMGetDlgCode(var Msg: TLMNoParams); message LM_GETDLGCODE; procedure WMHScroll(var Msg: TLMHScroll); message LM_HSCROLL; procedure WMKillFocus(var Msg: TLMKillFocus); message LM_KILLFOCUS; procedure WMPaste(var Msg: TLMessage); message LM_PASTE; procedure WMSetFocus(var Msg: TLMSetFocus); message LM_SETFOCUS; procedure WMVScroll(var Msg: TLMVScroll); message LM_VSCROLL; protected FCaretRect: TRect; FDragCurPos: TPoint; FDragMode: TKSizingGripPosition; FDragOrigRect: TRect; FDragRect: TRect; FHorzExtent: Integer; FHorzScrollExtent: Integer; FHorzScrollStep: Integer; FInUpdateScrollRange: Boolean; FLinePosition: TKMemoLinePosition; FNewTextStyleValid: Boolean; FOldCaretRect: TRect; { Method pointer to the private TControl.FontChanged. } FOldFontChanged: TNotifyEvent; FPreferredCaretPos: Integer; FRequiredMouseCursor: TCursor; FSelectedBlock: TKMemoBlock; FVertExtent: Integer; FVertScrollExtent: Integer; FVertScrollStep: Integer; { Inserts a single crCaretPos item into undo list. Unless Force is set to True, this change will be inserted only if previous undo item is not crCaretPos. } procedure AddUndoCaretPos(Force: Boolean = True); virtual; { Inserts a single character change into undo list.
    Parameters:
  • AItemKind - specifies the undo/redo item reason - most likely crInsertChar or crDeleteChar.
  • AData - specifies the character needed to restore the original text state
  • AInserted - for the urInsert* items, specifies the current @link(TKCustomMemo.InsertMode) status.
} procedure AddUndoChar(AItemKind: TKMemoChangeKind; AData: TKChar; AInserted: Boolean = True); virtual; { Inserts a string change into undo list.
    Parameters:
  • AItemKind - specifies the undo/redo item reason - crInsert* or crDelete*.
  • AData - specifies the text string needed to restore the original text state
  • AInserted - for the urInsert* items, specifies the current @link(TKCustomMemo.InsertMode) status.
} procedure AddUndoString(AItemKind: TKMemoChangeKind; const AData: TKString; AInserted: Boolean = True); virtual; { Notify control about main window background changes. } procedure BackgroundChanged(Sender: TObject); virtual; { Begins a new undo group. Use the GroupKind parameter to label it. } procedure BeginUndoGroup(AGroupKind: TKMemoChangeKind); { Converts a rectangle relative to active blocks to a rectangle relative to TKMemo. } function BlockRectToRect(const ARect: TRect): TRect; virtual; { IKMemoNotifier implementation. } function BlockClick(ABlock: TKMemoBlock): Boolean; { IKMemoNotifier implementation. } function BlockDblClick(ABlock: TKMemoBlock): Boolean; { IKMemoNotifier implementation. } procedure BlockFreeNotification(ABlock: TKMemoBlock); { IKMemoNotifier implementation. } procedure BlocksFreeNotification(ABlocks: TKMemoBlocks); { Update the editor after block changes. } procedure BlocksChanged(Reasons: TKMemoUpdateReasons); { Cancel block dragging. } procedure CancelDrag; { Determines whether an ecScroll* command can be executed. } function CanScroll(ACommand: TKEditCommand): Boolean; virtual; { Called by ContentPadding class to update the memo control. } procedure ContentPaddingChanged(Sender: TObject); virtual; { Overriden method - window handle has been created. } procedure CreateHandle; override; { Overriden method - defines additional styles for the memo window (scrollbars etc.). } procedure CreateParams(var Params: TCreateParams); override; { Overriden method - adjusts file drag&drop functionality. } procedure CreateWnd; override; { Overriden method - adjusts file drag&drop functionality. } procedure DestroyWnd; override; { Calls the @link(TKCustomMemo.OnChange) event. } procedure DoChange; virtual; { Performs the Copy command. } function DoCopy: Boolean; virtual; { Overriden method - handles mouse wheel messages. } function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean; override; { Performs the Paste command. } function DoPaste: Boolean; virtual; { Performs the Redo command. } function DoRedo: Boolean; virtual; { Perforns the Search or Replace command. } function DoSearchReplace(AReplace: Boolean): Boolean; virtual; { Performs the Undo command. } function DoUndo: Boolean; virtual; { Performs block dragging. } procedure DragBlock; { IKMemoNotifier implementation. } function EditBlock(ABlock: TKMemoBlock): Boolean; { Closes the undo group created by @link(TKCustomMemo.BeginUndoGroup). } procedure EndUndoGroup; { Notify blocks about memo font change. } procedure FontChange(Sender: TObject); virtual; { IKMemoNotifier implementation. } function GetActiveBlocks: TKMemoBlocks; { IKMemoNotifier implementation. } function GetDefaultTextStyle: TKMemoTextStyle; { IKMemoNotifier implementation. } function GetDefaultParaStyle: TKMemoParaStyle; { IKMemoNotifier implementation. } function GetDrawSingleChars: Boolean; { Returns actual scroll padding in horizontal direction. } function GetHorzScrollPadding: Integer; virtual; { IKMemoNotifier implementation. } function GetLinePosition: TKMemoLinePosition; { IKMemoNotifier implementation. } function GetListTable: TKMemoListTable; { IKMemoNotifier implementation. } function GetMemo: TKCustomMemo; { IKMemoNotifier implementation. } function GetMaxWordLength: TKMemoSelectionIndex; { Return nearest paragraph. } function GetNearestParagraph: TKMemoParagraph; virtual; { Return block index of nearest paragraph. } function GetNearestParagraphIndex: TKMemoBlockIndex; virtual; { IKMemoNotifier implementation. } function GetPixelsPerInchX: Integer; { IKMemoNotifier implementation. } function GetPixelsPerInchY: Integer; { IKMemoNotifier implementation. } function GetPaintSelection: Boolean; { IKMemoNotifier implementation. } function GetPrinting: Boolean; { IKMemoNotifier implementation. } function GetReadOnly: Boolean; { IKMemoNotifier implementation. } procedure GetSelColors(out Foreground, Background: TColor); { IKMemoNotifier implementation. } function GetSelectedBlock: TKMemoBlock; { IKMemoNotifier implementation. } function GetShowFormatting: Boolean; { Returns "real" selection end - with always higher index value than selection start value. } function GetRealSelEnd: TKMemoSelectionIndex; virtual; { Returns "real" selection length - always non-negative number. } function GetRealSelLength: TKMemoSelectionIndex; { Returns "real" selection start - with always lower index value than selection end value. } function GetRealSelStart: TKMemoSelectionIndex; virtual; { Returns actual scroll padding in vertical direction. } function GetVertScrollPadding: Integer; virtual; { Specific implementation of the standard Visible property. } function GetVisible: Boolean; reintroduce; virtual; { Specific implementation of the standard Visible property. } procedure SetVisible(Value: Boolean); reintroduce; virtual; { IKMemoNotifier implementation. } function GetWordBreaks: TKSysCharSet; { IKMemoNotifier implementation. } function GetWrapSingleChars: Boolean; { IKMemoNotifier implementation. } function HasFocus: Boolean; { Hides the caret. } procedure HideEditorCaret; virtual; { Overriden method - processes virtual key strokes according to current @link(TKCustomMemo.KeyMapping). } procedure KeyDown(var Key: Word; Shift: TShiftState); override; {$IFDEF FPC} { Overriden method - processes character key strokes - data editing. } procedure UTF8KeyPress(var Key: TUTF8Char); override; {$ELSE} { Overriden method - processes character key strokes - data editing. } procedure KeyPress(var Key: Char); override; {$ENDIF} { Overriden method - processes virtual key strokes. } procedure KeyUp(var Key: Word; Shift: TShiftState); override; { Responds to PostLateUpdate. } procedure LateUpdate(var Msg: TLMessage); override; { Update the editor after list table changes. } procedure ListChanged(AList: TKMemoList; ALevel: TKMemoListLevel); virtual; { Updates information about printed shape. } procedure MeasurePages(var Info: TKPrintMeasureInfo); override; { Overriden method - updates caret position/selection. } procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; { Overriden method - updates caret position/selection and initializes scrolling when needed. } procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; { Overriden method - releases mouse capture acquired by MouseDown. } procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; { Ends block dragging. } procedure MoveBlock; { Paints the document to specified canvas. } procedure PaintContent(ACanvas: TCanvas; const ARect: TRect; ALeftOfs, ATopOfs: Integer); { Paints a page to a printer/preview canvas. } procedure PaintPage; override; { Overriden method - calls PaintContent to paint the document into window client area. } procedure PaintToCanvas(ACanvas: TCanvas); override; { Reacts on default paragraph style changes and notifies all paragraph blocks. } procedure ParaStyleChanged(Sender: TObject; AReasons: TKMemoUpdateReasons); virtual; { Converts a point relative to TKMemo to a point relative to active blocks. } function PointToBlockPoint(const APoint: TPoint; ACalcActive: Boolean = True): TPoint; virtual; { Make the blocks ready for normal work. } procedure PrepareToPaint(ACanvas: TCanvas); virtual; { Make the blocks ready for preview or printing. } procedure PrepareToPrint(AScale: Double); virtual; { Overriden method - calls MeasureExtent to update document metrics for printing. } procedure PrintPaintBegin; override; { Overriden method - calls necessary functions to update document metrics for normal painting. } procedure PrintPaintEnd; override; { Grants the input focus to the control when possible and the control has had none before. } procedure SafeSetFocus; { Scrolls the text either horizontally by DeltaHorz scroll units or vertically by DeltaVert scroll units (lines) or in both directions. CodeHorz and CodeVert are the codes coming from WM_HSCROLL or WM_VSCROLL messages. } function Scroll(CodeHorz, CodeVert, DeltaHorz, DeltaVert: Integer; ACallScrollWindow: Boolean): Boolean; { Determines if a cell specified by ACol and ARow should be scrolled, i.e. is not fully visible. } function ScrollNeeded(AMousePos: PPoint; out DeltaCol, DeltaRow: Integer): Boolean; virtual; { Scrolls the memo so that caret will be in the center of client area. } procedure ScrollToClientAreaCenter; { Expands the current selection and performs all necessary adjustments. } procedure SelectionExpand(ASelEnd: TKMemoSelectionIndex; ADoScroll: Boolean = True; APosition: TKMemoLinePosition = eolInside); overload; virtual; { Expands the current selection and performs all necessary adjustments. } procedure SelectionExpand(const APoint: TPoint; ADoScroll: Boolean = True); overload; virtual; { Initializes the current selection and performs all necessary adjustments. } procedure SelectionInit(ASelStart: TKMemoSelectionIndex; ADoScroll: Boolean = True; APosition: TKMemoLinePosition = eolInside); overload; virtual; { Initializes the current selection and performs all necessary adjustments. } procedure SelectionInit(const APoint: TPoint; ADoScroll: Boolean = True); overload; virtual; { IKMemoNotifier implementation. } function SelectBlock(ABlock: TKMemoBlock; APosition: TKSizingGripPosition): Boolean; { IKMemoNotifier implementation. } procedure SetReqMouseCursor(ACursor: TCursor); { Updates mouse cursor according to the state determined from current mouse position. Returns True if cursor has been changed. } function SetMouseCursor(X, Y: Integer): Boolean; override; { Shows the caret. } procedure ShowEditorCaret; virtual; { Returns the rectangle for dragging/resizing a block, in coordinates relative to the memo. } function SizingRect(ABlock: TKMemoBlock): TRect; { Reacts on default text style changes and notifies all text blocks. } procedure TextStyleChanged(Sender: TObject); virtual; { Calls the @link(TKCustomMemo.DoChange) method. } procedure UndoChange(Sender: TObject; ItemKind: TKMemoChangeKind); { Updates caret position, shows/hides caret according to the input focus
    Parameters:
  • AShow - set to True to show the caret
} procedure UpdateEditorCaret(AShow: Boolean = True); virtual; { Update the mouse cursor. } procedure UpdateMouseCursor; virtual; { Update the preferred caret horizontal position. } procedure UpdatePreferredCaretPos; virtual; { Updates the scrolling range. } procedure UpdateScrollRange(CallInvalidate: Boolean); virtual; { Updates the grid size. } procedure UpdateSize; override; { Redo list manager - made accessible for descendant classes. } property RedoList: TKMemoChangeList read FRedoList; { States of this class - made accessible for descendant classes. } property States: TKMemoStates read FStates write FStates; { Undo list manager - made accessible for descendant classes. } property UndoList: TKMemoChangeList read FUndoList; public { Performs necessary initializations - default values to properties, create undo/redo list managers. } constructor Create(AOwner: TComponent); override; { Destroy instance, undo/redo list managers, dispose buffer... } destructor Destroy; override; { Takes property values from another TKCustomMemo class. } procedure Assign(Source: TPersistent); override; { Returns innermost block at given position. } function BlockAt(APos: TPoint): TKMemoBlock; { Returns block bounding rectangle in coordinates relative to the memo. } function BlockRect(ABlock: TKMemoBlock): TRect; { Determines whether the caret is visible. } function CaretInView: Boolean; virtual; { Forces the caret position to become visible. } function ClampInView(AMousePos: PPoint; ACallScrollWindow: Boolean): Boolean; virtual; { Clears all blocks. Unlike @link(ecClearAll) clears everything inclusive undo a redo lists. } procedure Clear(AKeepOnePara: Boolean = True); { Deletes blocks or parts of blocks corresponding to the active selection.
    Parameters:
  • ATextOnly - don't clear containers if True
} procedure ClearSelection(ATextOnly: Boolean = True); virtual; { Clears undo (and redo) list. } procedure ClearUndo; { Determines whether given command can be executed at this time. Use this function in TAction.OnUpdate events.
    Parameters:
  • Command - specifies the command to inspect
} function CommandEnabled(Command: TKEditCommand): Boolean; virtual; { Delete all characters from beginning of line to position given by At. } procedure DeleteBOL(At: TKMemoSelectionIndex); { Delete character at position At (Delete key). } procedure DeleteChar(At: TKMemoSelectionIndex); virtual; { Delete all characters from position given by At to the end of line. } procedure DeleteEOL(At: TKMemoSelectionIndex); { Delete character before position At (Backspace key). } procedure DeleteLastChar(At: TKMemoSelectionIndex); virtual; { Delete whole line at position At. } procedure DeleteLine(At: TKMemoSelectionIndex); { Delete block previously selected with @link(TKCustomMemo.SelectBlock), if any. } procedure DeleteSelectedBlock; virtual; { Executes given command. This function first calls CommandEnabled to assure given command can be executed.
    Parameters:
  • Command - specifies the command to execute
  • Data - specifies the data needed for the command
} function ExecuteCommand(Command: TKEditCommand; Data: Pointer = nil): Boolean; virtual; { Returns current maximum value for the @link(TKCustomMemo.LeftPos) property. } function GetMaxLeftPos: Integer; virtual; { Returns current maximum value for the @link(TKCustomMemo.TopPos) property. } function GetMaxTopPos: Integer; virtual; { Returns indexes corresponding to the word at position AIndex. } function GetNearestWordIndexes(AIndex: TKMemoSelectionIndex; AIncludeWhiteSpaces: Boolean; out AStartIndex, AEndIndex: TKMemoSelectionIndex): Boolean; { Converts a text buffer index into client area rectangle.
    Parameters:
  • AValue - index to convert
  • ACaret - return caret rectangle
} function IndexToRect(AValue: TKMemoSelectionIndex; ACaret: Boolean): TRect; virtual; { Inserts a character at specified position.
    Parameters:
  • At - position where the character should be inserted.
  • AValue - character
} procedure InsertChar(At: TKMemoSelectionIndex; const AValue: TKChar); virtual; { Inserts new line at specified position.
    Parameters:
  • At - position where the new line should be inserted.
} procedure InsertNewLine(At: TKMemoSelectionIndex); virtual; { Inserts a string at specified position.
    Parameters:
  • At - position where the string should be inserted.
  • AValue - inserted string
} procedure InsertString(At: TKMemoSelectionIndex; const AValue: TKString); virtual; { Load contents from a file. Chooses format automatically by extension. Text file is default format. } procedure LoadFromFile(const AFileName: TKString); virtual; { Load contents from a RTF file. } procedure LoadFromRTF(const AFileName: TKString); virtual; { Load contents from a RTF stream. } procedure LoadFromRTFStream(AStream: TStream; AtIndex: TKMemoSelectionIndex = -1); virtual; { Load contents from a plain text file. } procedure LoadFromTXT(const AFileName: TKString); virtual; { Load contents from a plain text stream. } procedure LoadFromTXTStream(AStream: TStream); virtual; { Moves the caret nearest to current mouse position. } procedure MoveCaretToMouseCursor(AIfOutsideOfSelection: Boolean); { Converts client area coordinates into a text buffer index.
    Parameters:
  • APoint - window client area coordinates
  • AOutOfArea - set to True to compute selection even if the the supplied coordinates are outside of the text space
} function PointToIndex(APoint: TPoint; AOutOfArea, ASelectionExpanding: Boolean; out ALinePos: TKMemoLinePosition): TKMemoSelectionIndex; virtual; { Converts horizontal pixels to points. } function Px2PtX(AValue: Integer): Double; virtual; { Converts vertical pixels to points. } function Px2PtY(AValue: Integer): Double; virtual; { Converts points to horizontal pixels. } function Pt2PxX(AValue: Double): Integer; virtual; { Converts points to vertical pixels. } function Pt2PxY(AValue: Double): Integer; virtual; { Save contents to a file. Chooses format automatically by extension. Text file is default format. } procedure SaveToFile(const AFileName: TKString; ASelectedOnly: Boolean = False); virtual; { Save contents to a RTF file. } procedure SaveToRTF(const AFileName: TKString; ASelectedOnly: Boolean = False; AReadableOutput: Boolean = False); virtual; { Save contents to a RTF stream. } procedure SaveToRTFStream(AStream: TStream; ASelectedOnly: Boolean = False; AReadableOutput: Boolean = False); virtual; { Save contents to a plain text file. } procedure SaveToTXT(const AFileName: TKString; ASelectedOnly: Boolean = False); virtual; { Scrolls the memo window horizontaly by DeltaHorz scroll units and/or vertically by DeltaVert scroll units (lines). } function ScrollBy(DeltaHorz, DeltaVert: Integer; ACallScrollWindow: Boolean): Boolean; reintroduce; virtual; { Specifies the current selection. This is faster than combination of SelStart and SelLength. } procedure Select(ASelStart, ASelLength: TKMemoSelectionIndex; ADoScroll: Boolean = True); virtual; { Activates relative or absolute positioned container nearest to APoint. The container blocks will be accessible through ActiveBlocks. } procedure SetActiveBlocksForPoint(const APoint: TPoint); virtual; { Specifies paragraph style for given range. Does not select the range. } procedure SetRangeParaStyle(AFrom, ATo: TKMemoSelectionIndex; AStyle: TKMemoParaStyle); virtual; { Specifies text style for given range. Does not select the range. } procedure SetRangeTextStyle(AFrom, ATo: TKMemoSelectionIndex; AStyle: TKMemoTextStyle); virtual; { Prepare to insert a new block at given position. Returns requested block index. } function SplitAt(AIndex: TKMemoSelectionIndex): TKMemoBlockIndex; virtual; { Gives access to active memo block (the outermost block at caret position within ActiveBlocks). } property ActiveBlock: TKMemoBlock read GetActiveBlock; { Gives access to innermost active memo block (the innermost block at caret position within ActiveBlocks). } property ActiveInnerBlock: TKMemoBlock read GetActiveInnerBlock; { Gives access to active memo blocks - containers of texts, images etc.. ActiveBlocks might be different from Blocks when editing the embedded text box etc. } property ActiveBlocks: TKMemoBlocks read FActiveBlocks write SetActiveBlocks; { Gives access to innermost active memo blocks - containers of texts, images etc.. ActiveInnerBlocks might be different from ActiveBlocks when inside of a table etc. } property ActiveInnerBlocks: TKMemoBlocks read GetActiveInnerBlocks; { Gives access to memo blocks - containers of texts, images etc.. } property Blocks: TKMemoBlocks read FBlocks; { Main window background. } property Background: TKMemoBackground read FBackground write SetBackground; { Returns current caret position = selection end. } property CaretPos: TKMemoSelectionIndex read GetSelEnd; { Returns caret rectangle in pixels. } property CaretRect: TRect read GetCaretRect; { Returns True if caret is visible. } property CaretVisible: Boolean read GetCaretVisible; { Makes it possible to take all color properties from another TKCustomMemo class. } property Colors: TKMemoColors read FColors write SetColors; { Specifies the padding around the memo contents. } property ContentPadding: TKRect read FContentPadding write SetContentPadding; { Returns height of the memo contents. } property ContentHeight: Integer read GetContentHeight; { Returns the left position of the memo contents. } property ContentLeft: Integer read GetContentLeft; { Returns the bounding rectangle of the memo contents. } property ContentRect: TRect read GetContentRect; { Returns the top position of the memo contents. } property ContentTop: Integer read GetContentTop; { Returns width of the memo contents. } property ContentWidth: Integer read GetContentWidth; { Specifies the style how the outline is drawn when editor is disabled. } property DisabledDrawStyle: TKEditDisabledDrawStyle read FDisabledDrawStyle write SetDisabledDrawStyle default cEditDisabledDrawStyleDef; { Returns True if text buffer is empty. } property Empty: Boolean read GetEmpty; { Returns horizontal scroll padding - relative to client width. } property HorzScrollPadding: Integer read GetHorzScrollPadding; { Returns True if insert mode is on. } property InsertMode: Boolean read GetInsertMode; { Specifies the current key stroke mapping scheme. } property KeyMapping: TKEditKeyMapping read FKeyMapping; { Specifies the horizontal scroll position. } property LeftPos: Integer read FLeftPos write SetLeftPos; { Returns the numbering list table. } property ListTable: TKMemoListTable read FListTable; { Specifies the maximum allowed nonbreakable word length. } property MaxWordLength: TKMemoSelectionIndex read FMaxWordLength write SetMaxWordLength default cMaxWordLengthDef; { Returns True if the buffer was modified - @link(eoUndoAfterSave) taken into account. } property Modified: Boolean read GetModified write SetModified; { Returns nearest paragraph to caret location. } property NearestParagraph: TKMemoParagraph read GetNearestParagraph; { Returns block index of nearest paragraph to caret location. } property NearestParagraphIndex: TKMemoBlockIndex read GetNearestParagraphIndex; { Specifies text style for newly entered character. } property NewTextStyle: TKMemoTextStyle read FNewTextStyle write SetNewTextStyle; { Indicates that style for newly entered text is valid and will be used for next character. } property NewTextStyleValid: Boolean read FNewTextStyleValid; { Specifies the editor options that do not affect painting. } property Options: TKEditOptions read FOptions write SetOptions stored IsOptionsStored; { Specifies default style for paragraphs. } property ParaStyle: TKMemoParaStyle read FParaStyle; { Specifies whether the editor has to be read only editor. } property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False; { Returns "real" selection end - with always higher index value than selection start value. } property RealSelEnd: TKMemoSelectionIndex read GetRealSelEnd; { Returns "real" selection lenth - always non-negative number. } property RealSelLength: TKMemoSelectionIndex read GetRealSelLength; { Returns "real" selection start - with always lower index value than selection end value. } property RealSelStart: TKMemoSelectionIndex read GetRealSelStart; { Returns true when a relative or absolute positioned block is selected. } property RelativeSelected: Boolean read GetRelativeSelected; { Specifies the required content width. } property RequiredContentWidth: Integer read GetRequiredContentWidth write SetRequiredContentWidth; { Allows to save and load the memo contents to/from RTF string.} property RTF: TKMemoRTFString read GetRTF write SetRTF; { Defines visible scrollbars - horizontal, vertical or both. } property ScrollBars: TScrollStyle read FScrollBars write SetScrollBars default ssBoth; { Specifies how fast the scrolling by timer should be. } property ScrollSpeed: Cardinal read FScrollSpeed write SetScrollSpeed default cScrollSpeedDef; { Specifies the padding in pixels to overscroll to show caret position or selection end. } property ScrollPadding: Integer read FScrollPadding write SetScrollPadding default cScrollPaddingDef; { Determines whether a selection is available. } property SelAvail: Boolean read GetSelAvail; { Returns selectable length. } property SelectableLength: TKMemoSelectionIndex read GetSelectableLength; { Returns block previously selected with @link(TKCustomMemo.SelectBlock). } property SelectedBlock: TKMemoBlock read FSelectedBlock; { Determines whether a selection contains a paragraph. } property SelectionHasPara: Boolean read GetSelectionHasPara; { Specifies paragraph style for active selection. } property SelectionParaStyle: TKMemoParaStyle read GetSelectionParaStyle write SetSelectionParaStyle; { Specifies text style for active selection. } property SelectionTextStyle: TKMemoTextStyle read GetSelectionTextStyle write SetSelectionTextStyle; { Specifies the current selection end. } property SelEnd: TKMemoSelectionIndex read GetSelEnd write SetSelEnd; { Specifies the current selection length. SelStart remains unchanged, SelEnd will be updated accordingly. To mark a selection, either set both SelStart and SelEnd properties or both SelStart and SelLength properties. } property SelLength: TKMemoSelectionIndex read GetSelLength write SetSelLength; { Specifies the current selection start. } property SelStart: TKMemoSelectionIndex read GetSelStart write SetSelStart; { Returns selected text. } property SelText: TKString read GetSelText; { If read, returns the textual part of the contents as a whole. If written, replace previous contents by a new one. } property Text: TKString read GetText write SetText; { Specifies default style for text. } property TextStyle: TKMemoTextStyle read FTextStyle; { Specifies the vertical scroll position. } property TopPos: Integer read FTopPos write SetTopPos; { Specifies the maximum number of undo items. Please note this value affects the undo item limit, not undo group limit. } property UndoLimit: Integer read GetUndoLimit write SetUndoLimit default cUndoLimitDef; { Returns vertical scroll padding - relative to client height. } property VertScrollPadding: Integer read GetVertScrollPadding; { Inherited property - see Delphi help. } property Visible: Boolean read GetVisible write SetVisible; { Defines the characters that will be used to split text to breakable words. } property WordBreaks: TKSysCharSet read FWordBreaks write SetWordBreaks; { When assigned, this event will be invoked at each change made to the text buffer either by the user or programmatically by public functions. } property OnChange: TNotifyEvent read FOnChange write FOnChange; { When assigned, this event will be invoked when the user drops any files onto the window. } property OnDropFiles: TKEditDropFilesEvent read FOnDropFiles write FOnDropFiles; { When assigned, this event will be invoked if a block has been clicked with left mouse button in KMemo. Click is called upon releasing the left mouse button for first time. } property OnBlockClick: TKMemoBlockNotifyEvent read FOnBlockClick write FOnBlockClick; { When assigned, this event will be invoked if a block has been double clicked with left mouse button in KMemo. Double click is called upon pressing the left mouse button for second time. } property OnBlockDblClick: TKMemoBlockNotifyEvent read FOnBlockDblClick write FOnBlockDblClick; { When assigned, this event will be invoked if some internal event in KMemo needs to edit a block externally. } property OnBlockEdit: TKMemoBlockNotifyEvent read FOnBlockEdit write FOnBlockEdit; { When assigned, this event will be invoked at each prompt-forced search match. } property OnReplaceText: TKEditReplaceTextEvent read FOnReplaceText write FOnReplaceText; end; { @abstract(Memo design-time component) } TKMemo = class(TKCustomMemo) published { Inherited property - see Delphi help. } property Align; { Inherited property - see Delphi help. } property Anchors; { See TKCustomMemo.@link(TKCustomMemo.Background) for details. } property Background; { See TKCustomControl.@link(TKCustomControl.BorderStyle) for details. } property BorderStyle; { Inherited property - see Delphi help. } property BorderWidth; { See TKCustomMemo.@link(TKCustomMemo.Colors) for details. } property Colors; { Inherited property - see Delphi help. } property Constraints; { See TKCustomMemo.@link(TKCustomMemo.ContentPadding) for details. } property ContentPadding; {$IFNDEF FPC} { Inherited property - see Delphi help. } property Ctl3D; {$ENDIF} { See TKCustomMemo.@link(TKCustomMemo.DisabledDrawStyle) for details. } property DisabledDrawStyle; { Inherited property - see Delphi help. } property DragCursor; { Inherited property - see Delphi help. } property DragKind; { Inherited property - see Delphi help. } property DragMode; { Inherited property - see Delphi help. } property Enabled; { Inherited property - see Delphi help. Font pitch must always remain fpFixed - specify fixed fonts only. Font.Size will also be trimmed if too small or big. } property Font; { Inherited property - see Delphi help. } property Height default cHeight; { See TKCustomMemo.@link(TKCustomMemo.Options) for details. } property Options; { Inherited property - see Delphi help. } property ParentFont; { Inherited property - see Delphi help. } property ParentShowHint; { Inherited property - see Delphi help. } property PopupMenu; { See TKCustomMemo.@link(TKCustomMemo.ReadOnly) for details. } property ReadOnly; { See TKCustomMemo.@link(TKCustomMemo.ScrollBars) for details. } property ScrollBars; { See TKCustomMemo.@link(TKCustomMemo.ScrollPadding) for details. } property ScrollPadding; { See TKCustomMemo.@link(TKCustomMemo.ScrollSpeed) for details. } property ScrollSpeed; { Inherited property - see Delphi help. } property ShowHint; { Inherited property - see Delphi help. } property TabOrder; { Inherited property - see Delphi help. } property TabStop default True; { See TKCustomMemo.@link(TKCustomMemo.UndoLimit) for details. } property UndoLimit; { Inherited property - see Delphi help. } property Visible; { Inherited property - see Delphi help. } property Width default cWidth; { See TKCustomMemo.@link(TKCustomMemo.OnChange) for details. } property OnChange; { See TKCustomMemo.@link(TKCustomMemo.OnBlockClick) for details. } property OnBlockClick; { See TKCustomMemo.@link(TKCustomMemo.OnBlockDblClick) for details. } property OnBlockDblClick; { See TKCustomMemo.@link(TKCustomMemo.OnBlockEdit) for details. } property OnBlockEdit; { Inherited property - see Delphi help. } property OnClick; { Inherited property - see Delphi help. } property OnContextPopup; { Inherited property - see Delphi help. } property OnDblClick; { Inherited property - see Delphi help. } property OnDockDrop; { Inherited property - see Delphi help. } property OnDockOver; { Inherited property - see Delphi help. } property OnDragDrop; { Inherited property - see Delphi help. } property OnDragOver; { See TKCustomMemo.@link(TKCustomMemo.OnDropFiles) for details. } property OnDropFiles; { Inherited property - see Delphi help. } property OnEndDock; { Inherited property - see Delphi help. } property OnEndDrag; { Inherited property - see Delphi help. } property OnEnter; { Inherited property - see Delphi help. } property OnExit; { Inherited property - see Delphi help. } property OnGetSiteInfo; { Inherited property - see Delphi help. } property OnKeyDown; { Inherited property - see Delphi help. } property OnKeyPress; { Inherited property - see Delphi help. } property OnKeyUp; { Inherited property - see Delphi help. } property OnMouseDown; {$IFDEF COMPILER9_UP} { Inherited property - see Delphi help. } property OnMouseEnter; { Inherited property - see Delphi help. } property OnMouseLeave; {$ENDIF} { Inherited property - see Delphi help. } property OnMouseMove; { Inherited property - see Delphi help. } property OnMouseUp; { Inherited property - see Delphi help. } property OnMouseWheel; { Inherited property - see Delphi help. } property OnMouseWheelDown; { Inherited property - see Delphi help. } property OnMouseWheelUp; { See TKCustomMemo.@link(TKCustomMemo.OnReplaceText) for details. } property OnReplaceText; { Inherited property - see Delphi help. } property OnResize; { Inherited property - see Delphi help. } property OnStartDock; { Inherited property - see Delphi help. } property OnStartDrag; { Inherited property - see Delphi help. } property OnUnDock; end; { Base class for standard actions targeting TKMemo. } TKMemoEditAction = class(TAction) protected function GetEditCommand: TKEditCommand; virtual; abstract; public function HandlesTarget(Target: TObject): Boolean; override; procedure UpdateTarget(Target: TObject); override; procedure ExecuteTarget(Target: TObject); override; end; TKMemoEditCopyAction = class(TKMemoEditAction) protected function GetEditCommand: TKEditCommand; override; end; TKMemoEditCutAction = class(TKMemoEditAction) protected function GetEditCommand: TKEditCommand; override; end; TKMemoEditPasteAction = class(TKMemoEditAction) protected function GetEditCommand: TKEditCommand; override; end; TKMemoEditSelectAllAction = class(TKMemoEditAction) protected function GetEditCommand: TKEditCommand; override; end; function NewLineChar: TKString; function SpaceChar: TKString; function TabChar: TKString; implementation uses {$IFDEF MSWINDOWS} ShellApi, {$ENDIF} ClipBrd, Printers, {$IFDEF USE_THEMES} Themes, {$ENDIF} Math, KMemoRTF; {$IFDEF MSWINDOWS} // this is better declaration of GetKerningPairs than in Windows.pas type TKerningPair = packed record wFirst: Word; wSecond: Word; iKernAmount: Integer; end; TKerningPairs = array[0..MaxInt div SizeOf(TKerningPair) - 1] of TKerningPair; PKerningPairs = ^TKerningPairs; function GetKerningPairs(DC: HDC; Count: DWORD; KerningPairs: PKerningPairs): DWORD; stdcall; external 'gdi32.dll' name 'GetKerningPairs'; {$ENDIF} procedure DefaultsToBrush(ABrush: TBrush); begin ABrush.Color := clWindow; ABrush.Style := bsClear; end; procedure DefaultsToFont(AFont: TFont); begin AFont.Name := 'Arial'; AFont.Charset := DEFAULT_CHARSET; AFont.Color := clWindowText; AFont.Size := 10; AFont.Style := []; end; function OppositeKind(ItemKind: TKMemoChangeKind): TKMemoChangeKind; begin case ItemKind of ckDelete: Result := ckInsert; ckInsert: Result := ckDelete; else Result := ItemKind; end; end; function NewLineChar: TKString; begin Result := UnicodeToNativeUTF(cNewlineChar); end; function SpaceChar: TKString; begin Result := UnicodeToNativeUTF(cSpaceChar); end; function TabChar: TKString; begin Result := UnicodeToNativeUTF(cTabChar); end; { TKMemoIndexObject } procedure TKMemoIndexObject.Assign(ASource: TKObject); begin if ASource is TKMemoIndexObject then FIndex := TKMemoIndexObject(ASource).Index; end; constructor TKMemoIndexObject.Create; begin inherited; FIndex := 0; end; function TKMemoIndexObject.EqualProperties(ASource: TKObject): Boolean; begin if ASource is TKMemoIndexObject then Result := (FIndex = TKMemoIndexObject(ASource).Index) else Result := False; end; { TKMemoIndexObjectList } procedure TKMemoIndexObjectList.AddItem(AValue: Integer); var Item: TKMemoIndexObject; begin Item := TKMemoIndexObject.Create; Item.Index := AValue; Add(Item); end; function TKMemoIndexObjectList.GetItem(Index: Integer): TKMemoIndexObject; begin Result := TKMemoIndexObject(inherited GetItem(Index)); end; procedure TKMemoIndexObjectList.SetItem(Index: Integer; const Value: TKMemoIndexObject); begin inherited SetItem(Index, Value); end; procedure TKMemoIndexObjectList.SetSize(ACount: Integer); var I: Integer; begin if ACount <> Count then begin if ACount > Count then begin for I := Count to ACount - 1 do AddItem(0); end else begin for I := ACount to Count - 1 do Delete(ACount); end; end; end; { TKMemoIndexObjectStack } function TKMemoIndexObjectStack.Peek: TKMemoIndexObject; begin Result := TKMemoIndexObject(inherited Peek); end; function TKMemoIndexObjectStack.Pop: TKMemoIndexObject; begin Result := TKMemoIndexObject(inherited Pop); end; function TKMemoIndexObjectStack.PopValue: Integer; var Item: TKMemoIndexObject; begin if Peek <> nil then begin Item := Pop; Result := Item.Index; Item.Free; end else Result := 0; end; function TKMemoIndexObjectStack.Push(AObject: TKMemoIndexObject): TKMemoIndexObject; begin Result := TKMemoIndexObject(inherited Push(AObject)); end; procedure TKMemoIndexObjectStack.PushValue(Value: Integer); var Item: TKMemoIndexObject; begin Item := TKMemoIndexObject.Create; Item.Index := Value; Push(Item); end; { TKMemoDictionaryItem } constructor TKMemoDictionaryItem.Create; begin inherited; FIndex := 0; FValue := 0; end; procedure TKMemoDictionaryItem.Assign(ASource: TKObject); begin if ASource is TKMemoDictionaryItem then begin FIndex := TKMemoDictionaryItem(ASource).Index; FValue := TKMemoDictionaryItem(ASource).Value; end; end; function TKMemoDictionaryItem.EqualProperties(ASource: TKObject): Boolean; begin if ASource is TKMemoDictionaryItem then Result := (FIndex = TKMemoDictionaryItem(ASource).Index) and (FValue = TKMemoDictionaryItem(ASource).Value) else Result := False; end; { TKMemoDictionary } procedure TKMemoDictionary.AddItem(AIndex, AValue: Integer); var Item: TKMemoDictionaryItem; begin Item := TKMemoDictionaryItem.Create; Item.Index := AIndex; Item.Value := AValue; Add(Item); end; function TKMemoDictionary.FindItem(AIndex: Integer): TKMemoDictionaryItem; var I: Integer; begin // this is slow index based search but we don't need fast hash table here Result := nil; for I := 0 to Count - 1 do if Items[I].Index = AIndex then begin Result := Items[I]; Break; end; end; function TKMemoDictionary.GetValue(AIndex, ADefault: Integer): Integer; var Item: TKMemoDictionaryItem; begin Item := FindItem(AIndex); if Item <> nil then Result := Item.Value else Result := ADefault; end; function TKMemoDictionary.GetItem(Index: Integer): TKMemoDictionaryItem; begin Result := TKMemoDictionaryItem(inherited GetItem(Index)); end; procedure TKMemoDictionary.SetItem(Index: Integer; const Value: TKMemoDictionaryItem); begin inherited SetItem(Index, Value); end; procedure TKMemoDictionary.SetValue(AIndex, AValue: Integer); var Item: TKMemoDictionaryItem; begin Item := FindItem(AIndex); if Item <> nil then Item.Value := AValue else AddItem(AIndex, AValue); end; { TKMemoNumberingFormatItem } procedure TKMemoNumberingFormatItem.Assign(ASource: TKObject); begin if ASource is TKMemoNumberingFormatItem then begin FLevel := TKMemoNumberingFormatItem(ASource).Level; FText := TKMemoNumberingFormatItem(ASource).Text; end; end; constructor TKMemoNumberingFormatItem.Create; begin inherited; FLevel := -1; FText := ''; end; { TKMemoNumberingFormat } procedure TKMemoNumberingFormat.AddItem(ALevel: Integer; const AText: TKString); var Item: TKMemoNumberingFormatItem; begin Item := TKMemoNumberingFormatItem.Create; Item.Level := ALevel; Item.Text := AText; Add(Item); end; procedure TKMemoNumberingFormat.Defaults(ANumbering: TKMemoParaNumbering; ALevelIndex: Integer); var I: Integer; begin Clear; case ANumbering of pnuBullets: begin AddItem(-1, UnicodeToNativeUTF(cRoundBullet)); end; pnuArrowTwoBullets: begin AddItem(-1, UnicodeToNativeUTF(cArrowTwoBullet)); end; pnuArrowOneBullets: begin AddItem(-1, UnicodeToNativeUTF(cArrowOneBullet)); end; pnuCircleBullets: begin AddItem(-1, UnicodeToNativeUTF(cCircleBullet)); end; pnuTriangleBullets: begin AddItem(-1, UnicodeToNativeUTF(cTriangleBullet)); end; pnuArabic, pnuLetterLo, pnuLetterHi, pnuRomanLo, pnuRomanHi: begin for I := 0 to ALevelIndex do begin AddItem(I, ''); AddItem(-1, '.'); end; end; end; end; function TKMemoNumberingFormat.GetItem(Index: Integer): TKMemoNumberingFormatItem; begin Result := TKMemoNumberingFormatItem(inherited GetItem(Index)); end; function TKMemoNumberingFormat.GetLevelCount: Integer; var I: Integer; begin Result := 0; for I := 0 to Count - 1 do if (Items[I].Level >= 0) and (Items[I].Text = '') then Inc(Result); end; procedure TKMemoNumberingFormat.InsertItem(AAt, ALevel: Integer; const AText: TKString); var Item: TKMemoNumberingFormatItem; begin Item := TKMemoNumberingFormatItem.Create; Item.Level := ALevel; Item.Text := AText; Insert(AAt, Item); end; procedure TKMemoNumberingFormat.SetItem(Index: Integer; const Value: TKMemoNumberingFormatItem); begin inherited SetItem(Index, Value); end; { TKMemoListLevel } constructor TKMemoListLevel.Create; begin inherited; FFirstIndent := 0; FLeftIndent := 0; FNumberingFont := TFont.Create; DefaultsToFont(FNumberingFont); FNumberingFont.OnChange := FontChanged; FNumberingFontChanged := False; FNumberingFormat := TKMemoNumberingFormat.Create; FNumberingFormat.Defaults(pnuNone, 0); FNumberStartAt := 1; FLevelCounter := FNumberStartAt - 1; end; destructor TKMemoListLevel.Destroy; begin FNumberingFont.Free; FNumberingFormat.Free; inherited; end; procedure TKMemoListLevel.Assign(ASource: TKObject); begin if ASource is TKMemoListLevel then begin FirstIndent := TKMemoListLevel(ASource).FirstIndent; LeftIndent := TKMemoListLevel(ASource).LeftIndent; Numbering := TKMemoListLevel(ASource).Numbering; NumberingFont.Assign(TKMemoListLevel(ASource).NumberingFont); FNumberingFontChanged := TKMemoListLevel(ASource).NumberingFontChanged; NumberingFormat.Assign(TKMemoListLevel(ASource).NumberingFormat); NumberStartAt := TKMemoListLevel(ASource).NumberStartAt; end; end; procedure TKMemoListLevel.Changed; begin if Parent <> nil then TKMemoListLevels(Parent).Changed(Self); end; procedure TKMemoListLevel.FontChanged(Sender: TObject); begin FNumberingFontChanged := True; end; procedure TKMemoListLevel.SetFirstIndent(const Value: Integer); begin if Value <> FFirstIndent then begin FFirstIndent := Value; Changed; end; end; procedure TKMemoListLevel.SetLeftPadding(const Value: Integer); begin if Value <> FLeftIndent then begin FLeftIndent := Value; Changed; end; end; procedure TKMemoListLevel.SetNumbering(const Value: TKMemoParaNumbering); var LevelIndex: Integer; begin if Value <> FNumbering then begin FNumbering := Value; if Parent <> nil then LevelIndex := Parent.IndexOf(Self) else Levelindex := 0; FNumberingFormat.Defaults(Value, LevelIndex); Changed; end; end; procedure TKMemoListLevel.SetNumberStartAt(const Value: Integer); begin if Value <> FNumberStartAt then begin FNumberStartAt := Value; FLevelCounter := FNumberStartAt - 1; Changed; end; end; { TKMemoListLevels } constructor TKMemoListLevels.Create; begin inherited; FParent := nil; end; procedure TKMemoListLevels.Changed(ALevel: TKMemoListLevel); begin if FParent <> nil then FParent.LevelChanged(ALevel); end; procedure TKMemoListLevels.ClearLevelCounters(AFromLevel: Integer); var I: Integer; begin for I := AFromLevel to Count - 1 do Items[I].LevelCounter := Items[I].NumberStartAt - 1; end; function TKMemoListLevels.GetItem(Index: Integer): TKMemoListLevel; begin Result := TKMemoListLevel(inherited GetItem(Index)); end; procedure TKMemoListLevels.SetItem(Index: Integer; const Value: TKMemoListLevel); begin inherited SetItem(Index, Value); end; { TKMemoList } constructor TKMemoList.Create; begin inherited; FLevels := TKMemoListLevels.Create; FLevels.Parent := Self; end; destructor TKMemoList.Destroy; begin FLevels.Free; inherited; end; procedure TKMemoList.Assign(ASource: TKObject); begin if ASource is TKMemoList then begin ID := TKMemoList(ASource).ID; Levels.Assign(TKMemoList(ASource).Levels); end; end; procedure TKMemoList.LevelChanged(ALevel: TKMemoListLevel); begin if Parent <> nil then TKMemoListTable(Parent).ListChanged(Self, ALevel); end; procedure TKMemoList.ParentChanged; begin if Parent <> nil then FID := TKMemoListTable(Parent).NextID else FID := Random(MaxInt); end; { TKMemoListTable } constructor TKMemoListTable.Create; begin inherited; FCallUpdate := False; FOnChanged := nil; end; procedure TKMemoListTable.CallAfterUpdate; begin if FCallUpdate then DoChanged(nil, nil); end; procedure TKMemoListTable.CallBeforeUpdate; begin FCallUpdate := False; end; procedure TKMemoListTable.ClearLevelCounters; var I: Integer; begin for I := 0 to Count - 1 do Items[I].Levels.ClearLevelCounters(0); end; procedure TKMemoListTable.DoChanged(AList: TKMemoList; ALevel: TKMemoListLevel); begin if Assigned(FOnChanged) then FOnChanged(AList, ALevel); end; function TKMemoListTable.FindByID(AListID: Integer): TKMemoList; var I: Integer; begin Result := nil; for I := 0 to Count - 1 do if Items[I].ID = AListID then begin Result := Items[I]; Break; end; end; function TKMemoListTable.GetItem(Index: Integer): TKMemoList; begin Result := TKMemoList(inherited GetItem(Index)); end; procedure TKMemoListTable.ListChanged(AList: TKMemoList; ALevel: TKMemoListLevel); begin if UpdateUnlocked then DoChanged(AList, ALevel) else FCallUpdate := True; end; function TKMemoListTable.ListByNumbering(AListID, ALevelIndex: Integer; ANumbering: TKMemoParaNumbering): TKMemoList; var I, J: Integer; List: TKMemoList; ListLevel: TKMemoListLevel; begin Result := nil; if ANumbering <> pnuNone then begin ALevelIndex := Max(ALevelIndex, 0); // search for existing list List := FindByID(AListID); if List <> nil then begin // list found, use it if ALevelIndex < List.Levels.Count then begin // level found, modify it ListLevel := List.Levels[ALevelIndex]; ListLevel.Numbering := ANumbering; end else begin // add missing levels for J := List.Levels.Count to ALevelIndex do begin ListLevel := TKMemoListLevel.Create; List.Levels.Add(ListLevel); ListLevel.Numbering := ANumbering; end; end; Result := List; end else begin // list not found, so search list table, if some list has the wanted numbering at requested level for I := 0 to Count - 1 do begin List := Items[I]; if ALevelIndex < List.Levels.Count then begin if List.Levels[ALevelIndex].Numbering = ANumbering then begin Result := List; Break; end; end else begin // use first available list and add all the missing levels for J := List.Levels.Count to ALevelIndex do begin ListLevel := TKMemoListLevel.Create; List.Levels.Add(ListLevel); ListLevel.Numbering := ANumbering; end; Result := List; Break; end; end; end; if Result = nil then begin // no suitable list found in table, so create new one List := TKMemoList.Create; for I := 0 to ALevelIndex do begin ListLevel := TKMemoListLevel.Create; List.Levels.Add(ListLevel); ListLevel.Numbering := ANumbering; end; Add(List); Result := List; end; end; end; function TKMemoListTable.NextID: Integer; var I, MaxID: Integer; begin MaxID := cInvalidListID; for I := 0 to Count - 1 do MaxID := Max(MaxID, Items[I].ID); Inc(MaxID); // assume there will never be an overflow Result := MaxID; end; procedure TKMemoListTable.SetItem(Index: Integer; const Value: TKMemoList); begin inherited SetItem(Index, Value); end; { TKMemoBackground } constructor TKMemoBackground.Create; begin inherited; FColor := clNone; FImage := TPicture.Create; FImage.OnChange := ImageChanged; FRepeatX := True; FRepeatY := True; FOnChanged := nil; end; destructor TKMemoBackground.Destroy; begin FImage.Free; inherited; end; procedure TKMemoBackground.ImageChanged(Sender: TObject); begin Changed; end; procedure TKMemoBackground.Assign(ASource: TPersistent); begin if ASource is TKMemoTextStyle then begin Color := TKMemoBackground(ASource).Color; Image.Assign(TKMemoBackground(ASource).Image); RepeatX := TKMemoBackground(ASource).RepeatX; RepeatY := TKMemoBackground(ASource).RepeatY; end; end; procedure TKMemoBackground.Clear; begin FImage.Graphic := nil; FColor := clNone; end; procedure TKMemoBackground.SetColor(const Value: TColor); begin if Value <> FColor then begin FColor := Value; Changed; end; end; procedure TKMemoBackground.SetImage(const Value: TPicture); begin FImage.Assign(Value); end; procedure TKMemoBackground.SetRepeatX(const Value: Boolean); begin if Value <> FRepeatX then begin FRepeatX := Value; Changed; end; end; procedure TKMemoBackground.SetRepeatY(const Value: Boolean); begin if Value <> FRepeatY then begin FRepeatY := Value; Changed; end; end; procedure TKMemoBackground.Update; begin inherited; if Assigned(FOnChanged) then FOnChanged(Self); end; { TKMemoTextStyle } constructor TKMemoTextStyle.Create; begin inherited; FChangeable := True; FBrush := TBrush.Create; FBrush.OnChange := BrushChanged; FFont := TFont.Create; FFont.OnChange := FontChanged; FOnChanged := nil; Defaults; end; procedure TKMemoTextStyle.Defaults; var OldState: Boolean; begin FAllowBrush := True; FCapitals := tcaNone; FScriptPosition := tpoNormal; FStyleChanged := False; OldState := Changeable; Changeable := False; try DefaultsToBrush(FBrush); DefaultsToFont(FFont); finally Changeable := OldState; end; end; destructor TKMemoTextStyle.Destroy; begin FBrush.Free; FFont.Free; inherited; end; procedure TKMemoTextStyle.Assign(ASource: TPersistent); var OldState: Boolean; begin if ASource is TKMemoTextStyle then begin OldState := Changeable; Changeable := TKMemoTextStyle(ASource).Changeable; LockUpdate; try Brush.Assign(TKMemoTextStyle(ASource).Brush); Capitals := TKMemoTextStyle(ASource).Capitals; Font.Assign(TKMemoTextStyle(ASource).Font); ScriptPosition := TKMemoTextStyle(ASource).ScriptPosition; finally Changeable := OldState; UnlockUpdate; end; end; end; procedure TKMemoTextStyle.BrushChanged(Sender: TObject); begin if UpdateUnlocked then FBrushChanged := True; PropsChanged; end; function TKMemoTextStyle.EqualProperties(ASource: TKMemoTextStyle): Boolean; begin if ASource <> nil then begin Result := (ASource.AllowBrush = AllowBrush) and (ASource.Capitals = Capitals) and (ASource.ScriptPosition = ScriptPosition) and CompareBrushes(ASource.Brush, Brush) and CompareFonts(ASource.Font, Font); end else Result := False; end; procedure TKMemoTextStyle.FontChanged(Sender: TObject); begin if UpdateUnlocked then FFontChanged := True; PropsChanged; end; procedure TKMemoTextStyle.NotifyChange(AValue: TKMemoTextStyle); begin if not FStyleChanged and UpdateUnlocked then Assign(AValue); end; procedure TKMemoTextStyle.PropsChanged; begin if Changeable then FStyleChanged := True; Changed; end; procedure TKMemoTextStyle.SetAllowBrush(const Value: Boolean); begin if Value <> FAllowBrush then begin FAllowBrush := Value; PropsChanged; end; end; procedure TKMemoTextStyle.SetBrush(const Value: TBrush); begin FBrush.Assign(Value); end; procedure TKMemoTextStyle.SetCapitals(const Value: TKMemoScriptCapitals); begin if Value <> FCapitals then begin FCapitals := Value; PropsChanged; end; end; procedure TKMemoTextStyle.SetFont(const Value: TFont); begin FFont.Assign(Value); end; procedure TKMemoTextStyle.SetScriptPosition(const Value: TKMemoScriptPosition); begin if Value <> FScriptPosition then begin FScriptPosition := Value; PropsChanged; end; end; procedure TKMemoTextStyle.Update; begin if Assigned(FOnChanged) then FOnChanged(Self); end; { TKMemoParagraphStyle } constructor TKMemoBlockStyle.Create; begin inherited; FChangeable := True; FBorderWidths := TKRect.Create; FBorderWidths.OnChanged := BrushChanged; FBrush := TBrush.Create; FBrush.OnChange := BrushChanged; FContentMargin := TKRect.Create; FContentMargin.OnChanged := BrushChanged; FContentPadding := TKRect.Create; FContentPadding.OnChanged := BrushChanged; FFillBlip := nil; FOnChanged := nil; Defaults; end; destructor TKMemoBlockStyle.Destroy; begin FBorderWidths.Free; FBrush.Free; FContentPadding.Free; FContentMargin.Free; FFillBlip.Free; inherited; end; procedure TKMemoBlockStyle.Assign(ASource: TPersistent); var OldState: Boolean; begin if ASource is TKMemoBlockStyle then begin OldState := Changeable; Changeable := TKMemoBlockStyle(ASource).Changeable; LockUpdate; try BorderColor := TKMemoBlockStyle(ASource).BorderColor; BorderRadius := TKMemoBlockStyle(ASource).BorderRadius; BorderWidth := TKMemoBlockStyle(ASource).BorderWidth; BorderWidths.Assign(TKMemoBlockStyle(ASource).BorderWidths); Brush.Assign(TKMemoBlockStyle(ASource).Brush); WrapMode := TKMemoParaStyle(ASource).WrapMode; ContentMargin.Assign(TKMemoBlockStyle(ASource).ContentMargin); ContentPadding.Assign(TKMemoBlockStyle(ASource).ContentPadding); HAlign := TKMemoParaStyle(ASource).HAlign; finally Changeable := OldState; UnlockUpdate; end; end; end; function TKMemoBlockStyle.BorderRect(const ARect: TRect): TRect; begin Result := ARect; if FBorderWidths.NonZero then begin Inc(Result.Left, FBorderWidths.Left); Inc(Result.Top, FBorderWidths.Top); Dec(Result.Right, FBorderWidths.Right); Dec(Result.Bottom, FBorderWidths.Bottom); end else InflateRect(Result, -FBorderWidth, -FBorderWidth); end; procedure TKMemoBlockStyle.BrushChanged(Sender: TObject); begin PropsChanged([muExtent]); end; procedure TKMemoBlockStyle.Defaults; begin FBorderColor := clBlack; FBorderRadius := 0; FBorderWidth := 0; FBorderWidths.All := 0; FBrush.Style := bsClear; FContentPadding.All := 0; FContentMargin.All := 0; FHAlign := halLeft; FStyleChanged := False; FWrapMode := wrAround; end; function TKMemoBlockStyle.GetAllPaddingsBottom: Integer; begin Result := BottomBorderWidth + BottomMargin + BottomPadding; end; function TKMemoBlockStyle.GetAllPaddingsLeft: Integer; begin Result := LeftBorderWidth + LeftMargin + LeftPadding; end; function TKMemoBlockStyle.GetAllPaddingsRight: Integer; begin Result := RightBorderWidth + RightMargin + RightPadding; end; function TKMemoBlockStyle.GetAllPaddingsTop: Integer; begin Result := TopBorderWidth + TopMargin + TopPadding; end; function TKMemoBlockStyle.GetBottomBorderWidth: Integer; begin Result := Max(FBorderWidths.Bottom, FBorderWidth); end; function TKMemoBlockStyle.GetBottomMargin: Integer; begin Result := FContentMargin.Bottom; end; function TKMemoBlockStyle.GetBottomPadding: Integer; begin Result := FContentPadding.Bottom; end; function TKMemoBlockStyle.GetLeftBorderWidth: Integer; begin Result := Max(FBorderWidths.Left, FBorderWidth); end; function TKMemoBlockStyle.GetLeftMargin: Integer; begin Result := FContentMargin.Left; end; function TKMemoBlockStyle.GetLeftPadding: Integer; begin Result := FContentPadding.Left; end; function TKMemoBlockStyle.GetRightBorderWidth: Integer; begin Result := Max(FBorderWidths.Right, FBorderWidth); end; function TKMemoBlockStyle.GetRightMargin: Integer; begin Result := FContentMargin.Right; end; function TKMemoBlockStyle.GetRightPadding: Integer; begin Result := FContentPadding.Right; end; function TKMemoBlockStyle.GetTopBorderWidth: Integer; begin Result := Max(FBorderWidths.Top, FBorderWidth); end; function TKMemoBlockStyle.GetTopMargin: Integer; begin Result := FContentMargin.Top; end; function TKMemoBlockStyle.GetTopPadding: Integer; begin Result := FContentPadding.Top; end; function TKMemoBlockStyle.InteriorRect(const ARect: TRect): TRect; begin Result := ARect; if FContentPadding.NonZero then begin Inc(Result.Left, FContentPadding.Left); Inc(Result.Top, FContentPadding.Top); Dec(Result.Right, FContentPadding.Right); Dec(Result.Bottom, FContentPadding.Bottom); end; end; function TKMemoBlockStyle.MarginRect(const ARect: TRect): TRect; begin Result := ARect; if FContentMargin.NonZero then begin Inc(Result.Left, FContentMargin.Left); Inc(Result.Top, FContentMargin.Top); Dec(Result.Right, FContentMargin.Right); Dec(Result.Bottom, FContentMargin.Bottom); end; end; procedure TKMemoBlockStyle.NotifyChange(AValue: TKMemoBlockStyle); begin if not FStyleChanged and UpdateUnlocked then Assign(Avalue); end; procedure TKMemoBlockStyle.PaintBox(ACanvas: TCanvas; const ARect: TRect); var R, RB: TRect; begin if (FBrush.Style <> bsClear) or (FBorderWidth > 0) or FBorderWidths.NonZero then with ACanvas do begin if FBorderWidths.NonZero or (FBorderWidth > 0) and (FBorderRadius = 0) then begin R := ARect; Pen.Style := psClear; Brush.Color := FBorderColor; Brush.Style := bsSolid; if LeftBorderWidth <> 0 then begin RB := ARect; RB.Right := RB.Left + LeftBorderWidth; R.Left := RB.Right; FillRect(RB); end; if TopBorderWidth <> 0 then begin RB := ARect; RB.Bottom := RB.Top + TopBorderWidth; R.Top := RB.Bottom; FillRect(RB); end; if RightBorderWidth <> 0 then begin RB := ARect; RB.Left := RB.Right - RightBorderWidth; R.Right := RB.Left; FillRect(RB); end; if BottomBorderWidth <> 0 then begin RB := ARect; RB.Top := RB.Bottom - BottomBorderWidth; R.Bottom := RB.Top; FillRect(RB); end; Brush.Assign(FBrush); // keep this here, some printers draw incorrectly for bsClear style if Brush.Style <> bsClear then FillRect(R); end else begin Brush.Assign(FBrush); Pen.Style := psSolid; Pen.Width := FBorderWidth; Pen.Color := FBorderColor; if FBorderRadius > 0 then RoundRectangle(ACanvas, ARect, FBorderRadius, FBorderRadius) else if FBorderWidth > 0 then Rectangle(ARect) else if Brush.Style <> bsClear then FillRect(ARect); end; end; end; procedure TKMemoBlockStyle.PropsChanged(AReasons: TKMemoUpdateReasons); begin FUpdateReasons := AReasons; if Changeable then FStyleChanged := True; Changed; end; procedure TKMemoBlockStyle.SetBorderColor(const Value: TColor); begin if Value <> FBorderColor then begin FBorderColor := Value; PropsChanged([muExtent]); end; end; procedure TKMemoBlockStyle.SetBorderRadius(const Value: Integer); begin if Value <> FBorderRadius then begin FBorderRadius := Value; PropsChanged([muExtent]); end; end; procedure TKMemoBlockStyle.SetBorderWidth(const Value: Integer); begin if Value <> FBorderWidth then begin FBorderWidth := Value; PropsChanged([muExtent]); end; end; procedure TKMemoBlockStyle.SetBorderWidths(const Value: TKRect); begin FBorderWidths.Assign(Value); end; procedure TKMemoBlockStyle.SetBottomMargin(const Value: Integer); begin FContentMargin.Bottom := Value; end; procedure TKMemoBlockStyle.SetBottomPadding(const Value: Integer); begin FContentPadding.Bottom := Value; end; procedure TKMemoBlockStyle.SetBrush(const Value: TBrush); begin FBrush.Assign(Value); end; procedure TKMemoBlockStyle.SetWrapMode(const Value: TKMemoBlockWrapMode); begin if Value <> FWrapMode then begin FWrapMode := Value; PropsChanged([muExtent]); end; end; procedure TKMemoBlockStyle.SetContentMargin(const Value: TKRect); begin FContentMargin.Assign(Value); end; procedure TKMemoBlockStyle.SetContentPadding(const Value: TKRect); begin FContentPadding.Assign(Value); end; procedure TKMemoBlockStyle.SetFillBlip(const Value: TGraphic); var Cls: TGraphicClass; begin FreeAndNil(FFillBlip); if Value <> nil then begin Cls := TGraphicClass(Value.ClassType); FFillBlip := Cls.Create; FFillBlip.Assign(Value); end; PropsChanged([muExtent]); end; procedure TKMemoBlockStyle.SetHAlign(const Value: TKHAlign); begin if Value <> FHAlign then begin FHAlign := Value; PropsChanged([muExtent]); end; end; procedure TKMemoBlockStyle.SetLeftMargin(const Value: Integer); begin FContentMargin.Left := Value; end; procedure TKMemoBlockStyle.SetLeftPadding(const Value: Integer); begin FContentPadding.Left := Value; end; procedure TKMemoBlockStyle.SetRightMargin(const Value: Integer); begin FContentMargin.Right := Value; end; procedure TKMemoBlockStyle.SetRightPadding(const Value: Integer); begin FContentPadding.Right := Value; end; procedure TKMemoBlockStyle.SetTopMargin(const Value: Integer); begin FContentMargin.Top := Value; end; procedure TKMemoBlockStyle.SetTopPadding(const Value: Integer); begin FContentPadding.Top := Value; end; procedure TKMemoBlockStyle.Update; begin if Assigned(FOnChanged) then FOnChanged(Self, FUpdateReasons); end; { TKMemoParagraphStyle } procedure TKMemoParaStyle.Defaults; begin inherited; FFirstIndent := 0; FLineSpacingFactor := 1; FLineSpacingMode := lsmFactor; FLineSpacingValue := 0; FNumberingList := cInvalidListID; FNumberingListLevel := -1; FNumberStartAt := 0; FWordWrap := True; end; procedure TKMemoParaStyle.Assign(ASource: TPersistent); begin inherited; if ASource is TKMemoParaStyle then begin FirstIndent := TKMemoParaStyle(ASource).FirstIndent; LineSpacingFactor := TKMemoParaStyle(ASource).LineSpacingFactor; LineSpacingMode := TKMemoParaStyle(ASource).LineSpacingMode; LineSpacingValue := TKMemoParaStyle(ASource).LineSpacingValue; NumberingListLevel := TKMemoParaStyle(ASource).NumberingListLevel; NumberingList := TKMemoParaStyle(ASource).NumberingList; NumberStartAt := TKMemoParaStyle(ASource).NumberStartAt; WordWrap := TKMemoParaStyle(ASource).WordWrap; end; end; procedure TKMemoParaStyle.SetFirstIndent(const Value: Integer); begin if Value <> FFirstIndent then begin FFirstIndent := Value; PropsChanged([muExtent]); end; end; procedure TKMemoParaStyle.SetLineSpacingValue(const Value: Integer); begin if Value <> FLineSpacingValue then begin FLineSpacingValue := Value; PropsChanged([muExtent]); end; end; procedure TKMemoParaStyle.SetLineSpacingFactor(const Value: Double); var Tmp: Double; begin Tmp := MinMax(Value, 1, 10); if Tmp <> FLineSpacingFactor then begin FLineSpacingFactor := Tmp; PropsChanged([muExtent]); end; end; procedure TKMemoParaStyle.SetLineSpacingMode(const Value: TKMemoLineSpacingMode); begin if Value <> FLineSpacingMode then begin FLineSpacingMode := Value; PropsChanged([muExtent]); end; end; procedure TKMemoParaStyle.SetNumberStartAt(const Value: Integer); begin if Value <> FNumberStartAt then begin FNumberStartAt := Value; PropsChanged([muContent]); end; end; procedure TKMemoParaStyle.SetNumberingList(const Value: Integer); begin if Value <> FNumberingList then begin FNumberingList := Value; if FNumberingList >= 0 then FNumberingListLevel := Max(FNumberingListLevel, 0) else FNumberingListLevel := -1; PropsChanged([muContent]); end; end; procedure TKMemoParaStyle.SetNumberingListAndLevel(AListID, ALevelIndex: Integer); begin FNumberingList := AListID; FNumberingListLevel := ALevelIndex; PropsChanged([muContent]); end; procedure TKMemoParaStyle.SetNumberingListLevel(const Value: Integer); begin if Value <> FNumberingListLevel then begin FNumberingListLevel := Value; PropsChanged([muContent]); end; end; procedure TKMemoParaStyle.SetWordWrap(const Value: Boolean); begin if Value <> FWordWrap then begin FWordWrap := Value; PropsChanged([muExtent]); end; end; { TKMemoLine } constructor TKMemoLine.Create; begin FPosition := CreateEmptyPoint; FExtent := CreateEmptyPoint; FEndBlock := 0; FEndIndex := 0; FEndWord := 0; FStartBlock := 0; FStartIndex := 0; FStartWord := 0; end; function TKMemoLine.GetLineRect: TRect; begin Result := Rect(FPosition.X, FPosition.Y, FPosition.X + FExtent.X, FPosition.Y + FExtent.Y); end; { TKMemoLines } function TKMemoLines.GetItem(Index: TKMemoLineIndex): TKMemoLine; begin Result := TKMemoLine(inherited GetItem(Index)); end; procedure TKMemoLines.SetItem(Index: TKMemoLineIndex; const Value: TKMemoLine); begin inherited SetItem(Index, Value); end; { TKWord } procedure TKMemoWord.Clear; begin FBaseLine := 0; FBottomPadding := 0; FClipped := False; FExtent := CreateEmptyPoint; FEndIndex := 0; FPosition := CreateEmptyPoint; FStartIndex := 0; FTopPadding := 0; end; constructor TKMemoWord.Create; begin Clear; end; { TKWordList } function TKMemoWordList.GetItem(Index: TKMemoWordIndex): TKMemoWord; begin Result := TKMemoWord(inherited GetItem(Index)); end; procedure TKMemoWordList.SetItem(Index: TKMemoWordIndex; const Value: TKMemoWord); begin inherited SetItem(Index, Value); end; { TKMemoColors } function TKMemoColors.GetColorSpec(Index: TKColorIndex): TKColorSpec; begin case Index of ciBkGnd: begin Result.Def := cBkGndDef; Result.Name := ''; end; ciInactiveCaretBkGnd: begin Result.Def := cInactiveCaretBkGndDef; Result.Name := ''; end; ciInactiveCaretSelBkGnd: begin Result.Def := cInactiveCaretSelBkGndDef; Result.Name := ''; end; ciInactiveCaretSelText: begin Result.Def := cInactiveCaretSelTextDef; Result.Name := ''; end; ciInactiveCaretText: begin Result.Def := cInactiveCaretTextDef; Result.Name := ''; end; ciSelBkGnd: begin Result.Def := cSelBkGndDef; Result.Name := ''; end; ciSelBkGndFocused: begin Result.Def := cSelBkGndFocusedDef; Result.Name := ''; end; ciSelText: begin Result.Def := cSelTextDef; Result.Name := ''; end; ciSelTextFocused: begin Result.Def := cSelTextFocusedDef; Result.Name := ''; end; else Result := inherited GetColorSpec(Index); end; end; function TKMemoColors.InternalGetColor(Index: TKColorIndex): TColor; begin case FColorScheme of csGrayed: if Index = ciBkGnd then Result := clWindow else Result := clGrayText; csBright: begin if FBrightColors[Index] = clNone then FBrightColors[Index] := BrightColor(FColors[Index], 0.5, bsOfTop); Result := FBrightColors[Index]; end; csGrayScale: Result := ColorToGrayScale(FColors[Index]); else Result := FColors[Index]; end; end; function TKMemoColors.GetMaxIndex: Integer; begin Result := ciMemoColorsMax; end; { TKMemoChangeList } constructor TKMemoChangeList.Create(AEditor: TKCustomMemo; RedoList: TKMemoChangeList); begin inherited Create; FEditor := AEditor; FGroupUseLock := 0; FLimit := cUndoLimitDef; FIndex := -1; FModifiedIndex := FIndex; FRedoList := RedoList; FOnChange := nil; end; procedure TKMemoChangeList.AddChange(ItemKind: TKMemoChangeKind; Inserted: Boolean); var P: PKMemoChangeItem; begin // don't allow succesive crCaretPos if (ItemKind = ckCaretPos) and not Inserted and (FIndex >= 0) and (PKMemoChangeItem(Items[FIndex]).ItemKind = ckCaretPos) then Exit; if FIndex < FLimit - 1 then begin if FIndex < Count - 1 then Inc(FIndex) else FIndex := Add(New(PKMemoChangeItem)); P := Items[FIndex]; if FGroupUseLock > 0 then begin P.Group := FGroup; P.GroupKind := FGroupKind; end else begin P.Group := 0; P.GroupKind := ItemKind; end; P.ItemKind := ItemKind; P.Position := FEditor.SelStart; // P.Data := Data; P.Inserted := Inserted; if FRedoList <> nil then FRedoList.Clear; if Assigned(FOnChange) then FOnChange(Self, ItemKind); end; end; procedure TKMemoChangeList.BeginGroup(GroupKind: TKMemoChangeKind); begin if FGroupUseLock = 0 then begin FGroupKind := GroupKind; Inc(FGroup); if FGroup = 0 then Inc(FGroup); end; Inc(FGroupUseLock); end; function TKMemoChangeList.CanPeek: Boolean; begin Result := FIndex >= 0; end; procedure TKMemoChangeList.Clear; begin inherited; FGroupUseLock := 0; FIndex := -1; FModifiedIndex := FIndex; end; procedure TKMemoChangeList.EndGroup; begin if FGroupUseLock > 0 then Dec(FGroupUseLock); end; function TKMemoChangeList.GetModified: Boolean; function CaretPosOnly: Boolean; var I: Integer; begin Result := True; for I := FModifiedIndex + 1 to FIndex do begin if PKMemoChangeItem(Items[I]).ItemKind <> ckCaretPos then begin Result := False; Exit; end; end; end; begin Result := (FIndex > FModifiedIndex) and not CaretPosOnly; end; procedure TKMemoChangeList.Notify(Ptr: Pointer; Action: TListNotification); var P: PKMemoChangeItem; begin case Action of lnDeleted: if Ptr <> nil then begin P := Ptr; Dispose(P); end; end; end; function TKMemoChangeList.PeekItem: PKMemoChangeItem; begin if CanPeek then begin Result := Items[FIndex]; Dec(FIndex); end else Result := nil; end; procedure TKMemoChangeList.PokeItem; begin if FIndex < Count - 1 then Inc(FIndex); end; procedure TKMemoChangeList.SetGroupData(Group: Integer; GroupKind: TKMemoChangeKind); begin FGroup := Group; FGroupKind := GroupKind; FGroupUseLock := 1; end; procedure TKMemoChangeList.SetLimit(Value: Integer); begin if Value <> FLimit then begin FLimit := MinMax(Value, cUndoLimitMin, cUndoLimitMax); while Count > FLimit do Delete(0); FIndex := Min(FIndex, FLimit - 1); end; end; procedure TKMemoChangeList.SetModified(Value: Boolean); begin if not Value then FModifiedIndex := FIndex; end; { TKCustomMemo } constructor TKCustomMemo.Create(AOwner: TComponent); begin inherited Create(AOwner); Color := clWindow; ControlStyle := [csOpaque, csClickEvents, csDoubleClicks, csCaptureMouse]; DoubleBuffered := True; // is needed FOldFontChanged := Font.OnChange; Font.OnChange := FontChange; Height := cHeight; ParentColor := False; ParentFont := False; TabStop := True; Width := cWidth; FBackground := TKMemoBackground.Create; FBackground.OnChanged := BackgroundChanged; FBlocks := TKMemoBlocks.Create; FBlocks.MemoNotifier := Self; FBlocks.OnUpdate := BlocksChanged; FActiveBlocks := FBlocks; FCaretRect := CreateEmptyRect; FColors := TKMemoColors.Create(Self); FContentPadding := TKRect.Create; FContentPadding.All := 5; FContentPadding.OnChanged := ContentPaddingChanged; FDisabledDrawStyle := cEditDisabledDrawStyleDef; FDragMode := sgpNone; FDragRect := CreateEmptyRect; FHorzScrollStep := cHorzScrollStepDef; FInUpdateScrollRange := False; FLeftPos := 0; FLinePosition := eolInside; FListTable := TKMemoListTable.Create; FListTable.OnChanged := ListChanged; FMaxWordLength := cMaxWordLengthDef; FMouseWheelAccumulator := 0; FNewTextStyle := TKMemoTextStyle.Create; FNewTextStyleValid := False; FOldCaretRect := CreateEmptyRect; FOptions := cKMemoOptionsDef; FPreferredCaretPos := 0; FKeyMapping := TKEditKeyMapping.Create; FParaStyle := TKMemoParaStyle.Create; FParaStyle.Changeable := False; FParaStyle.OnChanged := ParaStyleChanged; FRedoList := TKMemoChangeList.Create(Self, nil); FRequiredContentWidth := 0; FRequiredMouseCursor := crIBeam; FScrollBars := ssBoth; FScrollPadding := cScrollPaddingDef; FScrollSpeed := cScrollSpeedDef; FScrollTimer := TTimer.Create(Self); FScrollTimer.Enabled := False; FScrollTimer.Interval := FScrollSpeed; FScrollTimer.OnTimer := ScrollTimerHandler; FSelectedBlock := nil; FStates := []; FTextStyle := TKMemoTextStyle.Create; FTextStyle.Changeable := False; // Lazarus: Why is Font.Size = 0 here? In Delphi it is already valid! if Font.Size <> 0 then FTextStyle.Font.Assign(Font); FTextStyle.UnlockUpdate; FTextStyle.OnChanged := TextStyleChanged; FTopPos := 0; FUndoList := TKMemoChangeList.Create(Self, FRedoList); FUndoList.OnChange := UndoChange; FVertScrollStep := cVertScrollStepDef; FWordBreaks := cDefaultWordBreaks; FOnChange := nil; FOnDropFiles := nil; FOnBlockClick := nil; FOnBlockDblClick := nil; FOnBlockEdit := nil; FOnReplaceText := nil; if csDesigning in ComponentState then Text := 'This is beta state control.'+cEOL+'You may already use it in your programs'+cEOL+'but some important functions may still be missing.'+cEOL else Text := cEOL; UpdateEditorCaret; end; destructor TKCustomMemo.Destroy; begin Clear; FOnChange := nil; FUndoList.Free; FRedoList.Free; FParaStyle.Free; FNewTextStyle.Free; FKeyMapping.Free; FTextStyle.Free; FListTable.Free; FContentPadding.Free; FColors.Free; FBlocks.Free; FBackground.Free; inherited; end; procedure TKCustomMemo.AddUndoCaretPos(Force: Boolean); begin FUndoList.AddChange(ckCaretPos, Force); end; procedure TKCustomMemo.AddUndoChar(AItemKind: TKMemoChangeKind; AData: TKChar; AInserted: Boolean = True); begin FUndoList.AddChange(AItemKind, AInserted); end; procedure TKCustomMemo.AddUndoString(AItemKind: TKMemoChangeKind; const AData: TKString; AInserted: Boolean = True); begin if AData <> '' then FUndoList.AddChange(AItemKind, AInserted); end; procedure TKCustomMemo.Assign(Source: TPersistent); begin if Source is TKCustomMemo then with Source as TKCustomMemo do begin Self.LockUpdate; try Self.Align := Align; Self.Anchors := Anchors; Self.AutoSize := AutoSize; Self.BiDiMode := BiDiMode; Self.BorderStyle := BorderStyle; Self.BorderWidth := BorderWidth; Self.Color := Color; Self.Colors := Colors; Self.Constraints.Assign(Constraints); {$IFNDEF FPC} Self.Ctl3D := Ctl3D; {$ENDIF} Self.DisabledDrawStyle := DisabledDrawStyle; Self.DragCursor := DragCursor; Self.DragKind := DragKind; Self.DragMode := DragMode; Self.Enabled := Enabled; Self.Font := Font; {$IFNDEF FPC} Self.ImeMode := ImeMode; Self.ImeName := ImeName; {$ENDIF} Self.KeyMapping.Assign(KeyMapping); Self.Modified := False; Self.Options := Options; Self.ParaStyle.Assign(ParaStyle); Self.ParentBiDiMode := ParentBiDiMode; Self.ParentColor := ParentColor; {$IFNDEF FPC} Self.ParentCtl3D := ParentCtl3D; {$ENDIF} Self.ParentFont := ParentFont; Self.ParentShowHint := ParentShowHint; Self.PopupMenu := PopupMenu; Self.ScrollBars := ScrollBars; Self.SelEnd := SelEnd; Self.SelStart := SelStart; Self.ShowHint := ShowHint; Self.TabOrder := TabOrder; Self.TabStop := TabStop; Self.TextStyle.Assign(TextStyle); Self.Visible := Visible; finally Self.UnlockUpdate; end; end else inherited; end; function TKCustomMemo.BlockAt(APos: TPoint): TKMemoBlock; var TmpPosition: TKMemoLinePosition; Index: TKMemoSelectionIndex; P: TPoint; begin SetActiveBlocksForPoint(APos); P := PointToBlockPoint(APos); Index := ActiveBlocks.PointToIndex(Canvas, P, False, False, TmpPosition); if Index >= 0 then Result := ActiveBlocks.IndexToInnerBlock(Index) else Result := ActiveBlocks.PointToRelativeBlock(P); end; function TKCustomMemo.BlockRect(ABlock: TKMemoBlock): TRect; var OldActiveBlocks: TKMemoBlocks; begin Result := CreateEmptyRect; if (ABlock <> nil) and (ABlock.WordCount > 0) then begin OldActiveBlocks := FActiveBlocks; try FActiveBlocks := FBlocks.GetParentBlocksForBlock(ABlock); if FActiveBlocks <> nil then Result := BlockRectToRect(ABlock.BoundsRect); finally FActiveBlocks := OldActiveBlocks; end; end; end; procedure TKCustomMemo.BackgroundChanged(Sender: TObject); begin Invalidate; end; procedure TKCustomMemo.BeginUndoGroup(AGroupKind: TKMemoChangeKind); begin FUndoList.BeginGroup(AGroupKind); end; function TKCustomMemo.BlockRectToRect(const ARect: TRect): TRect; begin Result := ARect; KFunctions.OffsetRect(Result, ContentLeft, ContentTop); if ActiveBlocks <> FBlocks then begin KFunctions.OffsetRect(Result, ActiveBlocks.TotalLeftOffset, ActiveBlocks.TotalTopOffset); end; end; function TKCustomMemo.BlockClick(ABlock: TKMemoBlock): Boolean; begin Result := False; if Assigned(FOnBlockClick) then FOnBlockClick(Self, Ablock, Result); end; function TKCustomMemo.BlockDblClick(ABlock: TKMemoBlock): Boolean; begin Result := False; if Assigned(FOnBlockDblClick) then FOnBlockDblClick(Self, Ablock, Result); end; procedure TKCustomMemo.BlockFreeNotification(ABlock: TKMemoBlock); begin if ABlock = FSelectedBlock then begin CancelDrag; FSelectedBlock := nil; end; end; procedure TKCustomMemo.BlocksFreeNotification(ABlocks: TKMemoBlocks); begin if ABlocks = ActiveBlocks then ActiveBlocks := FBlocks; end; procedure TKCustomMemo.BlocksChanged(Reasons: TKMemoUpdateReasons); begin if HandleAllocated and UpdateUnlocked then begin if Reasons * [muContent, muContentAddOnly, muExtent] <> [] then UpdateScrollRange(True) else if muSelectionScroll in Reasons then begin if not ClampInView(nil, False) then begin UpdateEditorCaret; Invalidate; end; end else begin UpdateEditorCaret; Invalidate; end; if muContent in Reasons then DoChange; end; end; procedure TKCustomMemo.CancelDrag; begin if FStates * [elMouseDrag, elMouseDragInit] <> [] then begin FStates := FStates - [elMouseDrag, elMouseDragInit]; Invalidate; end; end; function TKCustomMemo.CanScroll(ACommand: TKEditCommand): Boolean; var R: TRect; begin case ACommand of ecScrollUp: Result := FTopPos > 0; ecScrollDown: Result := FTopPos < FVertScrollExtent - 1; ecScrollLeft: Result := FLeftPos > 0; ecScrollRight: Result := FLeftPos < FHorzScrollExtent - 1; ecScrollCenter: begin R := IndexToRect(SelEnd, True); R.Left := R.Left - ClientWidth div 2; R.Top := R.Top - ClientHeight div 2; Result := (FLeftPos > 0) and (R.Left < 0) or (FLeftPos < FHorzScrollExtent - 1) and (R.Left > 0) or (FTopPos > 0) and (R.Top < 0) or (FTopPos < FVertScrollExtent - 1) and (R.Top > 0); end; else Result := False; end; end; function TKCustomMemo.CaretInView: Boolean; begin Result := PtInRect(ClientRect, FCaretRect.TopLeft); end; function TKCustomMemo.ClampInView(AMousePos: PPoint; ACallScrollWindow: Boolean): Boolean; var DeltaHorz, DeltaVert: Integer; begin UpdateEditorCaret(False); Result := ScrollNeeded(AMousePos, DeltaHorz, DeltaVert); if Result then begin Result := Scroll(cScrollDelta, cScrollDelta, DeltaHorz, DeltaVert, ACallScrollWindow); if Result then FScrollTimer.Enabled := True; end; end; procedure TKCustomMemo.Clear(AKeepOnePara: Boolean); begin FBlocks.LockUpdate; try FBlocks.Clear; if AKeepOnePara then FBlocks.FixEmptyBlocks; FTextStyle.Defaults; if Font.Size <> 0 then FTextStyle.Font.Assign(Font); FParaStyle.Defaults; FColors.BkGnd := cBkGndDef; FBackground.Clear; FListTable.Clear; finally FBlocks.UnlockUpdate; end; end; procedure TKCustomMemo.ClearSelection(ATextOnly: Boolean); var Len: TKMemoSelectionIndex; begin Len := ActiveBlocks.SelLength; ActiveBlocks.ClearSelection(ATextOnly); if Len <> 0 then Modified := True; end; procedure TKCustomMemo.ClearUndo; begin FUndoList.Clear; FRedoList.Clear; end; procedure TKCustomMemo.CMEnabledChanged(var Msg: TLMessage); begin inherited; UpdateEditorCaret; Invalidate; end; procedure TKCustomMemo.CMSysColorChange(var Msg: TLMessage); begin inherited; FColors.ClearBrightColors; end; function TKCustomMemo.CommandEnabled(Command: TKEditCommand): Boolean; var TmpSelEnd, TmpSelLength: TKMemoSelectionIndex; TmpLinePos: TKMemoLinePosition; begin if Enabled and Visible and not (csDesigning in ComponentState) then begin TmpSelEnd := SelEnd; TmpSelLength := RealSelLength; case Command of // movement commands ecLeft, ecSelLeft, ecWordLeft, ecSelWordLeft: Result := TmpSelEnd > 0; ecRight, ecSelRight, ecWordRight, ecSelWordRight: Result := TmpSelEnd < ActiveBlocks.SelectableLength; ecUp, ecSelUp, ecPageUp, ecSelPageUp: Result := ActiveBlocks.IndexBelowFirstLine(TmpSelEnd, True); ecDown, ecPagedown, ecSelDown, ecSelPageDown: Result := ActiveBlocks.IndexAboveLastLine(TmpSelEnd, True); ecLineStart, ecPageLeft, ecSelLineStart, ecSelPageLeft: Result := TmpSelEnd > ActiveBlocks.LineStartIndexByIndex(TmpSelEnd, True, TmpLinePos); ecLineEnd, ecPageRight: Result := TmpSelEnd < ActiveBlocks.LineEndIndexByIndex(TmpSelEnd, True, False, TmpLinePos); ecSelLineEnd, ecSelPageRight: Result := TmpSelEnd < ActiveBlocks.LineEndIndexByIndex(TmpSelEnd, True, True, TmpLinePos); ecPageTop, ecSelPageTop: Result := TmpSelEnd <> ActiveBlocks.NextIndexByVertValue(Canvas, -ContentTop + VertScrollPadding, FPreferredCaretPos, False, TmpLinePos); ecPageBottom, ecSelPageBottom: Result := TmpSelEnd <> ActiveBlocks.NextIndexByVertValue(Canvas, -ContentTop + VertScrollPadding + ClientHeight, FPreferredCaretPos, True, TmpLinePos); ecEditorTop, ecSelEditorTop: Result := TmpSelEnd > 0; ecEditorBottom, ecSelEditorBottom: Result := TmpSelEnd < ActiveBlocks.SelectableLength; ecGotoXY, ecSelGotoXY: Result := True; // scroll commands ecScrollUp, ecScrollDown, ecScrollLeft, ecScrollRight, ecScrollCenter: Result := CanScroll(Command); // editing commands ecUndo: Result := not ReadOnly and FUndoList.CanPeek; ecRedo: Result := not ReadOnly and FRedoList.CanPeek; ecCopy, ecCut: Result := not Empty and (not ReadOnly or (Command = ecCopy)) and ((TmpSelLength > 0) or RelativeSelected); ecPaste: Result := not ReadOnly and (ClipBoard.FormatCount > 0); ecInsertChar, ecInsertString, ecInsertNewLine: Result := not (ReadOnly or RelativeSelected); ecDeleteLastChar: Result := not (Empty or ReadOnly) and ((TmpSelLength > 0) or (TmpSelEnd > 0)); ecDeleteChar: Result := not (Empty or ReadOnly) and ((TmpSelLength > 0) or (TmpSelEnd < ActiveBlocks.SelectableLength - 1)); ecDeleteBOL: Result := not (Empty or ReadOnly or RelativeSelected) and ((TmpSelLength > 0) or (TmpSelEnd <> ActiveBlocks.LineStartIndexByIndex(TmpSelEnd, True, TmpLinePos))); ecDeleteEOL: Result := not (Empty or ReadOnly or RelativeSelected) and ((TmpSelLength > 0) or (TmpSelEnd <> ActiveBlocks.LineEndIndexByIndex(TmpSelEnd, True, True, TmpLinePos))); ecDeleteLine, ecClearAll, ecReplace: Result := not (Empty or ReadOnly or RelativeSelected); ecClearSelection: Result := not (Empty or ReadOnly or RelativeSelected) and (TmpSelLength > 0); ecSearch: Result := not Empty; ecSelectAll: Result := not Empty and (SelLength < SelectableLength); ecInsertMode: Result := elOverwrite in FStates; ecOverwriteMode: Result := not (elOverwrite in FStates); ecToggleMode: Result := not ReadOnly; ecGotFocus, ecLostFocus: Result := True; else Result := False; end; end else Result := False; end; procedure TKCustomMemo.ContentPaddingChanged(Sender: TObject); begin BlocksChanged([muExtent]); end; procedure TKCustomMemo.CreateHandle; begin inherited; UpdateScrollRange(True); end; procedure TKCustomMemo.CreateParams(var Params: TCreateParams); begin inherited; with Params do begin if FScrollBars in [ssVertical, ssBoth] then Style := Style or WS_VSCROLL; if FScrollBars in [ssHorizontal, ssBoth] then Style := Style or WS_HSCROLL; end; end; procedure TKCustomMemo.CreateWnd; begin inherited; {$IFDEF MSWINDOWS} if (eoDropFiles in FOptions) and not (csDesigning in ComponentState) then DragAcceptFiles(Handle, TRUE); {$ENDIF} end; procedure TKCustomMemo.DeleteBOL(At: TKMemoSelectionIndex); begin ActiveBlocks.DeleteBOL(At); Modified := True; end; procedure TKCustomMemo.DeleteChar(At: TKMemoSelectionIndex); begin if RelativeSelected then DeleteSelectedBlock else ActiveBlocks.DeleteChar(At); Modified := True; end; procedure TKCustomMemo.DeleteEOL(At: TKMemoSelectionIndex); begin ActiveBlocks.DeleteEOL(At); Modified := True; end; procedure TKCustomMemo.DeleteLastChar(At: TKMemoSelectionIndex); begin if RelativeSelected then DeleteSelectedBlock else ActiveBlocks.DeleteLastChar(At); Modified := True; end; procedure TKCustomMemo.DeleteLine(At: TKMemoSelectionIndex); begin ActiveBlocks.DeleteLine(At); Modified := True; end; procedure TKCustomMemo.DeleteSelectedBlock; var Blocks: TKMemoBlocks; begin if FSelectedBlock <> nil then begin Blocks := FSelectedBlock.ParentBlocks; if Blocks <> nil then begin Blocks.Remove(FSelectedBlock); FSelectedBlock := nil; end; end; end; procedure TKCustomMemo.DestroyWnd; begin {$IFDEF MSWINDOWS} if (eoDropFiles in FOptions) and not (csDesigning in ComponentState) then DragAcceptFiles(Handle, FALSE); {$ENDIF} inherited; end; procedure TKCustomMemo.DoChange; begin if Assigned(FOnChange) then FOnChange(Self); end; function TKCustomMemo.DoCopy: Boolean; var Stream: TMemoryStream; S: TKString; TmpItems: TKMemoBlocks; TmpSelect: Boolean; begin // temporary select entire FSelectedBlock (floating TKMemoContainer) TmpItems := ActiveBlocks; TmpSelect := (FSelectedBlock <> nil) and (FSelectedBlock.SelLength = 0); if TmpSelect then begin FSelectedBlock.Select(0, FSelectedBlock.SelectableLength(True), False); FActiveBlocks := FBlocks; end; // copy selected blocks as plain text and RTF to clipboard S := ActiveBlocks.SelText; Stream := TMemoryStream.Create; try SaveToRTFStream(Stream, True); //Stream.SaveToFile('copied.rtf'); //debug line Result := ClipBoardSaveStreamAs(cRichText, Stream, S); finally Stream.Free; // clear selection if TmpSelect then begin FSelectedBlock.Select(-1, 0, False); FActiveBlocks := TmpItems; end; end; end; function TKCustomMemo.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean; const WHEEL_DIVISOR = 120; var AmountToScroll, WheelClicks: Integer; begin Result := inherited DoMouseWheel(Shift, WheelDelta, MousePos); if not Result then begin if ssCtrl in Shift then AmountToScroll := ClientHeight else AmountToScroll := 3 * FVertScrollStep; Inc(FMouseWheelAccumulator, WheelDelta); WheelClicks := FMouseWheelAccumulator div WHEEL_DIVISOR; FMouseWheelAccumulator := FMouseWheelAccumulator mod WHEEL_DIVISOR; ScrollBy(0, - WheelClicks * AmountToScroll, eoScrollWindow in FOptions); Result := True; end; end; function TKCustomMemo.DoPaste: Boolean; var Stream: TMemoryStream; S: TKString; Picture: TPicture; OldSelectableLength, NewSelectableLength: TKMemoSelectionIndex; BlocksToInsert: TKMemoBlocks; BlockIndex: TKMemoBlockIndex; {$IFDEF USE_PNG_SUPPORT} Png: TKPngImage; {$ENDIF} begin // load blocks from clipboard either as RTF or plain text Stream := TMemoryStream.Create; try Result := ClipBoardLoadStreamAs(cRichText, Stream, S); if Result then begin ExecuteCommand(ecClearSelection); OldSelectableLength := ActiveBlocks.SelectableLength; if Stream.Size > 0 then begin Stream.Seek(0, soFromBeginning); //Stream.SaveToFile('pasted.rtf'); //debug line LoadFromRTFStream(Stream, SelEnd); end else ActiveBlocks.InsertPlainText(SelEnd, S); NewSelectableLength := ActiveBlocks.SelectableLength; if NewSelectableLength > OldSelectableLength then Select(SelEnd + NewSelectableLength - OldSelectableLength, 0); Modified := True; end else begin // try image formats Result := ClipBoard.HasFormat(CF_PICTURE); if Result then begin try Picture := TPicture.Create; try LoadPictureFromClipboard(Picture, CF_BITMAP); {$IFDEF USE_PNG_SUPPORT} // Try to convert unsupported image formats to PNG if not ((Picture.Graphic is TKPngImage) or (Picture.Graphic is TKJPegImage){$IFnDEF FPC} or (Picture.Graphic is TMetafile){$ENDIF}) then begin Png := TKPngImage.Create; try Png.Assign(Picture.Graphic); Picture.Assign(Png); finally Png.Free; end; end; {$ENDIF} BlocksToInsert := ActiveBlocks.SplitForInsert(SelEnd, BlockIndex); if BlocksToInsert <> nil then BlocksToInsert.AddImageBlock(Picture, BlockIndex); finally Picture.Free; end; except // do nothing end; end; end; finally Stream.Free; end; end; function TKCustomMemo.DoRedo: Boolean; begin //TODO Result := False; end; function TKCustomMemo.DoSearchReplace(AReplace: Boolean): Boolean; begin // TODO Result := False; end; function TKCustomMemo.DoUndo: Boolean; begin //TODO Result := False; end; procedure TKCustomMemo.DragBlock; var P: TPoint; DX, DY: Integer; begin if FStates * [elMouseDrag, elMouseDragInit] <> [] then begin P := ScreenToClient(Mouse.CursorPos); DX := P.X - FDragCurPos.X; DY := P.Y - FDragCurPos.Y; if (elMouseDrag in FStates) or (elMouseDragInit in FStates) and ((Abs(DX) > cMouseDragThreshold) or (Abs(DY) > cMouseDragThreshold)) then begin FStates := FStates - [elMouseDragInit] + [elMouseDrag]; TKSizingGrips.ClsAffectRect(FDragMode, DX, DY, FDragRect); FDragCurPos := P; Invalidate; end; end; end; function TKCustomMemo.EditBlock(ABlock: TKMemoBlock): Boolean; begin Result := False; if Assigned(FOnBlockEdit) and not ReadOnly then FOnBlockEdit(Self, ABlock, Result); end; {$IFNDEF FPC} procedure TKCustomMemo.EMGetSel(var Msg: TLMessage); begin PInteger(Msg.WParam)^ := SelStart; PInteger(Msg.LParam)^ := SelEnd; Msg.Result := 1; end; procedure TKCustomMemo.EMSetSel(var Msg: TLMessage); begin Select(Msg.WParam, Msg.LParam); Msg.Result := 1; end; {$ENDIF} procedure TKCustomMemo.EndUndoGroup; begin FUndoList.EndGroup; end; function TKCustomMemo.ExecuteCommand(Command: TKEditCommand; Data: Pointer): Boolean; var TmpSelEnd, NewSelEnd: TKMemoSelectionIndex; TmpPosition: TKMemoLinePosition; AStart, AEnd: TKMemoSelectionIndex; begin Result := False; if CommandEnabled(Command) then begin Result := True; TmpSelEnd := SelEnd; TmpPosition := FLinePosition; case Command of // selection commands ecLeft: begin NewSelEnd := ActiveBlocks.NextIndexByCharCount(TmpSelEnd, -1); SelectionInit(NewSelEnd, True, eolInside); end; ecWordLeft: begin if ActiveBlocks.GetNearestWordIndexes(TmpSelEnd, true, true, AStart, AEnd) then begin if TmpSelEnd <> AStart then NewSelEnd := ActiveBlocks.NextIndexByCharCount(TmpSelEnd, -(TmpSelEnd-AStart)) else begin TmpSelEnd := ActiveBlocks.NextIndexByCharCount(TmpSelEnd, -2); ActiveBlocks.GetNearestWordIndexes(TmpSelEnd, false, true, AStart, AEnd); NewSelEnd := ActiveBlocks.NextIndexByCharCount(TmpSelEnd, -(TmpSelEnd-AStart)); end; SelectionInit(NewSelEnd, True, eolInside); end; end; ecSelLeft: begin NewSelEnd := ActiveBlocks.NextIndexByCharCount(TmpSelEnd, -1); SelectionExpand(NewSelEnd, True, eolInside); end; ecSelWordLeft: begin if ActiveBlocks.GetNearestWordIndexes(TmpSelEnd, true, true, AStart, AEnd) then begin if TmpSelEnd <> AStart then NewSelEnd := ActiveBlocks.NextIndexByCharCount(TmpSelEnd, -(TmpSelEnd-AStart)) else begin TmpSelEnd := ActiveBlocks.NextIndexByCharCount(TmpSelEnd, -2); ActiveBlocks.GetNearestWordIndexes(TmpSelEnd, false, true, AStart, AEnd); NewSelEnd := ActiveBlocks.NextIndexByCharCount(TmpSelEnd, -(TmpSelEnd-AStart)); end; SelectionExpand(NewSelEnd, True, eolInside); end; end; ecRight: begin NewSelEnd := ActiveBlocks.NextIndexByCharCount(TmpSelEnd, 1); SelectionInit(NewSelEnd, True, TmpPosition); end; ecWordRight: begin if ActiveBlocks.GetNearestWordIndexes(TmpSelEnd, true, true, AStart, AEnd) then begin if TmpSelEnd <> AEnd then NewSelEnd := ActiveBlocks.NextIndexByCharCount(TmpSelEnd, (AEnd-TmpSelEnd)) else begin TmpSelEnd := ActiveBlocks.NextIndexByCharCount(TmpSelEnd, 2); ActiveBlocks.GetNearestWordIndexes(TmpSelEnd, false, true, AStart, AEnd); NewSelEnd := ActiveBlocks.NextIndexByCharCount(TmpSelEnd, (AEnd-TmpSelEnd)); end; SelectionInit(NewSelEnd, True, eolInside); end; end; ecSelRight: begin NewSelEnd := ActiveBlocks.NextIndexByCharCount(TmpSelEnd, 1); SelectionExpand(NewSelEnd, True, TmpPosition); end; ecSelWordRight: begin if ActiveBlocks.GetNearestWordIndexes(TmpSelEnd, true, true, AStart, AEnd) then begin if TmpSelEnd <> AEnd then NewSelEnd := ActiveBlocks.NextIndexByCharCount(TmpSelEnd, (AEnd-TmpSelEnd)) else begin TmpSelEnd := ActiveBlocks.NextIndexByCharCount(TmpSelEnd, 2); ActiveBlocks.GetNearestWordIndexes(TmpSelEnd, false, true, AStart, AEnd); NewSelEnd := ActiveBlocks.NextIndexByCharCount(TmpSelEnd, (AEnd-TmpSelEnd)); end; SelectionExpand(NewSelEnd, True, TmpPosition); end; end; ecUp: begin NewSelEnd := ActiveBlocks.NextIndexByRowDelta(Canvas, TmpSelEnd, -1, FPreferredCaretPos, TmpPosition); SelectionInit(NewSelEnd, True, TmpPosition); end; ecSelUp: begin NewSelEnd := ActiveBlocks.NextIndexByRowDelta(Canvas, TmpSelEnd, -1, FPreferredCaretPos, TmpPosition); SelectionExpand(NewSelEnd, True, TmpPosition); end; ecDown: begin NewSelEnd := ActiveBlocks.NextIndexByRowDelta(Canvas, TmpSelEnd, 1, FPreferredCaretPos, TmpPosition); SelectionInit(NewSelEnd, True, TmpPosition); end; ecSelDown: begin NewSelEnd := ActiveBlocks.NextIndexByRowDelta(Canvas, TmpSelEnd, 1, FPreferredCaretPos, TmpPosition); SelectionExpand(NewSelEnd, True, TmpPosition); end; ecLineStart: begin NewSelEnd := ActiveBlocks.LineStartIndexByIndex(TmpSelEnd, True, TmpPosition); SelectionInit(NewSelEnd, True, TmpPosition); end; ecSelLineStart: begin NewSelEnd := ActiveBlocks.LineStartIndexByIndex(TmpSelEnd, True, TmpPosition); SelectionExpand(NewSelEnd, True, TmpPosition); end; ecLineEnd: begin NewSelEnd := ActiveBlocks.LineEndIndexByIndex(TmpSelEnd, True, False, TmpPosition); SelectionInit(NewSelEnd, True, TmpPosition); end; ecSelLineEnd: begin NewSelEnd := ActiveBlocks.LineEndIndexByIndex(TmpSelEnd, True, True, TmpPosition); SelectionExpand(NewSelEnd, True, TmpPosition); end; ecPageUp: begin NewSelEnd := ActiveBlocks.NextIndexByVertExtent(Canvas, TmpSelEnd, -ClientHeight, FPreferredCaretPos, TmpPosition); SelectionInit(NewSelEnd, True, TmpPosition); end; ecSelPageUp: begin NewSelEnd := ActiveBlocks.NextIndexByVertExtent(Canvas, TmpSelEnd, -ClientHeight, FPreferredCaretPos, TmpPosition); SelectionExpand(NewSelEnd, True, TmpPosition); end; ecPageDown: begin NewSelEnd := ActiveBlocks.NextIndexByVertExtent(Canvas, TmpSelEnd, ClientHeight, FPreferredCaretPos, TmpPosition); SelectionInit(NewSelEnd, True, TmpPosition); end; ecSelPageDown: begin NewSelEnd := ActiveBlocks.NextIndexByVertExtent(Canvas, TmpSelEnd, ClientHeight, FPreferredCaretPos, TmpPosition); SelectionExpand(NewSelEnd, True, TmpPosition); end; ecPageLeft: begin NewSelEnd := ActiveBlocks.NextIndexByHorzExtent(Canvas, TmpSelEnd, -ClientWidth, TmpPosition); SelectionInit(NewSelEnd, True, TmpPosition); end; ecSelPageLeft: begin NewSelEnd := ActiveBlocks.NextIndexByHorzExtent(Canvas, TmpSelEnd, -ClientWidth, TmpPosition); SelectionExpand(NewSelEnd, True, TmpPosition); end; ecPageRight: begin NewSelEnd := ActiveBlocks.NextIndexByHorzExtent(Canvas, TmpSelEnd, ClientWidth, TmpPosition); SelectionInit(NewSelEnd, True, TmpPosition); end; ecSelPageRight: begin NewSelEnd := ActiveBlocks.NextIndexByHorzExtent(Canvas, TmpSelEnd, ClientWidth, TmpPosition); SelectionExpand(NewSelEnd, True, TmpPosition); end; ecPageTop: begin NewSelEnd := ActiveBlocks.NextIndexByVertValue(Canvas, -ContentTop + VertScrollPadding, FPreferredCaretPos, False, TmpPosition); SelectionInit(NewSelEnd, True, TmpPosition); end; ecSelPageTop: begin NewSelEnd := ActiveBlocks.NextIndexByVertValue(Canvas, FTopPos + VertScrollPadding, FPreferredCaretPos, False, TmpPosition); SelectionExpand(NewSelEnd, True, TmpPosition); end; ecPageBottom: begin NewSelEnd := ActiveBlocks.NextIndexByVertValue(Canvas, -ContentTop + ClientHeight - VertScrollPadding, FPreferredCaretPos, True, TmpPosition); SelectionInit(NewSelEnd, True, TmpPosition); end; ecSelPageBottom: begin NewSelEnd := ActiveBlocks.NextIndexByVertValue(Canvas, FTopPos + ClientHeight - VertScrollPadding, FPreferredCaretPos, True, TmpPosition); SelectionExpand(NewSelEnd, True, TmpPosition); end; ecEditorTop: SelectionInit(0, True, eolInside); ecSelEditorTop: SelectionExpand(0, True, eolInside); ecEditorBottom: SelectionInit(ActiveBlocks.SelectableLength, True, eolEnd); ecSelEditorBottom: SelectionExpand(ActiveBlocks.SelectableLength, True, eolEnd); ecGotoXY: begin NewSelEnd := PointToIndex(PPoint(Data)^, True, False, TmpPosition); SelectionInit(NewSelEnd, True, TmpPosition); end; ecSelGotoXY: begin NewSelEnd := PointToIndex(PPoint(Data)^, True, True, TmpPosition); SelectionExpand(NewSelEnd, True, TmpPosition); end; // scroll commands ecScrollUp: begin ScrollBy(0, -1, eoScrollWindow in FOptions); while CommandEnabled(ecUp) and (FCaretRect.Top + FCaretRect.Bottom > ClientHeight - VertScrollPadding) do ExecuteCommand(ecUp); end; ecScrollDown: begin ScrollBy(0, 1, eoScrollWindow in FOptions); while CommandEnabled(ecDown) and (FCaretRect.Top < VertScrollPadding) do ExecuteCommand(ecDown); end; ecScrollLeft: begin ScrollBy(-1, 0, eoScrollWindow in FOptions); while CommandEnabled(ecLeft) and (FCaretRect.Left + FCaretRect.Right > ClientWidth - HorzScrollPadding) do ExecuteCommand(ecLeft); end; ecScrollRight: begin ScrollBy(1, 0, eoScrollWindow in FOptions); while CommandEnabled(ecRight) and (FCaretRect.Left < HorzScrollPadding) do ExecuteCommand(ecRight); end; ecScrollCenter: ScrollToClientAreaCenter; // editing commands ecUndo: Result := DoUndo; ecRedo: Result := DoRedo; ecCopy: Result := DoCopy; ecCut: begin if DoCopy then ClearSelection; end; ecPaste: DoPaste; ecInsertChar: InsertChar(TmpSelEnd, PKChar(Data)^); ecInsertString: InsertString(TmpSelEnd, TKString(Data)); ecInsertNewLine: InsertNewLine(TmpSelEnd); ecDeleteLastChar: DeleteLastChar(TmpSelEnd); ecDeleteChar: DeleteChar(TmpSelEnd); ecDeleteBOL: DeleteBOL(TmpSelEnd); ecDeleteEOL: DeleteEOL(TmpSelEnd); ecDeleteLine: DeleteLine(TmpSelEnd); ecSelectAll: Select(0, ActiveBlocks.SelectableLength); ecClearAll: begin Select(0, ActiveBlocks.SelectableLength); ClearSelection; end; ecClearSelection: ClearSelection; ecSearch, ecReplace: Result := DoSearchReplace(Command = ecReplace); ecInsertMode: begin Exclude(FStates, elOverwrite); UpdateEditorCaret; end; ecOverwriteMode: begin Include(FStates, elOverwrite); UpdateEditorCaret; end; ecToggleMode: begin if elOverwrite in FStates then Exclude(FStates, elOverwrite) else Include(FStates, elOverwrite); UpdateEditorCaret; end; // focus change ecGotFocus: begin UpdateEditorCaret; Invalidate; end; ecLostFocus: begin UpdateEditorCaret; Invalidate; end; end; case Command of ecLeft, ecRight, ecLineStart, ecLineEnd, ecPageLeft, ecPageRight, ecGotoXY, ecSelLeft, ecSelRight, ecSelLineStart, ecSelLineEnd, ecSelPageLeft, ecSelPageRight, ecSelGotoXY, ecEditorTop, ecSelEditorTop, ecEditorBottom, ecSelEditorBottom, ecInsertChar, ecInsertString, ecInsertNewLine, ecDeleteLastChar, ecDeleteChar, ecDeleteBOL, ecDeleteEOL, ecDeleteLine, ecSelectAll, ecClearAll, ecClearSelection: UpdatePreferredCaretPos; end; end; end; procedure TKCustomMemo.FontChange(Sender: TObject); begin if Assigned(FOldFontChanged) then FOldFontChanged(Sender); if Font.Size <> 0 then FTextStyle.Font.Assign(Font); end; function TKCustomMemo.GetActiveBlock: TKMemoBlock; var DummyLocalIndex, Index: TKMemoSelectionIndex; begin Index := ActiveBlocks.SelEnd; if SelAvail and (ActiveBlocks.SelEnd > ActiveBlocks.SelStart) then Dec(Index); Result := ActiveBlocks.IndexToBlock(Index, DummyLocalIndex); end; function TKCustomMemo.GetActiveBlocks: TKMemoBlocks; begin Result := ActiveBlocks; end; function TKCustomMemo.GetActiveInnerBlock: TKMemoBlock; var Index, LocalIndex: TKMemoSelectionIndex; Items: TKmemoBlocks; begin Index := ActiveBlocks.SelEnd; if SelAvail and (ActiveBlocks.SelEnd > ActiveBlocks.SelStart) then Dec(Index); Items := ActiveBlocks.IndexToBlocks(Index, LocalIndex); if Items <> nil then Result := Items.IndexToBlock(LocalIndex, LocalIndex) else Result := nil; end; function TKCustomMemo.GetActiveInnerBlocks: TKMemoBlocks; var DummyLocalIndex: TKMemoSelectionIndex; begin Result := ActiveBlocks.IndexToBlocks(ActiveBlocks.RealSelEnd, DummyLocalIndex); end; function TKCustomMemo.GetCaretRect: TRect; begin Result := FCaretRect; end; function TKCustomMemo.GetCaretVisible: Boolean; begin Result := elCaretVisible in FStates; end; function TKCustomMemo.GetContentHeight: Integer; begin Result := FVertExtent; end; function TKCustomMemo.GetContentLeft: Integer; begin Result := -FLeftPos + FContentPadding.Left; end; function TKCustomMemo.GetContentRect: TRect; begin Result.Left := ContentLeft; Result.Top := ContentTop; Result.Right := Result.Left + ContentWidth; Result.Bottom := Result.Top + ContentHeight; end; function TKCustomMemo.GetContentTop: Integer; begin Result := -FTopPos + FContentPadding.Top; end; function TKCustomMemo.GetContentWidth: Integer; begin Result := FHorzExtent; end; function TKCustomMemo.GetDefaultTextStyle: TKMemoTextStyle; begin Result := FTextStyle; end; function TKCustomMemo.GetDrawSingleChars: Boolean; begin Result := (eoDrawSingleChars in FOptions) or (elPrinting in FStates); end; function TKCustomMemo.GetDefaultParaStyle: TKMemoParaStyle; begin Result := FParaStyle; end; function TKCustomMemo.GetEmpty: Boolean; begin Result := FBlocks.Empty; end; function TKCustomMemo.GetHorzScrollPadding: Integer; begin Result := Min(FScrollPadding, ClientWidth div 8); end; function TKCustomMemo.GetInsertMode: Boolean; begin Result := not (elOverwrite in FStates); end; function TKCustomMemo.GetLinePosition: TKMemoLinePosition; begin Result := FLinePosition; end; function TKCustomMemo.GetListTable: TKMemoListTable; begin Result := FListTable; end; function TKCustomMemo.GetModified: Boolean; begin Result := (elModified in FStates) or FUndoList.Modified; end; function TKCustomMemo.GetNearestParagraph: TKMemoParagraph; begin Result := ActiveBlocks.BlockIndexToBlock(GetNearestParagraphIndex) as TKMemoParagraph; end; function TKCustomMemo.GetNearestParagraphIndex: TKMemoBlockIndex; var BlockIndex: TKMemoBlockIndex; LocalIndex: TKMemoSelectionIndex; begin BlockIndex := ActiveBlocks.IndexToBlockIndex(RealSelEnd, LocalIndex); if BlockIndex >= 0 then Result := ActiveBlocks.GetNearestParagraphBlockIndex(BlockIndex) else Result := -1; end; function TKCustomMemo.GetNearestWordIndexes(AIndex: TKMemoSelectionIndex; AIncludeWhiteSpaces: Boolean; out AStartIndex, AEndIndex: TKMemoSelectionIndex): Boolean; begin Result := ActiveBlocks.GetNearestWordIndexes(AIndex, True, AIncludeWhiteSpaces, AStartIndex, AEndIndex); end; function TKCustomMemo.GetPaintSelection: Boolean; begin if elPrinting in FStates then Result := poPaintSelection in PageSetup.Options else Result := True; end; function TKCustomMemo.GetPixelsPerInchX: Integer; begin if HandleAllocated then Result := PixelsPerInchX(Handle) else Result := PixelsPerInchX(0) end; function TKCustomMemo.GetPixelsPerInchY: Integer; begin if HandleAllocated then Result := PixelsPerInchY(Handle) else Result := PixelsPerInchY(0) end; function TKCustomMemo.GetPrinting: Boolean; begin Result := elPrinting in FStates; end; function TKCustomMemo.GetMaxLeftPos: Integer; begin Result := FHorzExtent - ClientWidth; end; function TKCustomMemo.GetMaxTopPos: Integer; begin Result := FVertExtent - ClientHeight; end; function TKCustomMemo.GetMaxWordLength: TKMemoSelectionIndex; begin Result := FMaxWordLength; end; function TKCustomMemo.GetMemo: TKCustomMemo; begin Result := Self; end; function TKCustomMemo.GetReadOnly: Boolean; begin Result := elReadOnly in FStates; end; function TKCustomMemo.GetRealSelEnd: TKMemoSelectionIndex; begin Result := ActiveBlocks.RealSelEnd; end; function TKCustomMemo.GetRealSelLength: TKMemoSelectionIndex; begin Result := RealSelEnd - RealSelStart; end; function TKCustomMemo.GetRealSelStart: TKMemoSelectionIndex; begin Result := ActiveBlocks.RealSelStart; end; function TKCustomMemo.GetRelativeSelected: Boolean; begin Result := (FSelectedBlock <> nil) and (FSelectedBlock.Position <> mbpText); end; function TKCustomMemo.GetRequiredContentWidth: Integer; begin if FRequiredContentWidth > 0 then Result := FRequiredContentWidth else Result := ClientWidth - FContentPadding.Left - FContentPadding.Right; end; function TKCustomMemo.GetRTF: TKMemoRTFString; var Stream: TStringStream; begin Stream := TStringStream.Create{$IFnDEF COMPILER12_UP}(''){$ENDIF}; try ActiveBlocks := FBlocks; SaveToRTFStream(Stream, False); Result := Stream.DataString; finally Stream.Free; end; end; function TKCustomMemo.GetSelAvail: Boolean; begin Result := SelLength <> 0; end; procedure TKCustomMemo.GetSelColors(out Foreground, Background: TColor); begin if Focused then begin Foreground := FColors.SelTextFocused; Background := FColors.SelBkGndFocused; end else begin Foreground := FColors.SelText; Background := FColors.SelBkGnd; end; end; function TKCustomMemo.GetSelectableLength: TKMemoSelectionIndex; begin Result := ActiveBlocks.SelectableLength; end; function TKCustomMemo.GetSelectedBlock: TKMemoBlock; begin Result := FSelectedBlock; end; function TKCustomMemo.GetSelectionHasPara: Boolean; begin Result := ActiveBlocks.SelectionHasPara; end; function TKCustomMemo.GetSelectionParaStyle: TKMemoParaStyle; begin Result := ActiveBlocks.SelectionParaStyle; if Result = nil then Result := FParaStyle; end; function TKCustomMemo.GetSelectionTextStyle: TKMemoTextStyle; begin Result := ActiveBlocks.SelectionTextStyle; if Result = nil then Result := FTextStyle; end; function TKCustomMemo.GetSelEnd: TKMemoSelectionIndex; begin Result := ActiveBlocks.SelEnd; end; function TKCustomMemo.GetSelLength: TKMemoSelectionIndex; begin Result := ActiveBlocks.SelLength; end; function TKCustomMemo.GetSelStart: TKMemoSelectionIndex; begin Result := ActiveBlocks.SelStart end; function TKCustomMemo.GetSelText: TKString; begin Result := ActiveBlocks.SelText; end; function TKCustomMemo.GetShowFormatting: Boolean; begin if elPrinting in States then Result := False else Result := eoShowFormatting in FOptions; end; function TKCustomMemo.GetText: TKString; begin Result := ActiveBlocks.Text; end; function TKCustomMemo.GetUndoLimit: Integer; begin Result := FUndoList.Limit; end; function TKCustomMemo.GetVertScrollPadding: Integer; begin Result := Min(FScrollPadding, ClientHeight div 8); end; function TKCustomMemo.GetVisible: Boolean; begin Result := inherited Visible; end; function TKCustomMemo.GetWordBreaks: TKSysCharSet; begin Result := FWordBreaks; end; function TKCustomMemo.GetWrapSingleChars: Boolean; begin Result := eoWrapSingleChars in FOptions; end; function TKCustomMemo.HasFocus: Boolean; begin Result := Focused; end; procedure TKCustomMemo.HideEditorCaret; begin if HandleAllocated then HideCaret(Handle); end; function TKCustomMemo.IndexToRect(AValue: TKMemoSelectionIndex; ACaret: Boolean): TRect; begin Result := BlockRectToRect(ActiveBlocks.IndexToRect(Canvas, AValue, ACaret, ActiveBlocks.EOLToNormal(AValue))); end; procedure TKCustomMemo.InsertChar(At: TKMemoSelectionIndex; const AValue: TKChar); var Style: TKMemoTextStyle; begin if FNewTextStyleValid then begin Style := FNewTextStyle; FNewTextStyleValid := False; end else Style := nil; ActiveBlocks.InsertChar(At, AValue, elOverwrite in FStates, Style); Modified := True; end; procedure TKCustomMemo.InsertNewLine(At: TKMemoSelectionIndex); begin ActiveBlocks.InsertNewLine(At); Modified := True; end; procedure TKCustomMemo.InsertString(At: TKMemoSelectionIndex; const AValue: TKString); begin if AValue <> '' then begin BeginUndoGroup(ckInsert); try if ActiveBlocks.SelLength > 0 then begin ActiveBlocks.ClearSelection; At := ActiveBlocks.SelEnd; end; // always insert (don't overwrite) ActiveBlocks.InsertString(At, True, AValue); finally EndUndoGroup; end; Modified := True; end end; function TKCustomMemo.IsOptionsStored: Boolean; begin Result := FOptions <> cKMemoOptionsDef; end; procedure TKCustomMemo.KeyDown(var Key: Word; Shift: TShiftState); var Cmd: TKEditCommand; begin inherited; Exclude(FStates, elIgnoreNextChar); if not (csDesigning in ComponentState) then begin Cmd := FKeyMapping.FindCommand(Key, Shift); if Cmd <> ecNone then begin ExecuteCommand(Cmd); Key := 0; Include(FStates, elIgnoreNextChar); end; case Key of VK_ESCAPE: begin Include(FStates, elIgnoreNextChar); CancelDrag; end; VK_SHIFT, VK_CONTROL, VK_MENU: begin UpdateMouseCursor; end; end; end; end; {$IFDEF FPC} procedure TKCustomMemo.UTF8KeyPress(var Key: TUTF8Char); {$ELSE} procedure TKCustomMemo.KeyPress(var Key: Char); {$ENDIF} var C: TKCHar; begin inherited; if not (csDesigning in ComponentState) then begin if not (elIgnoreNextChar in FStates) then begin {$IF DEFINED(FPC) OR DEFINED(COMPILER12_UP)} C := Key; {$ELSE} C := AnsiStringToString(Key)[1]; {$IFEND} ExecuteCommand(ecInsertChar, @C); end else Exclude(FStates, elIgnoreNextChar); end; end; procedure TKCustomMemo.KeyUp(var Key: Word; Shift: TShiftState); begin inherited; if not (csDesigning in ComponentState) then begin case Key of VK_SHIFT, VK_CONTROL, VK_MENU: UpdateMouseCursor; end; end; end; procedure TKCustomMemo.LateUpdate(var Msg: TLMessage); begin inherited; case Msg.Msg of KM_SCROLL: UpdateScrollRange(True); end; end; procedure TKCustomMemo.ListChanged(AList: TKMemoList; ALevel: TKMemoListLevel); begin FBlocks.ListChanged(AList, ALevel); if FBlocks.UpdateUnlocked then Modified := True; end; procedure TKCustomMemo.LoadFromFile(const AFileName: TKString); var Ext: TKString; begin Ext := LowerCase(ExtractFileExt(AFileName)); if Ext = '.rtf' then LoadFromRTF(AFileName) else LoadFromTXT(AFileName); end; procedure TKCustomMemo.LoadFromRTF(const AFileName: TKString); var Reader: TKMemoRTFReader; begin Reader := TKMemoRTFReader.Create(Self); try Clear(False); Reader.LoadFromFile(AFileName, Blocks, -1); finally Reader.Free; end; end; procedure TKCustomMemo.LoadFromRTFStream(AStream: TStream; AtIndex: TKMemoSelectionIndex); var Reader: TKMemoRTFReader; begin Reader := TKMemoRTFReader.Create(Self); try Reader.LoadFromStream(AStream, ActiveBlocks, AtIndex); finally Reader.Free; end; end; procedure TKCustomMemo.LoadFromTXT(const AFileName: TKString); var List: TStringList; begin if FileExists(AFileName) then begin Clear(False); List := TStringList.Create; try List.LoadFromFile(AFileName); Text := List.Text; finally List.Free; end; end; end; procedure TKCustomMemo.LoadFromTXTStream(AStream: TStream); var List: TStringList; begin Clear(False); List := TStringList.Create; try List.LoadFromStream(AStream); Text := List.Text; finally List.Free; end; end; procedure TKCustomMemo.MeasurePages(var Info: TKPrintMeasureInfo); var FitToPage: Boolean; Scale: Double; PageHeight, PageCount: Integer; APageSetup: TKPrintPageSetup; begin APageSetup := PageSetup; FitToPage := poFitToPage in APageSetup.Options; Scale := APageSetup.Scale / 100; Info.ControlHorzPageCount := 1; // no horizontal page splitting yet, cut it if ContentWidth > 0 then begin if FitToPage then Scale := APageSetup.MappedControlPaintAreaWidth / ContentWidth; PageHeight := Round(APageSetup.MappedPaintAreaHeight / Scale); PrepareToPrint(Scale); PageCount := FBlocks.GetPageCount(PageHeight); Info.OutlineWidth := FBlocks.Width; Info.OutlineHeight := PageCount * PageHeight; Info.ControlVertPageCount := PageCount; end else Info.ControlVertPageCount := 1; end; procedure TKCustomMemo.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var P: TPoint; Action: TKMemoMouseAction; StartIndex, EndIndex: TKMemoSelectionIndex; begin inherited; if Enabled then begin P := Point(X, Y); case Button of mbRight: Action := maRightDown; mbMiddle: Action := maMidDown; else Action := maLeftDown; end; if not FBlocks.MouseAction(Action, Canvas, PointToBlockPoint(P, False), Shift) then begin if Button = mbLeft then begin SetActiveBlocksForPoint(P); if ssDouble in Shift then begin GetNearestWordIndexes(SelEnd, False, StartIndex, EndIndex); Select(StartIndex, EndIndex - StartIndex, False); end else begin Include(FStates, elMouseCapture); SelectionInit(P, False); end; ClampInView(nil, eoScrollWindow in FOptions); end; end; SafeSetFocus; end; end; procedure TKCustomMemo.MouseMove(Shift: TShiftState; X, Y: Integer); var P: TPoint; begin inherited; P := Point(X, Y); if FStates * [elMouseDrag, elMouseDragInit] <> [] then DragBlock else if elMouseCapture in FStates then begin if not FScrollTimer.Enabled then SelectionExpand(P, True); end else begin UpdateMouseCursor; end; end; procedure TKCustomMemo.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var Action: TKMemoMouseAction; P: TPoint; begin inherited; FStates := FStates - [elMouseCapture, elMouseDragInit]; UpdateEditorCaret; if elMouseDrag in FStates then MoveBlock else begin case Button of mbRight: Action := maRightUp; mbMiddle: Action := maMidUp; else Action := maLeftUp; end; P := Point(X, Y); FBlocks.MouseAction(Action, Canvas, PointToBlockPoint(P, False), Shift); end; UpdateMouseCursor; end; procedure TKCustomMemo.MoveBlock; begin if elMouseDrag in FStates then begin Exclude(FStates, elMouseDrag); FDragRect := NormalizeRect(FDragRect); if (FSelectedBlock <> nil) and not EqualRect(FDragRect, FDragOrigRect) then begin FSelectedBlock.LockUpdate; try FSelectedBlock.LeftOffset := FSelectedBlock.LeftOffset + FDragRect.Left - FDragOrigRect.Left; FSelectedBlock.TopOffset := FSelectedBlock.TopOffset + FDragRect.Top - FDragOrigRect.Top; FSelectedBlock.Resize(FDragRect.Right - FDragRect.Left, FDragRect.Bottom - FDragRect.Top); finally FSelectedBlock.UnlockUpdate; end; Modified := True; end; end; end; procedure TKCustomMemo.MoveCaretToMouseCursor(AIfOutsideOfSelection: Boolean); var P: TPoint; Index: TKMemoSelectionIndex; Move: Boolean; begin if Enabled then begin SafeSetFocus; P := ScreenToClient(Mouse.CursorPos); if AIfOutsideOfSelection then begin Index := PointToIndex(P, True, False, FLinePosition); Move := (Index < RealSelStart) or (Index > RealSelEnd); end else Move := True; if Move then begin SetActiveBlocksForPoint(P); SelectionInit(P, False); ClampInView(nil, eoScrollWindow in FOptions); end; end; end; procedure TKCustomMemo.PaintContent(ACanvas: TCanvas; const ARect: TRect; ALeftOfs, ATopOfs: Integer); var H, X, Y, SaveIndex: Integer; begin SaveIndex := SaveDC(ACanvas.handle); // don't delete try if (FColors.BkGnd <> clNone) or (FBackground.Color <> clNone) then begin if FBackground.Color <> clNone then Brush.Color := FBackground.Color else Brush.Color := FColors.BkGnd; Brush.Style := bsSolid; ACanvas.Brush.Assign(Brush); ACanvas.FillRect(ARect); end; if (FBackground.Image.Graphic <> nil) and not FBackground.Image.Graphic.Empty then begin X := ARect.Left + (ALeftOfs - FContentPadding.Left) mod FBackground.Image.Width; Y := ARect.Top + (ATopOfs - FContentPadding.Top) mod FBackground.Image.Height; H := X; while Y < ARect.Bottom do begin ACanvas.Draw(X, Y, FBackground.Image.Graphic); Inc(X, FBackground.Image.Width); if not FBackground.RepeatX or (X >= ARect.Right) then begin if FBackground.RepeatY then Inc(Y, FBackground.Image.Height) else Y := ARect.Bottom; X := H; end; end; end; FBlocks.PaintToCanvas(ACanvas, ALeftOfs, ATopOfs, ARect); finally RestoreDC(ACanvas.Handle, SaveIndex); end; end; procedure TKCustomMemo.PaintPage; var AreaWidth, AreaHeight, PageOffset, PageHeight: Integer; TmpRect, TmpRect1: TRect; APageSetup: TKPrintPageSetup; begin // poSelOnly not supported // poUseColor not supported - always paints in colors APageSetup := PageSetup; AreaWidth := Round(APageSetup.MappedControlPaintAreaWidth / APageSetup.CurrentScale); AreaHeight := Round(APageSetup.MappedPaintAreaHeight / APageSetup.CurrentScale); TmpRect := Rect(0, 0, APageSetup.MappedOutlineWidth, APageSetup.MappedOutlineHeight); FBlocks.GetPageData(AreaHeight, APageSetup.CurrentPageControl - 1, PageOffset, PageHeight); TmpRect1 := Rect(0, 0, AreaWidth, PageHeight); IntersectRect(TmpRect, TmpRect, TmpRect1); TmpRect1 := TmpRect; TranslateRectToDevice(APageSetup.Canvas.Handle, TmpRect1); SelectClipRect(APageSetup.Canvas.Handle, TmpRect1); PaintContent(APageSetup.Canvas, TmpRect, 0, - PageOffset); end; procedure TKCustomMemo.PaintToCanvas(ACanvas: TCanvas); begin {$IFDEF FPC} if CaretVisible then HideEditorCaret; try {$ENDIF} PrepareToPaint(ACanvas); // select valid clipping region RgnSelectAndDelete(ACanvas.Handle, CreateRectRgn(0, 0, ClientWidth, ClientHeight)); PaintContent(ACanvas, ClientRect, ContentLeft, ContentTop); if elMouseDrag in FStates then begin SetBkColor(ACanvas.Handle, $FFFFFF); SetTextColor(ACanvas.Handle, 0); ACanvas.DrawFocusRect(NormalizeRect(FDragRect)); end; {$IFDEF FPC} finally if CaretVisible then ShowEditorCaret; end; {$ENDIF} end; procedure TKCustomMemo.ParaStyleChanged(Sender: TObject; AReasons: TKMemoUpdateReasons); begin FBlocks.NotifyDefaultParaChange; end; function TKCustomMemo.PointToBlockPoint(const APoint: TPoint; ACalcActive: Boolean): TPoint; begin Result.X := APoint.X - ContentLeft; Result.Y := APoint.Y - ContentTop; if (ActiveBlocks <> FBlocks) and ACalcActive then begin OffsetPoint(Result, -ActiveBlocks.TotalLeftOffset, -ActiveBlocks.TotalTopOffset); end; end; function TKCustomMemo.PointToIndex(APoint: TPoint; AOutOfArea, ASelectionExpanding: Boolean; out ALinePos: TKMemoLinePosition): TKMemoSelectionIndex; begin Result := ActiveBlocks.PointToIndex(Canvas, PointToBlockPoint(APoint), AOutOfArea, ASelectionExpanding, ALinePos); end; procedure TKCustomMemo.PrepareToPaint(ACanvas: TCanvas); begin if elPrinting in FStates then begin Exclude(FStates, elPrinting); FBlocks.NotifyPrintEnd; FBlocks.MeasureExtent(ACanvas, RequiredContentWidth); end; end; procedure TKCustomMemo.PrepareToPrint(AScale: Double); begin if not (elPrinting in FStates) then begin Include(FStates, elPrinting); FBlocks.NotifyPrintBegin; FBlocks.MeasureExtent(Canvas, Round(PageSetup.MappedControlPaintAreaWidth / AScale)); end; end; procedure TKCustomMemo.PrintPaintBegin; begin PrepareToPrint(PageSetup.CurrentScale); end; procedure TKCustomMemo.PrintPaintEnd; begin end; function TKCustomMemo.Pt2PxX(AValue: Double): Integer; begin Result := PointsToPixels(AValue, GetPixelsPerInchX); end; function TKCustomMemo.Pt2PxY(AValue: Double): Integer; begin Result := PointsToPixels(AValue, GetPixelsPerInchY); end; function TKCustomMemo.Px2PtX(AValue: Integer): Double; begin Result := PixelsToPoints(AValue, GetPixelsPerInchX); end; function TKCustomMemo.Px2PtY(AValue: Integer): Double; begin Result := PixelsToPoints(AValue, GetPixelsPerInchY); end; procedure TKCustomMemo.SafeSetFocus; begin if not Focused and CanFocus and not (csDesigning in ComponentState) then SetFocus; end; procedure TKCustomMemo.SaveToFile(const AFileName: TKString; ASelectedOnly: Boolean); var Ext: TKString; begin Ext := LowerCase(ExtractFileExt(AFileName)); if Ext = '.rtf' then SaveToRTF(AFileName) else SaveToTXT(AFileName); end; procedure TKCustomMemo.SaveToRTF(const AFileName: TKString; ASelectedOnly: Boolean; AReadableOutput: Boolean); var Writer: TKMemoRTFWriter; begin ActiveBlocks := FBlocks; Writer := TKMemoRTFWriter.Create(Self); try Writer.ReadableOutput := AReadableOutput; Writer.SaveToFile(AFileName, ASelectedOnly); finally Writer.Free; end; end; procedure TKCustomMemo.SaveToRTFStream(AStream: TStream; ASelectedOnly: Boolean; AReadableOutput: Boolean); var Writer: TKMemoRTFWriter; begin Writer := TKMemoRTFWriter.Create(Self); try Writer.ReadableOutput := AReadableOutput; Writer.SaveToStream(AStream, ASelectedOnly); finally Writer.Free; end; end; procedure TKCustomMemo.SaveToTXT(const AFileName: TKString; ASelectedOnly: Boolean); var List: TStringList; begin List := TStringList.Create; try if ASelectedOnly then List.Text := FBlocks.SelText else List.Text := FBlocks.Text; List.SaveToFile(AFileName); finally List.Free; end; end; function TKCustomMemo.Scroll(CodeHorz, CodeVert, DeltaHorz, DeltaVert: Integer; ACallScrollWindow: Boolean): Boolean; function Axis(Code: Cardinal; HasScrollBar: Boolean; ScrollCode: Cardinal; Delta, MaxScrollPos, ScrollStep: Integer; var ScrollPos: Integer): Boolean; var OldPos, Pos: Integer; SI: TScrollInfo; begin Result := False; if HasScrollBar then begin FillChar(SI, SizeOf(TScrollInfo), 0); SI.cbSize := SizeOf(TScrollInfo); SI.fMask := SIF_PAGE or SIF_RANGE or SIF_TRACKPOS; GetScrollInfo(Handle, Code, SI); {$IFDEF UNIX} SI.nTrackPos := Delta; {$ENDIF} end; Pos := ScrollPos; OldPos := Pos; case ScrollCode of SB_TOP: Pos := 0; SB_BOTTOM: Pos := SI.nMax; SB_LINEUP: Dec(Pos, ScrollStep); SB_LINEDOWN: Inc(Pos, ScrollStep); SB_PAGEUP: Dec(Pos, SI.nPage); SB_PAGEDOWN: Inc(Pos, SI.nPage); SB_THUMBTRACK, SB_THUMBPOSITION: Pos := SI.nTrackPos; Cardinal(cScrollDelta): Inc(Pos, Delta); end; if Pos < MaxScrollPos then Pos := (Pos div ScrollStep) * ScrollStep; Pos := MinMax(Pos, 0, MaxScrollPos); if Pos <> OldPos then begin if HasScrollBar then begin FillChar(SI, SizeOf(TScrollInfo), 0); SI.cbSize := SizeOf(TScrollInfo); SI.nPos := Pos; SI.fMask := SIF_POS; SetScrollInfo(Handle, Code, SI, True); end; ScrollPos := Pos; Result := True; end; end; var OldLeftPos, OldTopPos: Integer; ScrollHorzAxis, ScrollVertAxis: Boolean; begin OldLeftPos := FLeftPos; OldTopPos := FTopPos; ScrollHorzAxis := Axis(SB_HORZ, FScrollBars in [ssHorizontal, ssBoth], CodeHorz, DeltaHorz, FHorzScrollExtent, FHorzScrollStep, FLeftPos); ScrollVertAxis := Axis(SB_VERT, FScrollBars in [ssVertical, ssBoth], CodeVert, DeltaVert, FVertScrollExtent, FVertScrollStep, FTopPos); Result := ScrollHorzAxis or ScrollVertAxis; if Result then begin if ACallScrollWindow then ScrollWindowEx(Handle, OldLeftPos - FLeftPos, OldTopPos - FTopPos, nil, nil, 0, nil, SW_INVALIDATE) else Invalidate; UpdateEditorCaret; Inc(FPreferredCaretPos, OldLeftPos - FLeftPos); end; end; function TKCustomMemo.ScrollBy(DeltaHorz, DeltaVert: Integer; ACallScrollWindow: Boolean): Boolean; begin Result := Scroll(cScrollDelta, cScrollDelta, DeltaHorz, DeltaVert, ACallScrollWindow); end; procedure TKCustomMemo.ScrollToClientAreaCenter; var R: TRect; begin R := IndexToRect(SelEnd, True); ScrollBy(R.Left - ClientWidth div 2, R.Top - ClientHeight div 2, eoScrollWindow in FOptions); end; function TKCustomMemo.ScrollNeeded(AMousePos: PPoint; out DeltaCol, DeltaRow: Integer): Boolean; var HScrollPadding, VScrollPadding: Integer; begin DeltaCol := 0; DeltaRow := 0; HScrollPadding := HorzScrollPadding; VScrollPadding := VertScrollPadding; if AMousePos <> nil then begin if AMousePos.X < HScrollPadding then DeltaCol := AMousePos.X - HScrollPadding else if AMousePos.X > ClientWidth - HScrollPadding then DeltaCol := AMousePos.X - ClientWidth + HScrollPadding; if AMousePos.Y < VScrollPadding then DeltaRow := AMousePos.Y - VScrollPadding else if AMousePos.Y > ClientHeight - VScrollPadding then DeltaRow := AMousePos.Y - ClientHeight + VScrollPadding; end else begin if FCaretRect.Left < HScrollPadding then DeltaCol := FCaretRect.Left - HScrollPadding else if FCaretRect.Left + FCaretRect.Right > ClientWidth - HScrollPadding then DeltaCol := FCaretRect.Left + FCaretRect.Right - ClientWidth + HScrollPadding; if FCaretRect.Top < VScrollPadding then DeltaRow := FCaretRect.Top - VScrollPadding else if FCaretRect.Top + FCaretRect.Bottom > ClientHeight - VScrollPadding then DeltaRow := FCaretRect.Top + FCaretRect.Bottom - ClientHeight + VScrollPadding; end; Result := (DeltaCol <> 0) or (DeltaRow <> 0); end; procedure TKCustomMemo.ScrollTimerHandler(Sender: TObject); var DeltaHorz, DeltaVert: Integer; MousePos: TPoint; begin if (elMouseCapture in FStates) and not Dragging then begin MousePos := ScreenToClient(Mouse.CursorPos); SelectionExpand(MousePos, False); if ScrollNeeded(@MousePos, DeltaHorz, DeltaVert) then Scroll(cScrollDelta, cScrollDelta, DeltaHorz, DeltaVert, False) else if ScrollNeeded(nil, DeltaHorz, DeltaVert) then Scroll(cScrollDelta, cScrollDelta, DeltaHorz, DeltaVert, False) else FScrollTimer.Enabled := False; end else FScrollTimer.Enabled := False; end; procedure TKCustomMemo.Select(ASelStart, ASelLength: TKMemoSelectionIndex; ADoScroll: Boolean); begin if FSelectedBlock <> nil then begin FSelectedBlock.Select(0, 0, False); FSelectedBlock := nil; end; ActiveBlocks.Select(ASelStart, ASelLength, ADoScroll); end; procedure TKCustomMemo.SelectionExpand(ASelEnd: TKMemoSelectionIndex; ADoScroll: Boolean; APosition: TKMemoLinePosition); begin FLinePosition := APosition; Select(SelStart, ASelEnd - SelStart, ADoScroll); end; procedure TKCustomMemo.SelectionExpand(const APoint: TPoint; ADoScroll: Boolean); var NewSelEnd: TKMemoSelectionIndex; begin NewSelEnd := PointToIndex(APoint, True, True, FLinePosition); Select(SelStart, NewSelEnd - SelStart, ADoScroll); end; procedure TKCustomMemo.SelectionInit(ASelStart: TKMemoSelectionIndex; ADoScroll: Boolean; APosition: TKMemoLinePosition); begin FNewTextStyleValid := False; FLinePosition := APosition; Select(ASelStart, 0, ADoScroll); end; procedure TKCustomMemo.SelectionInit(const APoint: TPoint; ADoScroll: Boolean); var NewSelEnd: TKMemoSelectionIndex; begin FNewTextStyleValid := False; NewSelEnd := PointToIndex(APoint, True, False, FLinePosition); Select(NewSelEnd, 0, ADoScroll); UpdatePreferredCaretPos; end; function TKCustomMemo.SelectBlock(ABlock: TKMemoBlock; APosition: TKSizingGripPosition): Boolean; var StartIndex: TKMemoSelectionIndex; begin if ABlock.Position = mbpText then begin ActiveBlocks := ABlock.ParentRootBlocks; StartIndex := ActiveBlocks.BlockToIndex(ABlock); Result := StartIndex >= 0; if Result and (FSelectedBlock <> ABlock) then begin Select(StartIndex, ABlock.SelectableLength); FSelectedBlock := ABlock; end; end else begin // just select locally without scrolling and invalidate if ABlock is TKMemoContainer then begin ActiveBlocks := TKmemoContainer(ABlock).Blocks; FSelectedBlock := ABlock; UpdateEditorCaret end else begin ActiveBlocks := FBlocks; Select(SelStart, 0, False); // clear any other selection FSelectedBlock := ABlock; ABlock.Select(0, ABlock.SelectableLength(True), False); end; Result := True; end; // initialize dragging if not ReadOnly and ((ABlock.Position <> mbpText) or (APosition <> sgpNone)) then begin FDragCurPos := ScreenToClient(Mouse.CursorPos); FDragMode := APosition; FDragRect := SizingRect(ABlock); FDragOrigRect := FDragRect; Include(FStates, elMouseDragInit); end; end; procedure TKCustomMemo.SetActiveBlocks(const Value: TKMemoBlocks); begin if FActiveBlocks <> Value then begin Select(-1, 0, False); FActiveBlocks := Value; end; end; procedure TKCustomMemo.SetActiveBlocksForPoint(const APoint: TPoint); var TmpBlocks: TKMemoBlocks; begin TmpBlocks := FBlocks.PointToBlocks(PointToBlockPoint(APoint, False)); if TmpBlocks <> nil then ActiveBlocks := TmpBlocks else ActiveBlocks := FBlocks; end; procedure TKCustomMemo.SetRangeParaStyle(AFrom, ATo: TKMemoSelectionIndex; AStyle: TKMemoParaStyle); begin ActiveBlocks.SetRangeParaStyle(AFrom, ATo, AStyle); Modified := True; end; procedure TKCustomMemo.SetRangeTextStyle(AFrom, ATo: TKMemoSelectionIndex; AStyle: TKMemoTextStyle); begin ActiveBlocks.SetRangeTextStyle(AFrom, ATo, AStyle); Modified := True; end; procedure TKCustomMemo.SetBackground(const Value: TKMemoBackground); begin FBackground.Assign(Value); end; procedure TKCustomMemo.SetColors(Value: TKMemoColors); begin FColors.Assign(Value); end; procedure TKCustomMemo.SetContentPadding(const Value: TKRect); begin FContentPadding.Assign(Value); end; procedure TKCustomMemo.SetDisabledDrawStyle(Value: TKEditDisabledDrawStyle); begin if Value <> FDisabledDrawStyle then begin FDisabledDrawStyle := Value; if not Enabled then Invalidate; end; end; procedure TKCustomMemo.SetLeftPos(Value: Integer); begin Value := MinMax(Value, 0, FHorzScrollExtent - 1); if Value <> FLeftPos then ScrollBy(Value - FLeftPos, 0, eoScrollWindow in FOptions); end; procedure TKCustomMemo.SetMaxWordLength(const Value: TKMemoSelectionIndex); begin if Value <> FMaxWordLength then begin FMaxWordLength := Value; UpdateScrollRange(True); end; end; procedure TKCustomMemo.SetModified(Value: Boolean); begin if Value <> GetModified then begin if Value then Include(FStates, elModified) else begin Exclude(FStates, elModified); if eoUndoAfterSave in FOptions then FUndoList.Modified := False else begin FUndoList.Clear; FRedoList.Clear; end; end; end; end; procedure TKCustomMemo.SetReqMouseCursor(ACursor: TCursor); begin FRequiredMouseCursor := ACursor; end; function TKCustomMemo.SetMouseCursor(X, Y: Integer): Boolean; var ACursor: TCursor; P: TPoint; begin P := Point(X, Y); if PtInRect(ContentRect, P) then begin ACursor := FRequiredMouseCursor; end else ACursor := crDefault; {$IFDEF FPC} FCursor := ACursor; SetTempCursor(ACursor); {$ELSE} Windows.SetCursor(Screen.Cursors[ACursor]); {$ENDIF} Result := True; end; procedure TKCustomMemo.SetNewTextStyle(const Value: TKMemoTextStyle); begin FNewTextStyle.Assign(Value); FNewTextStyleValid := True; end; procedure TKCustomMemo.SetOptions(const Value: TKEditOptions); var UpdateShowFormatting, UpdateSingleChars: Boolean; {$IFDEF MSWINDOWS} UpdateDropFiles: Boolean; {$ENDIF} begin if Value <> FOptions then begin UpdateShowFormatting := (eoShowFormatting in Value) <> (eoShowFormatting in FOptions); {$IFDEF MSWINDOWS} UpdateDropFiles := (eoDropFiles in Value) <> (eoDropFiles in FOptions); {$ENDIF} UpdateSingleChars := (eoDrawSingleChars in Value) <> (eoDrawSingleChars in FOptions); FOptions := Value; FBlocks.NotifyOptionsChange; if UpdateShowFormatting or UpdateSingleChars then BlocksChanged([muExtent]); {$IFDEF MSWINDOWS} // (un)register HWND as drop target if UpdateDropFiles and not (csDesigning in ComponentState) and HandleAllocated then DragAcceptFiles(Handle, (eoDropFiles in fOptions)); {$ENDIF} end; end; procedure TKCustomMemo.SetReadOnly(Value: Boolean); begin if Value <> GetReadOnly then begin if Value then Include(FStates, elReadOnly) else Exclude(FStates, elReadOnly); end; end; procedure TKCustomMemo.SetRequiredContentWidth(const Value: Integer); begin if Value <> FRequiredContentWidth then begin FRequiredContentWidth := Value; UpdateScrollRange(True); end; end; procedure TKCustomMemo.SetRTF(const Value: TKMemoRTFString); var Stream: TStringStream; begin Stream := TStringStream.Create{$IFnDEF COMPILER12_UP}(''){$ENDIF}; try Stream.WriteString(Value); Stream.Seek(0, soFromBeginning); Clear(False); LoadFromRTFStream(Stream, -1); finally Stream.Free; end; end; procedure TKCustomMemo.SetScrollBars(Value: TScrollStyle); begin if Value <> FScrollBars then begin FScrollBars := Value; {$IFDEF FPC} CallUpdateSize; {$ELSE} RecreateWnd; {$ENDIF} end; end; procedure TKCustomMemo.SetScrollPadding(Value: Integer); begin FScrollPadding := MinMax(Integer(Value), cScrollPaddingMin, cScrollPaddingMax); end; procedure TKCustomMemo.SetScrollSpeed(Value: Cardinal); begin Value := MinMax(Integer(Value), cScrollSpeedMin, cScrollSpeedMax); if Value <> FScrollSpeed then begin FScrollSpeed := Value; FScrollTimer.Enabled := False; FScrollTimer.Interval := FScrollSpeed; end; end; procedure TKCustomMemo.SetSelectionParaStyle(const Value: TKMemoParaStyle); begin ActiveBlocks.SelectionParaStyle := Value; Modified := True; end; procedure TKCustomMemo.SetSelectionTextStyle(const Value: TKMemoTextStyle); begin ActiveBlocks.SelectionTextStyle := Value; Modified := True; end; procedure TKCustomMemo.SetSelEnd(Value: TKMemoSelectionIndex); begin Select(SelStart, Value - SelStart); end; procedure TKCustomMemo.SetSelLength(Value: TKMemoSelectionIndex); begin Select(SelStart, Value); end; procedure TKCustomMemo.SetSelStart(Value: TKMemoSelectionIndex); begin Select(Value, SelEnd - Value); end; procedure TKCustomMemo.SetText(const Value: TKString); begin ActiveBlocks.LockUpdate; try ActiveBlocks.Clear; ActiveBlocks.Text := Value; finally ActiveBlocks.UnlockUpdate; end; end; procedure TKCustomMemo.SetTopPos(Value: Integer); begin Value := MinMax(Value, 0, FVertScrollExtent - 1); if Value <> FTopPos then ScrollBy(0, Value - FTopPos, eoScrollWindow in FOptions); end; procedure TKCustomMemo.SetUndoLimit(Value: Integer); begin Value := MinMax(Value, cUndoLimitMin, cUndoLimitMax); if Value <> FUndoList.Limit then begin FUndoList.Limit := Value; FRedoList.Limit := Value; end; end; procedure TKCustomMemo.SetVisible(Value: Boolean); begin FBlocks.LockUpdate; try inherited Visible := Value; finally FBlocks.UnLockUpdate; end; end; procedure TKCustomMemo.SetWordBreaks(const Value: TKSysCharSet); begin if Value <> FWordBreaks then begin FWordBreaks := Value; BlocksChanged([muExtent]); end; end; procedure TKCustomMemo.ShowEditorCaret; begin if HandleAllocated then begin {$IFDEF FPC} SetCaretPosEx(Handle, FCaretRect.Left, FCaretRect.Top); {$ELSE} SetCaretPos(FCaretRect.Left, FCaretRect.Top); {$ENDIF} ShowCaret(Handle); end; end; function TKCustomMemo.SizingRect(ABlock: TKMemoBlock): TRect; var OldActiveBlocks: TKMemoBlocks; begin Result := CreateEmptyRect; if ABlock <> nil then begin OldActiveBlocks := FActiveBlocks; try FActiveBlocks := FBlocks.GetParentBlocksForBlock(ABlock); if FActiveBlocks <> nil then Result := BlockRectToRect(ABlock.SizingRect); finally FActiveBlocks := OldActiveBlocks; end; end; end; function TKCustomMemo.SplitAt(AIndex: TKMemoSelectionIndex): TKMemoBlockIndex; var LocalIndex, InnerLocalIndex: TKMemoSelectionIndex; Items: TKmemoBlocks; Block, NewBlock: TKMemoBlock; begin Items := ActiveBlocks.IndexToBlocks(AIndex, LocalIndex); if Items <> nil then begin Result := Items.IndexToBlockIndex(LocalIndex, InnerLocalIndex); if InnerLocalIndex > 0 then begin Block := Items[Result]; NewBlock := Block.Split(InnerLocalIndex); if NewBlock <> nil then begin Inc(Result); Items.AddAt(NewBlock, Result); end; end; end else Result := 0; end; procedure TKCustomMemo.TextStyleChanged(Sender: TObject); begin FBlocks.NotifyDefaultTextChange; end; procedure TKCustomMemo.UndoChange(Sender: TObject; ItemKind: TKMemoChangeKind); begin { if (Sender = FUndoList) and (ItemKind <> ckCaretPos) then DoChange;} end; procedure TKCustomMemo.UpdateEditorCaret(AShow: Boolean); begin if HandleAllocated then begin Include(FStates, elCaretUpdate); try if SelLength = 0 then ActiveBlocks.FixEOL(SelEnd, True, FLinePosition); FCaretRect := IndexToRect(SelEnd, True); Dec(FCaretRect.Right, FCaretRect.Left); // Right is width Dec(FCaretRect.Bottom, FCaretRect.Top); // Bottom is height if AShow then begin if Enabled and Focused and not (csDesigning in ComponentState) and (SelLength = 0) and not (eoDisableCaret in FOptions) and not RelativeSelected then begin if not (elOverwrite in FStates) then FCaretRect.Right := MinMax(FCaretRect.Bottom div 10, 2, 3); if not (elCaretCreated in FStates) or (FOldCaretRect.Right <> FCaretRect.Right) or (FOldCaretRect.Bottom <> FCaretRect.Bottom) then begin if CreateCaret(Handle, 0, FCaretRect.Right, FCaretRect.Bottom) then begin ShowEditorCaret; Include(FStates, elCaretVisible); Include(FStates, elCaretCreated); end; end else if (FOldCaretRect.Left <> FCaretRect.Left) or (FOldCaretRect.Top <> FCaretRect.Top) then begin ShowEditorCaret; Include(FStates, elCaretVisible); end; FOldCaretRect := FCaretRect; end else if elCaretCreated in FStates then begin HideEditorCaret; {$IFDEF FPC} DestroyCaret(Handle); {$ELSE} DestroyCaret; {$ENDIF} FStates := FStates - [elCaretCreated, elCaretVisible]; end; end; finally Exclude(FStates, elCaretUpdate); end; end; end; procedure TKCustomMemo.UpdateMouseCursor; var P: TPoint; OldCursor, NewCursor: TCursor; DoUpdate: Boolean; begin if not (elMouseCapture in FStates) then begin DoUpdate := False; P := ScreenToClient(Mouse.CursorPos); NewCursor := crIBeam; if NewCursor <> FRequiredMouseCursor then begin FRequiredMouseCursor := NewCursor; DoUpdate := True; end; OldCursor := FRequiredMouseCursor; FBlocks.MouseAction(maMove, Canvas, PointToBlockPoint(P, False), GetShiftState); if FRequiredMouseCursor <> OldCursor then DoUpdate := True; if DoUpdate then SetMouseCursor(P.X, P.Y); end; end; procedure TKCustomMemo.UpdatePreferredCaretPos; begin FPreferredCaretPos := FCaretRect.Left - ContentLeft; if ActiveBlocks <> FBlocks then Dec(FPreferredCaretPos, ActiveBlocks.TotalLeftOffset); end; procedure TKCustomMemo.UpdateScrollRange(CallInvalidate: Boolean); var DeltaHorz, DeltaVert, ClientHorz, ClientVert: Integer; SI: TScrollInfo; SBVisible: Boolean; begin if HandleAllocated then begin if not UpdateUnlocked then Exit; if FInUpdateScrollRange then begin PostLateUpdate(FillMessage(KM_SCROLL, 0, 0), True); Exit; end; FInUpdateScrollRange := True; try FBlocks.MeasureExtent(Canvas, RequiredContentWidth); FHorzExtent := FBlocks.Width + FContentPadding.Left + FContentPadding.Right; FVertExtent := FBlocks.Height + FContentPadding.Top + FContentPadding.Bottom; ClientHorz := ClientWidth; ClientVert := ClientHeight; DeltaHorz := Max(FLeftPos + ClientHorz - FHorzExtent - 1, 0); DeltaVert := Max(FTopPos + ClientVert - FVertExtent - 1, 0); FHorzScrollExtent := 0; FVertScrollExtent := 0; if FScrollBars in [ssBoth, ssHorizontal, ssVertical] then begin SI.cbSize := SizeOf(TScrollInfo); SI.fMask := SIF_RANGE or SIF_PAGE or SIF_POS {$IFDEF UNIX}or SIF_UPDATEPOLICY{$ENDIF}; SI.nMin := 0; {$IFDEF UNIX} SI.nTrackPos := SB_POLICY_CONTINUOUS; {$ELSE} SI.nTrackPos := 0; {$ENDIF} if FScrollBars in [ssBoth, ssHorizontal] then begin SBVisible := ClientWidth < FHorzExtent; ShowScrollBar(Handle, SB_HORZ, SBVisible); if SBVisible then begin SI.nMax := FHorzExtent{$IFnDEF FPC}- 1{$ENDIF}; SI.nPage := ClientHorz; SI.nPos := FLeftPos; SetScrollInfo(Handle, SB_HORZ, SI, True); FHorzScrollExtent := Max(FHorzExtent - Integer(SI.nPage), 0); end; end else ShowScrollBar(Handle, SB_HORZ, False); if FScrollBars in [ssBoth, ssVertical] then begin SBVisible := ClientVert < FVertExtent; ShowScrollBar(Handle, SB_VERT, SBVisible); if SBVisible then begin SI.nMax := FVertExtent{$IFnDEF FPC}- 1{$ENDIF}; SI.nPage := ClientVert; SI.nPos := FTopPos; SetScrollInfo(Handle, SB_VERT, SI, True); FVertScrollExtent := Max(FVertExtent - Integer(SI.nPage), 0); end; end else ShowScrollBar(Handle, SB_VERT, False); end; if CallInvalidate then begin if not ScrollBy(-DeltaHorz, -DeltaVert, False) then begin UpdateEditorCaret; Invalidate; end; end; InvalidatePageSetup; PrepareToPaint(Canvas); finally FInUpdateScrollRange := False; end; end; end; procedure TKCustomMemo.UpdateSize; begin UpdateScrollRange(True); end; procedure TKCustomMemo.WMClear(var Msg: TLMessage); begin ExecuteCommand(ecClearAll); end; procedure TKCustomMemo.WMCopy(var Msg: TLMessage); begin ExecuteCommand(ecCopy); end; procedure TKCustomMemo.WMCut(var Msg: TLMessage); begin ExecuteCommand(ecCut); end; {$IFNDEF FPC} procedure TKCustomMemo.WMDropFiles(var Msg: TMessage); var I, FileCount: Integer; PathName: array[0..260] of Char; Point: TPoint; FilesList: TStringList; begin try if Assigned(FOnDropFiles) then begin FilesList := TStringList.Create; try FileCount := DragQueryFile(THandle(Msg.wParam), Cardinal(-1), nil, 0); DragQueryPoint(THandle(Msg.wParam), Point); for i := 0 to FileCount - 1 do begin DragQueryFile(THandle(Msg.wParam), I, PathName, SizeOf(PathName)); FilesList.Add(PathName); end; FOnDropFiles(Self, Point.X, Point.Y, FilesList); finally FilesList.Free; end; end; finally Msg.Result := 0; DragFinish(THandle(Msg.wParam)); end; end; {$ENDIF} procedure TKCustomMemo.WMEraseBkgnd(var Msg: TLMessage); begin Msg.Result := 1 end; procedure TKCustomMemo.WMGetDlgCode(var Msg: TLMNoParams); begin Msg.Result := DLGC_WANTARROWS; if eoWantTab in FOptions then Msg.Result := Msg.Result or DLGC_WANTTAB; end; procedure TKCustomMemo.WMHScroll(var Msg: TLMHScroll); begin SafeSetFocus; Scroll(Msg.ScrollCode, cScrollNoAction, Msg.Pos, 0, eoScrollWindow in FOptions); end; procedure TKCustomMemo.WMKillFocus(var Msg: TLMKillFocus); begin inherited; ExecuteCommand(ecLostFocus); end; procedure TKCustomMemo.WMPaste(var Msg: TLMessage); begin ExecuteCommand(ecPaste); end; procedure TKCustomMemo.WMSetFocus(var Msg: TLMSetFocus); begin inherited; ExecuteCommand(ecGotFocus); end; procedure TKCustomMemo.WMVScroll(var Msg: TLMVScroll); begin SafeSetFocus; Scroll(cScrollNoAction, Msg.ScrollCode, 0, Msg.Pos, eoScrollWindow in FOptions); end; { TKMemoBlock } constructor TKMemoBlock.Create; begin inherited; FOffset := CreateEmptyPoint; FDoubleClickState := mdblNone; FMouseCaptureWord := -1; FClickOnMouseUp := True; FOnClick := nil; FOnDblClick := nil; end; destructor TKMemoBlock.Destroy; begin if MemoNotifier <> nil then MemoNotifier.BlockFreeNotification(Self); inherited Destroy; end; function TKMemoBlock.EqualProperties(ASource: TKObject): Boolean; begin Result := False; end; function TKMemoBlock.ActiveBlocks: TKMemoBlocks; var Notifier: IKMemoNotifier; begin Notifier := MemoNotifier; if Notifier <> nil then Result := Notifier.GetActiveBlocks else Result := nil; end; procedure TKMemoBlock.Assign(ASource: TKObject); begin if ASource is TKMemoBlock then begin Select(TKMemoBlock(ASource).SelStart, TKMemoBlock(ASource).SelLength, False); OnClick := TKMemoBlock(ASource).OnClick; OnDblClick := TKMemoBlock(ASource).OnDblClick; AssignAttributes(TKMemoBlock(ASource)); end; end; procedure TKMemoBlock.AssignAttributes(ABlock: TKMemoBlock); begin if ABlock <> nil then begin Position := ABlock.Position; LeftOffset := ABlock.LeftOffset; TopOffset := ABlock.TopOffset; end; end; function TKMemoBlock.CalcAscent(ACanvas: TCanvas): Integer; begin Result := 0; end; procedure TKMemoBlock.CallAfterUpdate; begin if ParentBlocks <> nil then ParentBlocks.UnlockUpdate; end; procedure TKMemoBlock.CallBeforeUpdate; begin if ParentBlocks <> nil then ParentBlocks.LockUpdate; end; function TKMemoBlock.CanAdd(ABlock: TKMemoBlock): Boolean; begin Result := False; end; procedure TKMemoBlock.ClearSelection(ATextOnly: Boolean); begin end; function TKMemoBlock.Concat(ABlock: TKMemoBlock): Boolean; begin Result := False; end; function TKMemoBlock.ContentLength: TKMemoSelectionIndex; begin Result := 0; end; function TKMemoBlock.GetBottomPadding: Integer; begin Result := 0; end; function TKMemoBlock.GetBoundsRect: TRect; begin Result := Rect(Left, Top, Left + Width, Top + Height); end; function TKMemoBlock.GetCanAddText: Boolean; begin Result := False; end; function TKMemoBlock.GetWrapMode: TKMemoBlockWrapMode; begin Result := wrAround; end; function TKMemoBlock.GetDefaultParaStyle: TKMemoParaStyle; begin if Parent <> nil then Result := ParentBlocks.DefaultParaStyle else Result := nil; end; function TKMemoBlock.GetDefaultTextStyle: TKMemoTextStyle; begin if Parent <> nil then Result := ParentBlocks.DefaultTextStyle else Result := nil; end; function TKMemoBlock.GetHeight: Integer; var I: Integer; begin Result := 0; for I := 0 to WordCount - 1 do Result := Max(Result, WordTop[I] + WordHeight[I]); Dec(Result, Top); end; function TKMemoBlock.GetLeft: Integer; var I: Integer; begin Result := WordLeft[0]; for I := 1 to WordCount - 1 do Result := Min(Result, WordLeft[I]); end; function TKMemoBlock.GetMemoNotifier: IKMemoNotifier; begin if Parent <> nil then Result := ParentBlocks.MemoNotifier else Result := nil; end; function TKMemoBlock.GetPaintSelection: Boolean; var Notifier: IKMemoNotifier; begin Notifier := MemoNotifier; if Notifier <> nil then Result := Notifier.GetPaintSelection else Result := False; end; function TKMemoBlock.GetParaStyle: TKMemoParaStyle; begin Result := nil; end; function TKMemoBlock.GetParentBlocks: TKMemoBlocks; begin Result := Parent as TKMemoBlocks; end; function TKMemoBlock.GetParentRootBlocks: TKMemoBlocks; var Block: TKMemoBlock; begin Result := ParentBlocks; if Result <> nil then begin Block := Result.Parent; while (Block <> nil) and (Block.Position = mbpText) do begin if Block.ParentBlocks <> nil then begin Result := Block.ParentBlocks; Block := Result.Parent end else Block := nil; end; end; end; function TKMemoBlock.GetPrinting: Boolean; var Notifier: IKMemoNotifier; begin Notifier := MemoNotifier; if Notifier <> nil then Result := Notifier.GetPrinting else Result := False; end; function TKMemoBlock.GetReadOnly: Boolean; var Notifier: IKMemoNotifier; begin Notifier := MemoNotifier; if Notifier <> nil then Result := Notifier.GetReadOnly else Result := False; end; function TKMemoBlock.GetWordRect(Index: TKMemoWordIndex): TRect; begin Result.Left := WordLeft[Index]; Result.Top := WordTop[Index]; Result.Right := Result.Left + WordWidth[Index]; Result.Bottom := Result.Top + WordHeight[Index]; end; function TKMemoBlock.GetResizable: Boolean; begin Result := False; end; procedure TKMemoBlock.GetSelColors(out Foreground, Background: TColor); begin Foreground := cSelTextFocusedDef; Background := cSelBkGndFocusedDef; if Parent <> nil then ParentBlocks.GetSelColors(Foreground, Background); end; function TKMemoBlock.GetSelEnd: TKMemoSelectionIndex; begin Result := SelStart + SelLength; end; function TKMemoBlock.GetSelLength: TKMemoSelectionIndex; begin Result := 0; end; function TKMemoBlock.GetSelStart: TKMemoSelectionIndex; begin Result := -1; end; function TKMemoBlock.GetSelText: TKString; begin Result := ''; end; function TKMemoBlock.GetShowFormatting: Boolean; begin if Parent <> nil then Result := ParentBlocks.ShowFormatting else Result := False; end; function TKMemoBlock.GetSizingRect: TRect; begin Result := BoundsRect; KFunctions.OffsetRect(Result, RealLeftOffset, RealTopOffset); end; function TKMemoBlock.GetText: TKString; begin Result := ''; end; function TKMemoBlock.GetTop: Integer; var I: Integer; begin Result := WordTop[0]; for I := 1 to WordCount - 1 do Result := Min(Result, WordTop[I]); end; function TKMemoBlock.GetTopPadding: Integer; begin Result := 0; end; function TKMemoBlock.GetWidth: Integer; var I: Integer; begin Result := 0; for I := 0 to WordCount - 1 do Result := Max(Result, WordLeft[I] + WordWidth[I]); Dec(Result, Left); end; function TKMemoBlock.GetWordBaseLine(Index: TKMemoWordIndex): Integer; begin Result := 0; end; function TKMemoBlock.GetWordBottomPadding(Index: TKMemoWordIndex): Integer; begin Result := 0; end; function TKMemoBlock.GetWordBoundsRect(Index: TKMemoWordIndex): TRect; begin Result := CreateEmptyRect; end; function TKMemoBlock.GetWordBreakable(Index: TKMemoWordIndex): Boolean; begin Result := True; end; function TKMemoBlock.GetWordClipped(Index: TKMemoWordIndex): Boolean; begin Result := False; end; function TKMemoBlock.GetWordCount: Integer; begin Result := 0; end; function TKMemoBlock.GetWordHeight(Index: TKMemoWordIndex): Integer; begin Result := 0; end; procedure TKMemoBlock.GetWordIndexes(AIndex: TKMemoSelectionIndex; out ASt, AEn: TKMemoSelectionIndex); begin ASt := 0; AEn := 0; end; function TKMemoBlock.GetWordLeft(Index: TKMemoWordIndex): Integer; begin Result := 0; end; function TKMemoBlock.GetWordLength(Index: TKMemoWordIndex): TKMemoSelectionIndex; begin Result := 0; end; function TKMemoBlock.GetWordLengthWOWS(Index: TKMemoWordIndex): TKMemoSelectionIndex; begin Result := GetWordLength(Index); end; function TKMemoBlock.GetWords(Index: TKMemoWordIndex): TKString; begin Result := ''; end; function TKMemoBlock.GetWordTop(Index: TKMemoWordIndex): Integer; begin Result := 0; end; function TKMemoBlock.GetWordTopPadding(Index: TKMemoWordIndex): Integer; begin Result := 0; end; function TKMemoBlock.GetWordWidth(Index: TKMemoWordIndex): Integer; begin Result := 0; end; function TKMemoBlock.IndexToRect(ACanvas: TCanvas; AIndex: TKMemoSelectionIndex; ACaret: Boolean): TRect; var Found: Boolean; WordIndex: TKMemoWordIndex; WLen: Integer; begin Result := CreateEmptyRect; Found := False; WordIndex := 0; WLen := 0; while not Found and (WordIndex < WordCount) do begin Result := WordIndexToRect(ACanvas, WordIndex, AIndex - WLen, ACaret); Inc(WLen, WordLength[WordIndex]); Inc(WordIndex); end; end; function TKMemoBlock.InsertParagraph(AIndex: TKMemoSelectionIndex): Boolean; var ParentBlock: TKMemoBlockIndex; NewItem: TKMemoBlock; begin Result := False; if Parent <> nil then begin ParentBlock := ParentBlocks.IndexOf(Self); NewItem := Split(AIndex); if NewItem <> nil then begin ParentBlocks.AddAt(NewItem, ParentBlock + 1); ParentBlocks.AddParagraph(ParentBlock + 1); end else begin if AIndex = 0 then ParentBlocks.AddParagraph(ParentBlock) else ParentBlocks.AddParagraph(ParentBlock + 1); end; Result := True; end; end; function TKMemoBlock.InsertString(const AText: TKString; At: TKMemoSelectionIndex): Boolean; begin Result := False; end; function TKMemoBlock.RealLeftOffset: Integer; begin if FPosition <> mbpText then Result := FOffset.X else Result := 0; end; function TKMemoBlock.RealTopOffset: Integer; begin if FPosition <> mbpText then Result := FOffset.Y else Result := 0; end; procedure TKMemoBlock.Resize(ANewWidth, ANewHeight: Integer); begin end; procedure TKMemoBlock.RestoreUpdateState(AValue: TKMemoUpdateReasons); begin if ParentBlocks <> nil then ParentBlocks.RestoreUpdateState(AValue); end; function TKMemoBlock.MeasureExtent(ACanvas: TCanvas; ARequiredWidth: Integer): TPoint; var I: Integer; Extent: TPoint; begin Result := CreateEmptyPoint; for I := 0 to WordCount - 1 do begin Extent := WordMeasureExtent(ACanvas, I, ARequiredWidth); Inc(Result.X, Extent.X); Result.Y := Max(Result.Y, Extent.Y); end; end; procedure TKMemoBlock.NotifyDefaultParaChange; begin end; procedure TKMemoBlock.NotifyDefaultTextChange; begin end; procedure TKMemoBlock.NotifyOptionsChange; begin end; procedure TKMemoBlock.NotifyPrintBegin; begin end; procedure TKMemoBlock.NotifyPrintEnd; begin end; procedure TKMemoBlock.PaintToCanvas(ACanvas: TCanvas; ALeft, ATop: Integer); var I: Integer; begin for I := 0 to WordCount - 1 do WordPaintToCanvas(ACanvas, I, ALeft, ATop); end; function TKMemoBlock.PixelsPerInchX: Integer; var Notifier: IKMemoNotifier; begin Notifier := MemoNotifier; if Notifier <> nil then Result := Notifier.GetPixelsPerInchX else Result := KEditCommon.PixelsPerInchX(0); end; function TKMemoBlock.PixelsPerInchY: Integer; var Notifier: IKMemoNotifier; begin Notifier := MemoNotifier; if Notifier <> nil then Result := Notifier.GetPixelsPerInchY else Result := KEditCommon.PixelsPerInchY(0); end; function TKMemoBlock.PointToIndex(ACanvas: TCanvas; const APoint: TPoint; AOutOfArea, ASelectionExpanding: Boolean; out APosition: TKMemoLinePosition): TKMemoSelectionIndex; var WordIndex: TKMemoWordIndex; begin Result := -1; WordIndex := 0; while (Result < 0) and (WordIndex < WordCount) do begin Result := WordPointToIndex(ACanvas, APoint, WordIndex, AOutOfArea, ASelectionExpanding, APosition); Inc(WordIndex); end; end; function TKMemoBlock.WordPointToIndex(ACanvas: TCanvas; const APoint: TPoint; AWordIndex: TKMemoWordIndex; AOutOfArea, ASelectionExpanding: Boolean; out APosition: TKMemoLinePosition): TKMemoSelectionIndex; begin Result := -1; end; function TKMemoBlock.SaveUpdateState: TKMemoUpdateReasons; begin if ParentBlocks <> nil then Result := ParentBlocks.SaveUpdateState else Result := []; end; function TKMemoBlock.Select(ASelStart, ASelLength: TKMemoSelectionIndex; ADoScroll: Boolean): Boolean; begin Result := False; end; function TKMemoBlock.SelectableLength(ALocalCalc: Boolean): TKMemoSelectionIndex; begin if (Position = mbpText) or ALocalCalc then Result := ContentLength else Result := 0; end; procedure TKMemoBlock.SelectAll; begin Select(0, SelectableLength, False); end; function TKMemoBlock.SelectedBlock: TKMemoBlock; var Notifier: IKMemoNotifier; begin Notifier := MemoNotifier; if Notifier <> nil then Result := Notifier.GetSelectedBlock else Result := nil; end; procedure TKMemoBlock.SetLeftOffset(const Value: Integer); begin if Value <> FOffset.X then begin FOffset.X := Value; Update([muExtent]); end; end; procedure TKMemoBlock.SetPosition(const Value: TKMemoBlockPosition); begin if Value <> FPosition then begin FPosition := Value; Update([muContent]); end; end; function TKMemoBlock.Click: Boolean; var Notifier: IKMemoNotifier; begin if Assigned(FOnClick) then begin FOnClick(Self); Result := True; end else begin Notifier := MemoNotifier; if Notifier <> nil then Result := Notifier.BlockClick(Self) else Result := False; end; end; function TKMemoBlock.DblClick: Boolean; var Notifier: IKMemoNotifier; begin if Assigned(FOnDblClick) then begin FOnDblClick(Self); Result := True; end else begin Notifier := MemoNotifier; if Notifier <> nil then Result := Notifier.BlockDblClick(Self) else Result := False; end; end; procedure TKMemoBlock.SetResizable(const Value: Boolean); begin Error('Resizable property unsupported for this block.'); end; procedure TKMemoBlock.SetTopOffset(const Value: Integer); var BlockIndex: TKMemoBlockIndex; Blocks: TKMemoBlocks; Block: TKMemoBlock; Y: Integer; begin if Value <> FOffset.Y then begin Y := Value; if (Y < 0) and (FPosition = mbpRelative) then begin Blocks := ParentBlocks; if Blocks <> nil then begin Blocks.LockUpdate; try // try to move block anchor first BlockIndex := Blocks.IndexOf(Self) - 1; if BlockIndex > 0 then begin Inc(Y, TopOffset); repeat BlockIndex := Blocks.GetNearestAnchorBlockIndex(BlockIndex); if BlockIndex >= 0 then begin Block := Blocks[BlockIndex]; Inc(Y, Block.Height); Dec(BlockIndex); end; until (Y >= 0) or (BlockIndex < 0); Inc(BlockIndex); Blocks.Extract(Self); Blocks.AddAt(Self, BlockIndex); end; finally Blocks.UnLockUpdate; end; end; end; FOffset.Y := Y; Update([muExtent]); end; end; procedure TKMemoBlock.SetWordBaseLine(Index: TKMemoWordIndex; const Value: Integer); begin end; procedure TKMemoBlock.SetWordBottomPadding(Index: TKMemoWordIndex; const Value: Integer); begin end; procedure TKMemoBlock.SetWordClipped(Index: TKMemoWordIndex; const Value: Boolean); begin end; procedure TKMemoBlock.SetWordHeight(Index: TKMemoWordIndex; const Value: Integer); begin end; procedure TKMemoBlock.SetWordLeft(Index: TKMemoWordIndex; const Value: Integer); begin end; procedure TKMemoBlock.SetWordTop(Index: TKMemoWordIndex; const Value: Integer); begin end; procedure TKMemoBlock.SetWordTopPadding(Index: TKMemoWordIndex; const Value: Integer); begin end; procedure TKMemoBlock.SetWordWidth(Index: TKMemoWordIndex; const Value: Integer); begin end; function TKMemoBlock.SizingGripsCursor(const ARect: TRect; const APoint: TPoint): TCursor; var Grips: TKSizingGrips; begin if Resizable then begin Grips := TKSizingGrips.Create; try Grips.BoundsRect := ARect; Result := Grips.CursorAt(APoint); finally Grips.Free; end; end else Result := crDefault; end; procedure TKMemoBlock.SizingGripsDraw(ACanvas: TCanvas; const ARect: TRect); var Grips: TKSizingGrips; begin if Resizable then begin Grips := TKSizingGrips.Create; try Grips.BoundsRect := ARect; Grips.DrawTo(ACanvas); finally Grips.Free; end; end; end; function TKMemoBlock.SizingGripsPosition(const ARect: TRect; const APoint: TPoint): TKSizingGripPosition; var Grips: TKSizingGrips; begin if Resizable then begin Grips := TKSizingGrips.Create; try Grips.BoundsRect := ARect; Result := Grips.HitTest(APoint); finally Grips.Free; end; end else Result := sgpNone; end; function TKMemoBlock.Split(At: TKMemoSelectionIndex; AllowEmpty: Boolean): TKMemoBlock; begin Result := nil; end; procedure TKMemoBlock.Update(AReasons: TKMemoUpdateReasons); begin if Parent <> nil then ParentBlocks.Update(AReasons) end; function TKMemoBlock.WordIndexToRect(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; AIndex: TKMemoSelectionIndex; ACaret: Boolean): TRect; begin Result := CreateEmptyRect; end; function TKMemoBlock.WordMeasureExtent(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; ARequiredWidth: Integer): TPoint; begin Result := CreateEmptyPoint; end; function TKMemoBlock.WordMouseAction(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; AAction: TKMemoMouseAction; const APoint: TPoint; AShift: TShiftState): Boolean; var R: TRect; begin Result := False; R := WordRect[AWordIndex]; if PtInRect(R, APoint) then begin case AAction of maLeftDown: begin if FMouseCaptureWord < 0 then begin FMouseCaptureWord := AWordIndex; FDoubleClickState := mdblNone; if ssDouble in AShift then begin Result := DblClick; if Result then FDoubleClickState := mdblClickedAndHandled else FDoubleClickState := mdblClicked; end else if not ClickOnMouseUp then Result := Click end; end; maLeftUp: begin if FMouseCaptureWord >= 0 then begin FMouseCaptureWord := -1; if ClickOnMouseUp and (FDoubleClickState = mdblNone) then Result := Click end; end; end; end else begin case AAction of maLeftUp: if FMouseCaptureWord = AWordIndex then FMouseCaptureWord := -1; end; end; end; procedure TKMemoBlock.WordPaintToCanvas(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; ALeft, ATop: Integer); begin end; { TKMemoSingleBlock } constructor TKMemoSingleton.Create; begin inherited; FSelEnd := -1; FSelStart := -1; end; function TKMemoSingleton.GetSelLength: TKMemoSelectionIndex; begin Result := FSelEnd - FSelStart; end; function TKMemoSingleton.GetSelStart: TKMemoSelectionIndex; begin Result := FSelStart; end; function TKMemoSingleton.Select(ASelStart, ASelLength: TKMemoSelectionIndex; ADoScroll: Boolean): Boolean; var NewSelEnd, MaxLen: TKMemoSelectionIndex; begin NewSelEnd := ASelStart + ASelLength; if NewSelEnd < ASelStart then Exchange(Integer(ASelStart), Integer(NewSelEnd)); MaxLen := SelectableLength(True); NewSelEnd := MinMax(NewSelEnd, -1, MaxLen); ASelStart := MinMax(ASelStart, -1, MaxLen); if (ASelStart <> FSelStart) or (NewSelEnd <> FSelEnd) then begin FSelEnd := NewSelEnd; FSelStart := ASelStart; if ADoScroll then Update([muSelectionScroll]) else Update([muSelection]); Result := True; end else Result := False; end; { TKTextMemoBlock } constructor TKMemoTextBlock.Create; begin FTextStyle := TKMemoTextStyle.Create; FTextStyle.OnChanged := TextStyleChanged; FWordBreakStyle := wbsLastWordChar; inherited; FText := ''; FTextLength := 0; FWordCount := 0; FWords := TKMemoWordList.Create; end; destructor TKMemoTextBlock.Destroy; begin FTextStyle.Free; FWords.Free; FWordCount := 0; inherited; end; function TKMemoTextBlock.SingleCharWords: Boolean; var Notifier: IKMemoNotifier; begin Result := FWordBreakStyle = wbsEveryChar; if not Result then begin Notifier := MemoNotifier; if Notifier <> nil then Result := Notifier.GetDrawSingleChars or Notifier.GetWrapSingleChars; end end; function TKMemoTextBlock.EqualProperties(ASource: TKObject): Boolean; begin if ASource is TKMemoTextBlock then begin Result := (TKMemoTextBlock(ASource).Text = Text) and TKMemoTextBlock(ASource).TextStyle.EqualProperties(TextStyle); end else Result := False; end; function TKMemoTextBlock.ApplyFormatting(const AText: TKString): TKString; begin if ShowFormatting then begin Result := UnicodeStringReplace(AText, ' ', SpaceChar, [rfReplaceAll]); end else begin Result := UnicodeStringReplace(AText, NewLineChar, ' ', [rfReplaceAll]); end; end; procedure TKMemoTextBlock.ApplyTextStyle(ACanvas: TCanvas); begin with ACanvas do begin Font.Assign(FTextStyle.Font); FScriptFontHeight := FTextStyle.Font.Height; Font.Height := FScriptFontHeight; case FTextStyle.ScriptPosition of tpoSuperscript: begin FScriptVertOffset := GetFontAscent(ACanvas.Handle); // aligned to ascent line of original font FScriptFontHeight := MulDiv(FScriptFontHeight, 3, 5); // 60% Font.Height := FScriptFontHeight; Dec(FScriptVertOffset, GetFontAscent(ACanvas.Handle)); end; tpoSubscript: begin FScriptVertOffset := -GetFontDescent(ACanvas.Handle); // aligned to descent line of original font FScriptFontHeight := MulDiv(FScriptFontHeight, 3, 5); // 60% Font.Height := FScriptFontHeight; end; else FScriptVertOffset := 0; end; if FTextStyle.AllowBrush then Brush.Assign(FTextStyle.Brush) else begin Brush.Style := bsClear; Font.Style := Font.Style - [fsUnderLine]; end; end; end; procedure TKMemoTextBlock.Assign(ASource: TKObject); begin inherited; if ASource is TKMemoTextBlock then Text := TKMemoTextBlock(ASource).Text; end; procedure TKMemoTextBlock.AssignAttributes(ABlock: TKMemoBlock); begin inherited; if ABlock is TKMemoTextBlock then begin TextStyle.Assign(TKMemoTextBlock(ABlock).TextStyle); WordBreakStyle := TKMemoTextBlock(ABlock).WordBreakStyle; end; end; function TKMemoTextBlock.CalcAscent(ACanvas: TCanvas): Integer; begin ApplyTextStyle(ACanvas); Result := GetFontAscent(ACanvas.Handle); end; function TKMemoTextBlock.CalcDescent(ACanvas: TCanvas): Integer; begin ApplyTextStyle(ACanvas); Result := GetFontDescent(ACanvas.Handle); end; procedure TKMemoTextBlock.ClearSelection(ATextOnly: Boolean); var S: TKString; begin inherited; if SelLength <> 0 then begin S := Text; StringDelete(S, FSelStart + 1, FSelEnd - FSelStart); FSelEnd := FSelStart; Text := S; end; end; function TKMemoTextBlock.Concat(ABlock: TKMemoBlock): Boolean; var TmpLen: Integer; begin Result := ABlock is TKMemoTextBlock; if Result then begin TmpLen := SelectableLength; InsertString(TKMemoTextBlock(ABlock).Text, -1); // concat selection when necessary if (ABlock.SelLength > 0) and (ABlock.SelStart = 0) then begin if (SelLength > 0) and (SelEnd >= TmpLen) then begin // concat with previous selection Select(SelStart, TmpLen + ABlock.SelLength, False); end else begin // create new selection Select(TmpLen, TmpLen + ABlock.SelLength, False); end; end; end; end; function TKMemoTextBlock.ContentLength: TKMemoSelectionIndex; begin Result := FTextLength; end; function TKMemoTextBlock.GetCanAddText: Boolean; begin Result := Position = mbpText; end; function TKMemoTextBlock.GetKerningDistance(ACanvas: TCanvas; const AChar1, AChar2: TKChar): Integer; {$IFDEF MSWINDOWS} var Cnt: Integer; Pairs: array of TKerningPair; C1, C2: WideChar; I: Integer; {$ENDIF} begin Result := 0; {$IFDEF MSWINDOWS} Cnt := GetKerningPairs(ACanvas.Handle, 0, nil); if Cnt > 0 then begin SetLength(Pairs, Cnt); GetKerningPairs(ACanvas.Handle, Cnt, PKerningPairs(@Pairs[0])); C1 := NativeUTFToUnicode(AChar1); C2 := NativeUTFToUnicode(AChar2); for I := 0 to Cnt - 1 do if (Pairs[I].wFirst = Ord(C1)) and (Pairs[I].wSecond = Ord(C2)) then begin if Pairs[I].iKernAmount <> 0 then begin Result := Pairs[I].iKernAmount; end; Exit; end; end; {$ENDIF} end; function TKMemoTextBlock.GetSelText: TKString; begin Result := StringCopy(Text, FSelStart + 1, FSelEnd - FSelStart); end; function TKMemoTextBlock.GetText: TKString; begin Result := FText; end; function TKMemoTextBlock.GetWordBaseLine(Index: TKMemoWordIndex): Integer; begin Result := FWords[Index].BaseLine; end; function TKMemoTextBlock.GetWordBottomPadding(Index: TKMemoWordIndex): Integer; begin Result := FWords[Index].BottomPadding; end; function TKMemoTextBlock.GetWordClipped(Index: TKMemoWordIndex): Boolean; begin Result := FWords[Index].Clipped; end; function TKMemoTextBlock.GetWordCount: Integer; begin Result := FWordCount; end; function TKMemoTextBlock.GetWordHeight(Index: TKMemoWordIndex): Integer; begin Result := FWords[Index].Extent.Y; end; procedure TKMemoTextBlock.GetWordIndexes(AIndex: TKMemoSelectionIndex; out ASt, AEn: TKMemoSelectionIndex); var I: TKMemoWordIndex; begin inherited; for I := 0 to FWordCount - 1 do if (AIndex >= FWords[I].StartIndex) and (AIndex < FWords[I].EndIndex) then begin ASt := FWords[I].StartIndex; AEn := FWords[I].EndIndex; Break; end; end; function TKMemoTextBlock.GetWordLeft(Index: TKMemoWordIndex): Integer; begin Result := FWords[Index].Position.X; end; function TKMemoTextBlock.GetWordLength(Index: TKMemoWordIndex): TKMemoSelectionIndex; begin Result := FWords[Index].EndIndex - FWords[Index].StartIndex + 1; end; function TKMemoTextBlock.GetWordLengthWOWS(Index: TKMemoWordIndex): TKMemoSelectionIndex; var I: Integer; S: TKString; begin Result := GetWordLength(Index); S := Words[Index]; I := Length(S); while (I >= 1) and CharInSetEx(S[I], [cTAB] + Wordbreaks) do begin Dec(Result); Dec(I); end; end; function TKMemoTextBlock.GetWordBoundsRect(Index: TKMemoWordIndex): TRect; begin Result.TopLeft := CreateEmptyPoint; Result.BottomRight := FWords[Index].Extent; KFunctions.OffsetRect(Result, FWords[Index].Position); end; function TKMemoTextBlock.GetWordBreakable(Index: TKMemoWordIndex): Boolean; var S: TKString; Notifier: IKMemoNotifier; begin Result := False; Notifier := MemoNotifier; if Notifier <> nil then Result := Notifier.GetWrapSingleChars; if not Result then begin S := Words[Index]; if S <> '' then begin case FWordBreakStyle of wbsLastWordChar: Result := CharInSetEx(S[Length(S)], [cTAB] + Wordbreaks); wbsFirstWordChar: Result := CharInSetEx(S[1], [cTAB] + Wordbreaks); else Result := True; end; end else Result := True; end; end; function TKMemoTextBlock.GetWordBreaks: TKSysCharSet; var Notifier: IKMemoNotifier; begin Notifier := MemoNotifier; if Notifier <> nil then Result := Notifier.GetWordBreaks else Result := cDefaultWordBreaks; end; function TKMemoTextBlock.GetWords(Index: TKMemoWordIndex): TKString; begin Result := StringCopy(Text, FWords[Index].StartIndex + 1, FWords[Index].EndIndex - FWords[Index].StartIndex + 1); end; function TKMemoTextBlock.GetWordTop(Index: TKMemoWordIndex): Integer; begin Result := FWords[Index].Position.Y; end; function TKMemoTextBlock.GetWordTopPadding(Index: TKMemoWordIndex): Integer; begin Result := FWords[Index].TopPadding; end; function TKMemoTextBlock.GetWordWidth(Index: TKMemoWordIndex): Integer; begin Result := FWords[Index].Extent.X; end; function TKMemoTextBlock.IndexToTextIndex(const AText: TKString; AIndex: Integer): Integer; begin AIndex := MinMax(AIndex, 0, ContentLength); Result := StrCPIndexToByteIndex(AText, AIndex); end; function TKMemoTextBlock.InsertString(const AText: TKString; At: TKMemoSelectionIndex): Boolean; var S, T, Part1, Part2: TKString; begin Result := False; S := Text; if At >= 0 then begin SplitText(S, At + 1, Part1, Part2); T := Part1 + AText + Part2; end else T := S + AText; if T <> S then begin Text := T; Result := True; end; end; function TKMemoTextBlock.InternalTextExtent(ACanvas: TCanvas; const AText: TKString): TSize; begin Result := TKTextBox.TextExtent(ACanvas, AText, 1, Length(AText)); end; procedure TKMemoTextBlock.InternalTextOutput(ACanvas: TCanvas; ALeft, ATop: Integer; const AText: TKString); begin TKTextBox.TextOutput(ACanvas, ALeft, ATop, AText, 1, Length(AText)); end; function TKMemoTextBlock.ModifiedTextExtent(ACanvas: TCanvas; const AText: TKString): TPoint; var Size: TSize; C, CU, SU: TKString; I, SmallFontHeight, X, Y: Integer; begin if Pos(cTab, AText) <> 0 then begin SU := UnicodeStringReplace(AText, cTab, TabChar, [rfReplaceAll]); Size := InternalTextExtent(ACanvas, SU); Result := Point(Size.cx, Size.cy); end else if FTextStyle.Capitals = tcaNone then begin Size := InternalTextExtent(ACanvas, AText); Result := Point(Size.cx, Size.cy); end else begin SU := UnicodeUpperCase(AText); if FTextStyle.Capitals = tcaNormal then begin Size := InternalTextExtent(ACanvas, SU); Result := Point(Size.cx, Size.cy); end else begin SmallFontHeight := MulDiv(FScriptFontHeight, 4, 5); X := 0; Y := 0; for I := 1 to StringLength(SU) do begin C := StringCopy(AText, I, 1); CU := StringCopy(SU, I, 1); if C <> CU then ACanvas.Font.Height := SmallFontheight else ACanvas.Font.Height := FScriptFontheight; Size := InternalTextExtent(ACanvas, CU); Inc(X, Size.cx); Y := Max(Y, Size.cy); end; Result := Point(X, Y); end; end; end; procedure TKMemoTextBlock.NotifyDefaultTextChange; begin FTextStyle.NotifyChange(GetDefaultTextStyle); end; procedure TKMemoTextBlock.NotifyOptionsChange; begin inherited; UpdateWords; end; procedure TKMemoTextBlock.NotifyPrintBegin; begin inherited; UpdateWords; // update words to take each character separately end; procedure TKMemoTextBlock.NotifyPrintEnd; begin inherited; UpdateWords; // restore words end; procedure TKMemoTextBlock.ParentChanged; begin inherited; NotifyDefaultTextChange; end; procedure TKMemoTextBlock.SetText(const Value: TKString); begin if FText <> Value then begin FText := Value; FTextLength := StringLength(Value); UpdateWords; Update([muContent]); end; end; procedure TKMemoTextBlock.SetWordBaseLine(Index: TKMemoWordIndex; const Value: Integer); begin FWords[Index].BaseLine := Value; end; procedure TKMemoTextBlock.SetWordBottomPadding(Index: TKMemoWordIndex; const Value: Integer); begin FWords[Index].BottomPadding := Value; end; procedure TKMemoTextBlock.SetWordBreakStyle(const Value: TKMemoWordBreakStyle); begin if Value <> FWordBreakStyle then begin FWordBreakStyle := Value; UpdateWords; Update([muExtent]); end; end; procedure TKMemoTextBlock.SetWordClipped(Index: TKMemoWordIndex; const Value: Boolean); begin FWords[Index].Clipped := Value; end; procedure TKMemoTextBlock.SetWordHeight(Index: TKMemoWordIndex; const Value: Integer); var P: TPoint; begin P := FWords[Index].Extent; P.Y := Value; FWords[Index].Extent := P; end; procedure TKMemoTextBlock.SetWordLeft(Index: TKMemoWordIndex; const Value: Integer); var P: TPoint; begin P := FWords[Index].Position; P.X := Value; FWords[Index].Position := P; end; procedure TKMemoTextBlock.SetWordTop(Index: TKMemoWordIndex; const Value: Integer); var P: TPoint; begin P := FWords[Index].Position; P.Y := Value; FWords[Index].Position := P; end; procedure TKMemoTextBlock.SetWordTopPadding(Index: TKMemoWordIndex; const Value: Integer); begin FWords[Index].TopPadding := Value; end; procedure TKMemoTextBlock.SetWordWidth(Index: TKMemoWordIndex; const Value: Integer); var P: TPoint; begin P := FWords[Index].Extent; P.X := Value; FWords[Index].Extent := P; end; function TKMemoTextBlock.Split(At: TKMemoSelectionIndex; AllowEmpty: Boolean): TKMemoBlock; var Block: TKMemoTextBlock; S, Part1, Part2: TKString; Cls: TKMemoBlockClass; TmpSelStart, TmpSelEnd: TKMemoSelectionIndex; begin if ((At > 0) or AllowEmpty and (At = 0)) and (At < ContentLength) then begin Cls := TKMemoBlockClass(Self.ClassType); Block := Cls.Create as TKMemoTextBlock; Block.Assign(Self); S := GetText; SplitText(S, At + 1, Part1, Part2); // split selection when necessary if SelLength > 0 then begin TmpSelStart := SelStart; TmpSelEnd := SelEnd; if TmpSelStart < At then Select(TmpSelStart, At - TmpSelStart, False) else Select(-1, 0, False); if TmpSelEnd > At then Block.Select(0, TmpSelEnd - At, False) else Block.Select(-1, 0, False) end; Text := Part1; Block.Text := Part2; Result := Block; end else Result := nil; end; class procedure TKMemoTextBlock.SplitText(const ASource: TKString; At: Integer; out APart1, APart2: TKString); begin APart1 := StringCopy(ASource, 1, At - 1); APart2 := StringCopy(ASource, At, Length(ASource) - At + 1); end; function TKMemoTextBlock.TextIndexToIndex(var AText: TKString; ATextIndex: Integer): Integer; begin if ATextIndex >= 0 then Result := StrByteIndexToCPIndex(AText, ATextIndex) else Result := -1; end; procedure TKMemoTextBlock.TextStyleChanged(Sender: TObject); begin Update([muExtent]); end; procedure TKMemoTextBlock.UpdateWords; procedure AddWord(AStart, AEnd: TKMemoSelectionIndex); var Word: TKMemoWord; begin if WordCount < FWords.Count then begin Word := FWords[TKMemoWordIndex(WordCount)]; Word.Clear; end else begin Word := TKMemoWord.Create; FWords.Add(Word); end; Word.StartIndex := AStart - 1; Word.EndIndex := AEnd - 1; Inc(FWordCount); end; var Index, PrevIndex, CharIndex: Integer; WasBreak, IsTab, WasTab, SingleChars: Boolean; begin FWordCount := 0; if FText <> '' then begin CharIndex := 1; Index := 1; PrevIndex := 1; IsTab := False; WasBreak := False; SingleChars := SingleCharWords; while Index <= FTextLength do begin if SingleChars then AddWord(Index, Index) else begin if CharInSetEx(FText[CharIndex], WordBreaks) then WasBreak := True else begin WasTab := IsTab; IsTab := CharInSetEx(FText[CharIndex], [cTab]); if WasBreak or (WasTab and not IsTab) or (IsTab and not WasTab) then begin AddWord(PrevIndex, Index - 1); PrevIndex := Index; WasBreak := False; end; end; end; Inc(Index); CharIndex := StrNextCharIndex(FText, CharIndex); end; if not SingleChars and (Index > PrevIndex) then AddWord(PrevIndex, Index - 1); end; if SelLength <> 0 then begin FSelStart := MinMax(FSelStart, 0, SelectableLength); FSelEnd := MinMax(FSelEnd, 0, SelectableLength); if FSelStart = FSelEnd then begin // unselect... FSelStart := -1; FSelEnd := -1; end; end; end; function TKMemoTextBlock.WordIndexToRect(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; AIndex: TKMemoSelectionIndex; ACaret: Boolean): TRect; var BaseLine, Y, DY: Integer; AppliedText, S, T: TKString; Ofs, Size: TPoint; Word: TKMemoWord; begin Word := FWords[AWordIndex]; if (AIndex >= 0) and (AIndex <= WordLength[AWordIndex]) then begin AppliedText := ApplyFormatting(FText); S := StringCopy(AppliedText, Word.StartIndex + 1, AIndex); T := StringCopy(AppliedText, Word.StartIndex + AIndex + 1, 1); ApplyTextStyle(ACanvas); with ACanvas do begin Ofs := ModifiedTextExtent(ACanvas, S); Size := ModifiedTextExtent(ACanvas, T); end; if ACaret then begin BaseLine := GetFontAscent(ACanvas.Handle); Y := Word.Position.Y + Word.TopPadding + Word.BaseLine - BaseLine - FScriptVertOffset; DY := Size.Y; end else begin Y := Word.Position.Y; DY := Word.Extent.Y; end; Result := Rect(Word.Position.X + Ofs.X, Y, Word.Position.X + Ofs.X + Size.X, Y + DY); end else Result := CreateEmptyRect; end; function TKMemoTextBlock.WordMeasureExtent(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; ARequiredWidth: Integer): TPoint; var AppliedText: TKString; begin AppliedText := ApplyFormatting(Words[AWordIndex]); with ACanvas do begin ApplyTextStyle(ACanvas); FWords[AWordIndex].Extent := ModifiedTextExtent(ACanvas, AppliedText); Result := FWords[AWordIndex].Extent; end; end; function TKMemoTextBlock.WordMouseAction(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; AAction: TKMemoMouseAction; const APoint: TPoint; AShift: TShiftState): Boolean; var R, R1, R2: TRect; Word: TKMemoWord; Notifier: IKMemoNotifier; begin Result := inherited WordMouseAction(ACanvas, AWordIndex, AAction, APoint, AShift); if not Result then begin Word := FWords[AWordIndex]; if (SelLength > 0) and (SelStart <= Word.EndIndex) and (SelEnd > Word.StartIndex) then begin Notifier := MemoNotifier; if Notifier <> nil then begin case AAction of maMove: begin R1 := WordIndexToRect(ACanvas, AWordIndex, Max(SelStart, Word.StartIndex) - Word.StartIndex, False); R2 := WordIndexToRect(ACanvas, AWordIndex, Min(SelEnd - 1, Word.EndIndex) - Word.StartIndex, False); UnionRect(R, R1, R2); if PtInRect(R, APoint) then begin Notifier.SetReqMouseCursor(crDefault); Result := True; end; end; end; end; end; end; end; procedure TKMemoTextBlock.WordPaintToCanvas(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; ALeft, ATop: Integer); function AdjustBaseLine(ABaseLine: Integer): Integer; begin Dec(ABaseline, GetFontAscent(ACanvas.Handle) + FScriptVertOffset); Result := ABaseLine; end; procedure TextDraw(const ARect: TRect; ABaseLine: Integer; const AText: TKString); var C, CU, SU: TKString; AdjBaseLine, I, SmallFontHeight, X: Integer; Size: TSize; begin with ACanvas do begin if Brush.Style <> bsClear then DrawFilledRectangle(ACanvas, ARect, clNone); SetBkMode(Handle, TRANSPARENT); AdjBaseLine := AdjustBaseLine(ABaseLine); // align to baseline if (Pos(cTab, AText) <> 0) and ShowFormatting then begin SU := UnicodeStringReplace(AText, cTab, TabChar, [rfReplaceAll]); InternalTextOutput(ACanvas, ARect.Left, AdjBaseLine, SU); end else if FTextStyle.Capitals = tcaNone then begin InternalTextOutput(ACanvas, ARect.Left, AdjBaseLine, AText); end else begin SU := UnicodeUpperCase(AText); if FTextStyle.Capitals = tcaNormal then InternalTextOutput(ACanvas, ARect.Left, AdjBaseLine, SU) else begin SmallFontHeight := MulDiv(FScriptFontHeight, 4, 5); X := ARect.Left; for I := 1 to StringLength(SU) do begin C := StringCopy(AText, I, 1); CU := StringCopy(SU, I, 1); if C <> CU then Font.Height := SmallFontHeight else Font.Height := FScriptFontHeight; AdjBaseLine := AdjustBaseLine(ABaseLine); InternalTextOutput(ACanvas, X, AdjBaseLine, CU); Size := InternalTextExtent(ACanvas, CU); Inc(X, Size.cx); end; end; end; end; end; var W, X, Y, BaseLine: Integer; AppliedText, S, Part1, Part2, Part3: TKString; R, RClip: TRect; Word: TKMemoWord; Color, Bkgnd: TColor; PrevRgn: HRGN; begin with ACanvas do begin ApplyTextStyle(ACanvas); AppliedText := ApplyFormatting(Words[AWordIndex]); Word := FWords[AWordIndex]; X := Word.Position.X + ALeft + RealLeftOffset; Y := Word.Position.Y + ATop + RealTopOffset; BaseLine := Y + Word.TopPadding; if Position = mbpText then Inc(BaseLine, Word.BaseLine) else Inc(BaseLine, Word.Extent.Y); if PaintSelection and (FSelEnd > FSelStart) and (Word.EndIndex >= FSelStart) and (Word.StartIndex < FSelEnd) then begin GetSelColors(Color, BkGnd); if FSelStart > Word.StartIndex then begin W := FSelStart - Word.StartIndex; SplitText(AppliedText, W + 1, Part1, S); end else begin W := 0; S := AppliedText; end; SplitText(S, FSelEnd - Word.StartIndex - W + 1, Part2, Part3); if Part1 <> '' then begin W := ModifiedTextExtent(ACanvas, Part1).X; R := Rect(X, Y + Word.TopPadding, X + W, Y + Word.Extent.Y - Word.BottomPadding); TextDraw(R, BaseLine, Part1); Inc(X, W); end; if Part2 <> '' then begin Brush.Style := bsSolid; Brush.Color := Bkgnd; Font.Color := Color; W := ModifiedTextExtent(ACanvas, Part2).X; R := Rect(X, Y, X + W, Y + Word.Extent.Y); TextDraw(R, BaseLine, Part2); Inc(X, W); end; if Part3 <> '' then begin ApplyTextStyle(ACanvas); W := ModifiedTextExtent(ACanvas, Part3).X; R := Rect(X, Y + Word.TopPadding, X + W, Y + Word.Extent.Y - Word.BottomPadding); TextDraw(R, BaseLine, Part3); end; end else begin R := Rect(X, Y + Word.TopPadding, X + Word.Extent.X, Y + Word.Extent.Y - Word.BottomPadding); if FWords[AWordIndex].Clipped then begin RClip := R; TranslateRectToDevice(ACanvas.Handle, RClip); PrevRgn := RgnCreateAndGet(ACanvas.Handle); try if ExtSelectClipRect(ACanvas.Handle, RClip, RGN_AND, PrevRgn) then TextDraw(R, BaseLine, AppliedText); finally RgnSelectAndDelete(ACanvas.Handle, PrevRgn); end; ACanvas.Refresh; end else TextDraw(R, BaseLine, AppliedText); end; end; end; function TKMemoTextBlock.WordPointToIndex(ACanvas: TCanvas; const APoint: TPoint; AWordIndex: TKMemoWordIndex; AOutOfArea, ASelectionExpanding: Boolean; out APosition: TKMemoLinePosition): TKMemoSelectionIndex; var I: TKMemoSelectionIndex; WPos: Integer; AppliedText, S: TKString; Size: TPoint; R: TRect; Word: TKMemoWord; begin Result := -1; Word := FWords[AWordIndex]; R := Rect(Word.Position.X, Word.Position.Y, Word.Position.X + Word.Extent.X, Word.Position.Y + Word.Extent.Y); with ACanvas do begin if PtInRect(R, APoint) or (AOutOfArea and (APoint.X >= R.Left) and (APoint.X < R.Right)) then begin ApplyTextStyle(ACanvas); AppliedText := ApplyFormatting(FText); WPos := Word.Position.X; for I := Word.StartIndex to Word.EndIndex do begin S := StringCopy(AppliedText, I + 1, 1); Size := ModifiedTextExtent(ACanvas, S); R := Rect(WPos, Word.Position.Y, WPos + Size.X, Word.Position.Y + Word.Extent.Y); if PtInRect(R, APoint) or (AOutOfArea and (APoint.X >= R.Left) and (APoint.X < R.Right)) then begin Result := I - Word.StartIndex; Break; end; Inc(WPos, Size.X); end; end; end; end; { TKMemoHyperlink } constructor TKMemoHyperlink.Create; begin inherited; FURL := ''; DefaultStyle; end; procedure TKMemoHyperlink.Assign(ASource: TKObject); begin inherited; if ASource is TKMemoHyperlink then begin FURL := TKMemoHyperlink(ASource).URL; end; end; function TKMemoHyperlink.Click: Boolean; begin Result:=inherited Click; if not Result and (FURL <> '') then begin if (ssCtrl in GetShiftState) or ReadOnly then begin OpenURLWithShell(FURL); Result := True; end; end; end; procedure TKMemoHyperlink.DefaultStyle; begin FTextStyle.Font.Color := clBlue; FTextStyle.Font.Style := FTextStyle.Font.Style + [fsUnderline]; end; function TKMemoHyperlink.WordMouseAction(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; AAction: TKMemoMouseAction; const APoint: TPoint; AShift: TShiftState): Boolean; var R: TRect; Notifier: IKMemoNotifier; begin Result := inherited WordMouseAction(ACanvas, AWordIndex, AAction, APoint, AShift); if not Result then begin R := WordRect[AWordIndex]; if PtInRect(R, APoint) then begin case AAction of maMove: begin Notifier := MemoNotifier; if Notifier <> nil then begin if (ssCtrl in AShift) or ReadOnly then Notifier.SetReqMouseCursor(crHandPoint); Result := True; end; end; end; end; end; end; { TKParagraph } constructor TKMemoParagraph.Create; begin inherited; FExtent := CreateEmptyPoint; FTextStyle.Changeable := False; try FTextStyle.AllowBrush := False; finally FTextStyle.Changeable := True; end; FNumberBlock := nil; FParaStyle := TKMemoParaStyle.Create; FParaStyle.OnChanged := ParaStyleChanged; FOrigin := CreateEmptyPoint; Text := NewLineChar; end; destructor TKMemoParagraph.Destroy; begin FNumberBlock.Free; FParaStyle.Free; inherited; end; procedure TKMemoParagraph.AssignAttributes(ABlock: TKMemoBlock); begin inherited; if ABlock is TKMemoParagraph then FParaStyle.Assign(TKMemoParagraph(ABlock).ParaStyle); end; procedure TKMemoParagraph.ParaStyleChanged(Sender: TObject; AReasons: TKMemoUpdateReasons); begin Update(AReasons); end; function TKMemoParagraph.Concat(ABlock: TKMemoBlock): Boolean; begin Result := False; end; function TKMemoParagraph.GetCanAddText: Boolean; begin Result := False; end; function TKMemoParagraph.GetNumberBlock: TKMemoTextBlock; var ListTable: TKMemoListTable; Notifier: IKMemoNotifier; begin Notifier := MemoNotifier; if Notifier <> nil then begin ListTable := Notifier.GetListTable; if ListTable.FindByID(FParaStyle.NumberingList) <> nil then begin if FNumberBlock = nil then begin FNumberBlock := TKMemoTextBlock.Create; FNumberBlock.Parent := Parent; // because of FMemoNotifier end; end else FreeAndNil(FNumberBlock); end else FreeAndNil(FNumberBlock); Result := FNumberBlock; end; function TKMemoParagraph.GetNumbering: TKMemoParaNumbering; var ListLevel: TKMemoListLevel; begin ListLevel := GetNumberingListLevel; if ListLevel <> nil then Result := ListLevel.Numbering else Result := pnuNone; end; function TKMemoParagraph.GetNumberingList: TKMemoList; var ListTable: TKMemoListTable; Notifier: IKMemoNotifier; begin Result := nil; if FParaStyle.NumberingList <> cInvalidListID then begin Notifier := MemoNotifier; if Notifier <> nil then begin ListTable := Notifier.GetListTable; Result := ListTable.FindByID(FParaStyle.NumberingList); end; end; end; function TKMemoParagraph.GetNumberingListLevel: TKMemoListLevel; var List: TKMemoList; begin List := GetNumberingList; if List <> nil then Result := List.Levels[FParaStyle.NumberingListLevel] else Result := nil; end; function TKMemoParagraph.GetParaStyle: TKMemoParaStyle; begin Result := FParaStyle; end; function TKMemoParagraph.GetWordBreakable(Index: TKMemoWordIndex): Boolean; begin Result := True; end; procedure TKMemoParagraph.NotifyDefaultParaChange; begin FParaStyle.NotifyChange(GetDefaultParaStyle); end; procedure TKMemoParagraph.SetNumbering(const Value: TKMemoParaNumbering); var List: TKMemoList; ListLevel: TKMemoListLevel; ListTable: TKMemoListTable; Notifier: IKMemoNotifier; LevelIndex: Integer; begin if Value <> GetNumbering then begin // here we try to set best numbering match from list table Notifier := MemoNotifier; if Notifier <> nil then begin ListTable := Notifier.GetListTable; LevelIndex := Max(FParaStyle.NumberingListLevel, 0); List := ListTable.ListByNumbering(FParaStyle.FNumberingList, LevelIndex, Value); if (List <> nil) and (LevelIndex < List.Levels.Count) then begin FParaStyle.NumberingList := List.ID; FParaStyle.NumberStartAt := 0; ListLevel := List.Levels[LevelIndex]; FParaStyle.FirstIndent := ListLevel.FirstIndent; FParaStyle.LeftPadding := ListLevel.LeftIndent; end else begin FParaStyle.NumberingList := cInvalidListID; end; end; end; end; function TKMemoParagraph.Split(At: TKMemoSelectionIndex; AllowEmpty: Boolean): TKMemoBlock; begin Result := nil; end; procedure TKMemoParagraph.WordPaintToCanvas(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; ALeft, ATop: Integer); begin inherited; end; { TKImageMemoBlock } constructor TKMemoImageBlock.Create; begin inherited; FBaseLine := 0; FWordBottomPadding := 0; FCreatingCroppedImage := False; FCrop := TKRect.Create; FCrop.OnChanged := CropChanged; FCalcBaseLine := 0; FExtent := CreateEmptyPoint; FImage := nil; FImageStyle := TKMemoBlockStyle.Create; FImageStyle.ContentMargin.All := 5; FImageStyle.OnChanged := ImageStyleChanged; FMouseCapture := False; FExplicitExtent := CreateEmptyPoint; FOrigin := CreateEmptyPoint; FResizable := True; FScale := Point(100, 100); FCroppedImage := nil; FWordTopPadding := 0; end; destructor TKMemoImageBlock.Destroy; begin FCrop.Free; FImageStyle.Free; FImage.Free; FCroppedImage.Free; inherited; end; procedure TKMemoImageBlock.Assign(ASource: TKObject); begin inherited; if ASource is TKMemoImageBlock then AssignImage(TKMemoImageBlock(ASource).Image); end; procedure TKMemoImageBlock.AssignAttributes(ABlock: TKMemoBlock); begin inherited; if ABlock is TKMemoImageBlock then begin LockUpdate; try Crop.Assign(TKMemoImageBlock(ABlock).Crop); ImageStyle.Assign(TKMemoImageBlock(ABlock).ImageStyle); ExplicitWidth := TKMemoImageBlock(ABlock).ExplicitWidth; ExplicitHeight := TKMemoImageBlock(ABlock).ExplicitHeight; Resizable := TKMemoImageBlock(ABlock).Resizable; ScaleX := TKMemoImageBlock(ABlock).ScaleX; ScaleY := TKMemoImageBlock(ABlock).ScaleY; finally UnlockUpdate; end; end; end; procedure TKMemoImageBlock.AssignImage(ASource: TGraphic); var MS: TMemoryStream; begin FreeAndNil(FImage); if ASource <> nil then begin FImage := TGraphicClass(ASource.ClassType).Create; FImage.OnChange := ImageChanged; //FImage.Assign(ASource); does not work well in all cases so use slower workaround: MS := TMemoryStream.Create; try ASource.SaveToStream(MS); MS.Seek(0, soFromBeginning); Image.LoadFromStream(MS); finally MS.Free; end; end; end; function TKMemoImageBlock.CalcAscent(ACanvas: TCanvas): Integer; var Block: TKMemoBlock; BlockIndex: TKMemoBlockIndex; Ascent, Descent: Integer; begin if (Parent <> nil) and (Position = mbpText) then begin Result := FExtent.Y div 2; BlockIndex := ParentBlocks.IndexOf(Self); if BlockIndex >= 0 then begin Block := ParentBlocks.GetLastBlockByClass(BlockIndex, TKMemoTextBlock); if Block = nil then Block := ParentBlocks.GetNextBlockByClass(BlockIndex, TKMemoTextBlock); if Block <> nil then begin Ascent := TKMemoTextBlock(Block).CalcAscent(ACanvas); Descent := TKMemoTextBlock(Block).CalcDescent(ACanvas); Result := (FExtent.Y - (Ascent + Descent)) div 2 + Ascent; end else begin Block := ParentBlocks.GetNearestParagraphBlock(BlockIndex); if Block <> nil then begin Descent := TKMemoTextBlock(Block).CalcDescent(ACanvas); Result := FExtent.Y - Descent; end; end; end; end else Result := 0; FCalcBaseLine := Result; end; function TKMemoImageBlock.ContentLength: TKMemoSelectionIndex; begin Result := 1; end; function TKMemoImageBlock.GetWrapMode: TKMemoBlockWrapMode; begin Result := FImageStyle.WrapMode; end; function TKMemoImageBlock.GetImageHeight: Integer; begin if FScale.Y <> 0 then Result := ScaleHeight else if FImage <> nil then Result := FImage.Height else Result := 0; Dec(Result, FCrop.Top + FCrop.Bottom); end; function TKMemoImageBlock.GetImageWidth: Integer; begin if FScale.X <> 0 then Result := ScaleWidth else if FImage <> nil then Result := FImage.Width else Result := 0; Dec(Result, FCrop.Left + FCrop.Right); end; function TKMemoImageBlock.GetLogScaleX: Integer; begin if ImageDPIX <> 0 then Result := MulDiv(ScaleX, ImageDPIX, PixelsPerInchX) else Result := ScaleX; end; function TKMemoImageBlock.GetLogScaleY: Integer; begin if ImageDPIY <> 0 then Result := MulDiv(ScaleY, ImageDPIY, PixelsPerInchY) else Result := ScaleY; end; function TKMemoImageBlock.GetNativeOrExplicitHeight: Integer; begin if FExplicitExtent.Y <> 0 then Result := FExplicitExtent.Y else if FImage <> nil then Result := FImage.Height else Result := 0; end; function TKMemoImageBlock.GetNativeOrExplicitWidth: Integer; begin if FExplicitExtent.X <> 0 then Result := FExplicitExtent.X else if FImage <> nil then Result := FImage.Width else Result := 0; end; function TKMemoImageBlock.GetResizable: Boolean; begin Result := FResizable; end; function TKMemoImageBlock.GetScaleHeight: Integer; begin Result := MulDiv(NativeOrExplicitHeight, FScale.Y, 100); end; function TKMemoImageBlock.GetScaleWidth: Integer; begin Result := MulDiv(NativeOrExplicitWidth, FScale.X, 100); end; function TKMemoImageBlock.GetSizingRect: TRect; var ROuter: TRect; begin // Result := inherited GetSizingRect; ROuter := OuterRect(False); CroppedImage; Result := FScaledRect; KFunctions.OffsetRect(Result, ROuter.Left + FImageStyle.AllPaddingsLeft, ROuter.Top + FImageStyle.AllPaddingsTop + FWordTopPadding + FBaseLine - FCalcBaseLine); end; function TKMemoImageBlock.GetWordBottomPadding(Index: TKMemoWordIndex): Integer; begin Result := FWordBottomPadding; end; function TKMemoImageBlock.GetWordBoundsRect(Index: TKMemoWordIndex): TRect; begin Result.TopLeft := CreateEmptyPoint; Result.BottomRight := FExtent; KFunctions.OffsetRect(Result, FOrigin); end; function TKMemoImageBlock.GetWordCount: Integer; begin Result := 1; end; function TKMemoImageBlock.GetWordHeight(Index: TKMemoWordIndex): Integer; begin Result := FExtent.Y; end; function TKMemoImageBlock.GetWordLeft(Index: TKMemoWordIndex): Integer; begin Result := FOrigin.X; end; function TKMemoImageBlock.GetWordLength(Index: TKMemoWordIndex): TKMemoSelectionIndex; begin Result := 1; end; function TKMemoImageBlock.GetWords(Index: TKMemoWordIndex): TKString; begin Result := ''; end; function TKMemoImageBlock.GetWordTop(Index: TKMemoWordIndex): Integer; begin Result := FOrigin.Y; end; function TKMemoImageBlock.GetWordTopPadding(Index: TKMemoWordIndex): Integer; begin Result := FWordTopPadding; end; function TKMemoImageBlock.GetWordWidth(Index: TKMemoWordIndex): Integer; begin Result := FExtent.X; end; procedure TKMemoImageBlock.ImageChanged(Sender: TObject); begin if not FCreatingCroppedImage then begin FreeAndNil(FCroppedImage); FImageDPI := GetImageDPI(FImage); Update([muContent]); end; end; procedure TKMemoImageBlock.ImageStyleChanged(Sender: TObject; AReasons: TKMemoUpdateReasons); begin Update(AReasons); end; procedure TKMemoImageBlock.LoadFromFile(const APath: string); var Picture: TPicture; begin Picture := TPicture.Create; try Picture.LoadFromFile(APath); AssignImage(Picture.Graphic); finally Picture.Free; end; FreeAndNil(FCroppedImage); Update([muContent]); end; function TKMemoImageBlock.OuterRect(ACaret: Boolean): TRect; begin Result.TopLeft := FOrigin; Result.Right := Result.Left + FExtent.X; Result.Bottom := Result.Top + FExtent.Y; if ACaret then begin Inc(Result.Top, FWordTopPadding); Dec(Result.Bottom, FWordBottomPadding); end; KFunctions.OffsetRect(Result, RealLeftOffset, RealTopOffset); end; procedure TKMemoImageBlock.Resize(ANewWidth, ANewHeight: Integer); begin ScaleWidth := ANewWidth + FCrop.Left + FCrop.Right; ScaleHeight := ANewHeight + FCrop.Top + FCrop.Bottom; end; procedure TKMemoImageBlock.CropChanged(Sender: TObject); begin FreeAndNil(FCroppedImage); Update([muExtent]); end; function TKMemoImageBlock.CroppedImage: TKAlphaBitmap; var ExtentX, ExtentY: Integer; RatioX, RatioY: Double; OrigCrop: TRect; begin if (FCroppedImage = nil) and (FImage <> nil) and not FCreatingCroppedImage then begin FCreatingCroppedImage := True; try // get scaled image only on demand ExtentX := ScaleWidth; if ExtentX = 0 then ExtentX := FImage.Width; ExtentY := ScaleHeight; if ExtentY = 0 then ExtentY := FImage.Height; RatioX := ExtentX / FImage.Width; RatioY := ExtentY / FImage.Height; // crop in original units OrigCrop := Rect(Round(FCrop.Left / RatioX), Round(FCrop.Top / RatioY), Round(FCrop.Right / RatioX), Round(FCrop.Bottom / RatioY)); Dec(ExtentX, FCrop.Left + FCrop.Right); Dec(ExtentY, FCrop.Top + FCrop.Bottom); FScaledRect := Rect(0, 0, ExtentX, ExtentY); if (ExtentX * ExtentY <> 0) and (FImage.Width * FImage.Height <> 0) then begin FCroppedImage := TKAlphaBitmap.Create; FCroppedImage.SetSize(FImage.Width - OrigCrop.Left - OrigCrop.Right, FImage.Height - OrigCrop.Top - OrigCrop.Bottom); FCroppedImage.CopyFromXY(-OrigCrop.Left, -OrigCrop.Top, FImage); end; finally FCreatingCroppedImage := False; end; end; Result := FCroppedImage; end; procedure TKMemoImageBlock.SetCrop(const Value: TKRect); begin FCrop.Assign(Value); end; procedure TKMemoImageBlock.SetImage(const Value: TGraphic); begin AssignImage(Value); FreeAndNil(FCroppedImage); Update([muContent]); end; procedure TKMemoImageBlock.SetLogScaleX(const Value: Integer); begin if ImageDPIX <> 0 then ScaleX := MulDiv(Value, PixelsPerInchX, ImageDPIX) else ScaleX := Value; end; procedure TKMemoImageBlock.SetLogScaleY(const Value: Integer); begin if ImageDPIY <> 0 then ScaleY := MulDiv(Value, PixelsPerInchY, ImageDPIY) else ScaleY := Value; end; procedure TKMemoImageBlock.SetResizable(const Value: Boolean); begin if Value <> FResizable then begin FResizable := Value; Update([muExtent]); end; end; procedure TKMemoImageBlock.SetExplicitHeight(const Value: Integer); begin if Value <> FExplicitExtent.Y then begin FExplicitExtent.Y := Value; FreeAndNil(FCroppedImage); Update([muContent]); end; end; procedure TKMemoImageBlock.SetExplicitWidth(const Value: Integer); begin if Value <> FExplicitExtent.X then begin FExplicitExtent.X := Value; FreeAndNil(FCroppedImage); Update([muContent]); end; end; procedure TKMemoImageBlock.SetScaleHeight(const Value: Integer); begin if Value <> ScaleHeight then begin FScale.Y := MulDiv(Value, 100, NativeOrExplicitHeight); FreeAndNil(FCroppedImage); Update([muExtent]); end; end; procedure TKMemoImageBlock.SetScaleWidth(const Value: Integer); begin if Value <> ScaleWidth then begin FScale.X := MulDiv(Value, 100, NativeOrExplicitWidth); FreeAndNil(FCroppedImage); Update([muExtent]); end; end; procedure TKMemoImageBlock.SetScaleX(const Value: Integer); begin if Value <> FScale.X then begin FScale.X := Value; FreeAndNil(FCroppedImage); Update([muExtent]); end; end; procedure TKMemoImageBlock.SetScaleY(const Value: Integer); begin if Value <> FScale.Y then begin FScale.Y := Value; FreeAndNil(FCroppedImage); Update([muExtent]); end; end; procedure TKMemoImageBlock.SetWordBaseLine(Index: TKMemoWordIndex; const Value: Integer); begin FBaseLine := Value; end; procedure TKMemoImageBlock.SetWordBottomPadding(Index: TKMemoWordIndex; const Value: Integer); begin FWordBottomPadding := Value; end; procedure TKMemoImageBlock.SetWordHeight(Index: TKMemoWordIndex; const Value: Integer); begin FExtent.Y := Value; end; procedure TKMemoImageBlock.SetWordLeft(Index: TKMemoWordIndex; const Value: Integer); begin FOrigin.X := Value; end; procedure TKMemoImageBlock.SetWordTop(Index: TKMemoWordIndex; const Value: Integer); begin FOrigin.Y := Value; end; procedure TKMemoImageBlock.SetWordTopPadding(Index: TKMemoWordIndex; const Value: Integer); begin FWordTopPadding := Value; end; function TKMemoImageBlock.WordIndexToRect(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; AIndex: TKMemoSelectionIndex; ACaret: Boolean): TRect; begin Result := OuterRect(ACaret); end; function TKMemoImageBlock.WordMeasureExtent(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; ARequiredWidth: Integer): TPoint; begin FreeAndNil(FCroppedImage); Result := Point( ImageWidth + FImageStyle.AllPaddingsLeft + FImageStyle.AllPaddingsRight, ImageHeight + FImageStyle.AllPaddingsTop + FImageStyle.AllPaddingsBottom); FExtent := Result; end; function TKMemoImageBlock.WordMouseAction(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; AAction: TKMemoMouseAction; const APoint: TPoint; AShift: TShiftState): Boolean; var R: TRect; Notifier: IKMemoNotifier; Cursor: TCursor; begin Result := False; R := GetSizingRect; if PtInRect(R, APoint) then begin Result := inherited WordMouseAction(ACanvas, AWordIndex, AAction, APoint, AShift); if not Result then begin Notifier := MemoNotifier; if Notifier <> nil then begin case AAction of maMove: begin if ReadOnly then Cursor := crDefault else begin if SelLength > 0 then begin Cursor := SizingGripsCursor(R, APoint); if Cursor = crDefault then Cursor := crSizeAll; end else Cursor := crSizeAll; if (Position = mbpText) and (Cursor = crSizeAll) then Cursor := crDefault; end; Notifier.SetReqMouseCursor(Cursor); Result := True; end; maLeftDown: begin if ssDouble in AShift then Notifier.EditBlock(Self) else Notifier.SelectBlock(Self, SizingGripsPosition(R, APoint)); Result := True; end; maRightDown: begin Result := Notifier.SelectBlock(Self, sgpNone); end; end; end; end; end; end; procedure TKMemoImageBlock.WordPaintToCanvas(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; ALeft, ATop: Integer); var X, Y: Integer; R: TRect; ROuter: TRect; Bitmap: TKAlphaBitmap; Color, Bkgnd: TColor; begin inherited; ROuter := OuterRect(False); KFunctions.OffsetRect(ROuter, ALeft, ATop); X := ROuter.Left + FImageStyle.AllPaddingsLeft; Y := ROuter.Top + FImageStyle.AllPaddingsTop + FWordTopPadding + FBaseLine - FCalcBaseLine; CroppedImage; R := FScaledRect; KFunctions.OffsetRect(R, X, Y); ROuter := ImageStyle.MarginRect(ROuter); if PaintSelection and (SelLength > 0) then begin GetSelColors(Color, BkGnd); ACanvas.Brush.Color := BkGnd; ACanvas.FillRect(ROuter); if FCroppedImage <> nil then begin Bitmap := TKAlphaBitmap.Create; try Bitmap.CopyFromAlphaBitmap(FCroppedImage); Bitmap.AlphaFillPercent(50, False); ACanvas.StretchDraw(R, Bitmap); if not ReadOnly and (SelectedBlock = Self) then SizingGripsDraw(ACanvas, R); finally Bitmap.Free; end; end; end else begin FImageStyle.PaintBox(ACanvas, ROuter); if FCroppedImage <> nil then ACanvas.StretchDraw(R, FCroppedImage); end; end; function TKMemoImageBlock.WordPointToIndex(ACanvas: TCanvas; const APoint: TPoint; AWordIndex: TKMemoWordIndex; AOutOfArea, ASelectionExpanding: Boolean; out APosition: TKMemoLinePosition): TKMemoSelectionIndex; begin if PtInRect(OuterRect(False), APoint) then Result := 0 else Result := -1; end; { TKMemoContainer } constructor TKMemoContainer.Create; begin inherited; FBlocks := TKMemoBlocks.Create; FBlocks.Parent := Self; FBlocks.OnUpdate := Update; FBlockStyle := TKMemoBlockStyle.Create; FBlockStyle.OnChanged := BlockStyleChanged; FWordBottomPadding := 0; FClip := False; FCurrentRequiredHeight := 0; FCurrentRequiredWidth := 0; FFixedHeight := False; FFixedWidth := False; FOrigin := CreateEmptyPoint; FRequiredHeight := 0; FRequiredWidth := 0; FResizable := True; FWordTopPadding := 0; end; destructor TKMemoContainer.Destroy; begin FBlocks.Free; FBlockStyle.Free; inherited; end; function TKMemoContainer.AddRectOffset(const ARect: TRect): TRect; begin Result := ARect; KFunctions.OffsetRect(Result, Left + RealLeftOffset + FBlockStyle.AllPaddingsLeft, Top + RealTopOffset + FBlockStyle.AllPaddingsTop + FWordTopPadding); end; procedure TKMemoContainer.AddSingleLine; var Line: TKMemoLine; begin if Position = mbpText then begin FBlocks.Lines.Clear; if FBlocks.Count > 0 then begin Line := TKMemoLine.Create; Line.StartBlock := 0; Line.StartWord := 0; Line.StartIndex := 0; Line.EndBlock := FBlocks.Count - 1; Line.EndWord := 0; Line.EndIndex := FBlocks.SelectableLength - 1; Line.Position := Point(0, 0); Line.Extent := Point(Width, Height); FBlocks.Lines.Add(Line); end; end; end; procedure TKMemoContainer.Assign(ASource: TKObject); begin inherited; if ASource is TKMemoContainer then begin LockUpdate; try Blocks.Assign(TKMemoContainer(ASource).Blocks); finally UnlockUpdate; end; end; end; procedure TKMemoContainer.AssignAttributes(ABlock: TKMemoBlock); begin inherited; if ABlock is TKMemoContainer then begin LockUpdate; try BlockStyle.Assign(TKMemoContainer(ABlock).BlockStyle); Clip := TKMemoContainer(ABlock).Clip; FixedWidth := TKMemoContainer(ABlock).FixedWidth; FixedHeight := TKMemoContainer(ABlock).FixedHeight; RequiredWidth := TKMemoContainer(ABlock).RequiredWidth; RequiredHeight := TKMemoContainer(ABlock).RequiredHeight; Resizable := TKMemoContainer(ABlock).Resizable; finally UnlockUpdate; end; end; end; procedure TKMemoContainer.AddBlockLine(AStartBlock, AStartIndex, AEndBlock, AEndIndex, ALeft, ATop, AWidth, AHeight: Integer); var Line: TKMemoLine; begin if Position = mbpText then begin if AEndBlock >= AStartBlock then begin Line := TKMemoLine.Create; Line.StartBlock := AStartBlock; Line.StartWord := 0; Line.StartIndex := AStartIndex; Line.EndBlock := AEndBlock; Line.EndWord := 0; Line.EndIndex := AEndIndex; Line.Position := Point(ALeft, ATop); Line.Extent := Point(AWidth, AHeight); FBlocks.Lines.Add(Line); end; end; end; procedure TKMemoContainer.BlockStyleChanged(Sender: TObject; AReasons: TKMemoUpdateReasons); begin Update(AReasons); end; function TKMemoContainer.CalcAscent(ACanvas: TCanvas): Integer; var PA: TKMemoParagraph; ParaDescent: Integer; begin Result := 0; if (Parent <> nil) and (Position = mbpText) then begin PA := ParentBlocks.GetNearestParagraphBlock(ParentBlocks.IndexOf(Self)); if PA <> nil then begin ParaDescent := PA.CalcDescent(ACanvas); Result := FBlocks.Height - ParaDescent; end; end; end; function TKMemoContainer.CanAdd(ABlock: TKMemoBlock): Boolean; begin // generic container cannot accept some kinds of subblocks Result := not ( (ABlock is TKMemoTableRow) or (ABlock is TKMemoTableCell) ); end; procedure TKMemoContainer.ClearLines; begin FBlocks.Lines.Clear; end; procedure TKMemoContainer.ClearSelection(ATextOnly: Boolean); begin FBlocks.ClearSelection(ATextOnly); end; function TKMemoContainer.ContentLength: TKMemoSelectionIndex; begin Result := FBlocks.SelectableLength; end; procedure TKMemoContainer.FixedHeightChanged; begin end; procedure TKMemoContainer.FixedWidthChanged; begin end; function TKMemoContainer.GetBottomPadding: Integer; begin Result := FBlockStyle.BottomPadding; end; function TKMemoContainer.GetCanAddText: Boolean; begin Result := True; end; function TKMemoContainer.GetResizable: Boolean; begin Result := FResizable; end; function TKMemoContainer.GetWrapMode: TKMemoBlockWrapMode; begin Result := FBlockStyle.WrapMode; end; function TKMemoContainer.GetSelLength: TKMemoSelectionIndex; begin Result := FBlocks.SelLength; end; function TKMemoContainer.GetSelStart: TKMemoSelectionIndex; begin Result := FBlocks.SelStart; end; function TKMemoContainer.GetSelText: TKString; begin Result := FBlocks.SelText; end; function TKMemoContainer.GetText: TKString; begin Result := FBlocks.Text; end; function TKMemoContainer.GetTopPadding: Integer; begin Result := FBlockStyle.TopPadding; end; function TKMemoContainer.GetTotalLineCount: Integer; begin Result := FBlocks.TotalLineCount; end; function TKMemoContainer.GetTotalLineRect(Index: TKMemoTotalLineIndex): TRect; begin Result := AddRectOffset(FBlocks.TotalLineRect[Index]); end; function TKMemoContainer.GetWordBottomPadding(Index: TKMemoWordIndex): Integer; begin Result := FWordBottomPadding; end; function TKMemoContainer.GetWordBoundsRect(Index: TKMemoWordIndex): TRect; begin Result := Rect(0, 0, Width, Height); KFunctions.OffsetRect(Result, FOrigin); end; function TKMemoContainer.GetWordCount: Integer; begin Result := 1; end; function TKMemoContainer.GetWordHeight(Index: TKMemoWordIndex): Integer; begin if FFixedHeight and (FRequiredHeight > 0) then Result := FRequiredHeight else Result := Max(FCurrentRequiredHeight, FBlocks.Height + FBlockStyle.AllPaddingsBottom + FBlockStyle.AllPaddingsTop); end; function TKMemoContainer.GetWordLeft(Index: TKMemoWordIndex): Integer; begin Result := FOrigin.X; end; function TKMemoContainer.GetWordLength(Index: TKMemoWordIndex): TKMemoSelectionIndex; begin Result := ContentLength; end; function TKMemoContainer.GetWords(Index: TKMemoWordIndex): TKString; begin Result := FBlocks.Text; end; function TKMemoContainer.GetWordTop(Index: TKMemoWordIndex): Integer; begin Result := FOrigin.Y; end; function TKMemoContainer.GetWordTopPadding(Index: TKMemoWordIndex): Integer; begin Result := FWordTopPadding; end; function TKMemoContainer.GetWordWidth(Index: TKMemoWordIndex): Integer; begin if FFixedWidth and (FRequiredWidth > 0) then Result := FRequiredWidth else Result := Max(FCurrentRequiredWidth, FBlocks.Width + FBlockStyle.AllPaddingsLeft + FBlockStyle.AllPaddingsRight); end; function TKMemoContainer.InsertParagraph(AIndex: TKMemoSelectionIndex): Boolean; begin Result := FBlocks.InsertParagraph(AIndex, False); end; function TKMemoContainer.InsertString(const AText: TKString; At: TKMemoSelectionIndex): Boolean; begin if At < 0 then At := FBlocks.SelectableLength; Result := FBlocks.InsertString(At, False, AText); end; procedure TKMemoContainer.NotifyDefaultParaChange; begin FBlocks.NotifyDefaultParaChange; end; procedure TKMemoContainer.NotifyDefaultTextChange; begin FBlocks.NotifyDefaultTextChange; end; procedure TKMemoContainer.NotifyPrintBegin; begin FBlocks.NotifyPrintBegin; end; procedure TKMemoContainer.NotifyPrintEnd; begin FBlocks.NotifyPrintEnd; end; procedure TKMemoContainer.ParentChanged; begin inherited; FBlocks.MemoNotifier := GetMemoNotifier; end; procedure TKMemoContainer.RequiredHeightChanged; begin end; procedure TKMemoContainer.RequiredWidthChanged; begin end; procedure TKMemoContainer.Resize(ANewWidth, ANewHeight: Integer); begin FixedWidth := True; FixedHeight := True; RequiredWidth := ANewWidth; RequiredHeight := ANewHeight; end; function TKMemoContainer.Select(ASelStart, ASelLength: TKMemoSelectionIndex; ADoScroll: Boolean): Boolean; begin Result := FBlocks.Select(ASelStart, ASelLength, ADoScroll); end; procedure TKMemoContainer.SetBlockExtent(AWidth, AHeight: Integer); begin FBlocks.SetExtent(AWidth - FBlockStyle.AllPaddingsLeft - FBlockStyle.AllPaddingsRight, AHeight - FBlockStyle.AllPaddingsTop - FBlockStyle.AllPaddingsBottom); end; procedure TKMemoContainer.SetClip(const Value: Boolean); begin if Value <> FClip then begin FClip := Value; Update([muExtent]); end; end; procedure TKMemoContainer.SetFixedHeight(const Value: Boolean); begin if Value <> FFixedHeight then begin FFixedHeight := Value; FixedHeightChanged; Update([muExtent]); end; end; procedure TKMemoContainer.SetFixedWidth(const Value: Boolean); begin if Value <> FFixedWidth then begin FFixedWidth := Value; FixedWidthChanged; Update([muExtent]); end; end; procedure TKMemoContainer.SetRequiredHeight(const Value: Integer); begin if Value <> FRequiredHeight then begin FRequiredHeight := Value; RequiredHeightChanged; Update([muExtent]); end; end; procedure TKMemoContainer.SetRequiredWidth(const Value: Integer); begin if Value <> FRequiredWidth then begin FRequiredWidth := Value; RequiredWidthChanged; Update([muExtent]); end; end; procedure TKMemoContainer.SetResizable(const Value: Boolean); begin if Value <> FResizable then begin FResizable := Value; Update([muExtent]); end; end; procedure TKMemoContainer.SetWordBottomPadding(Index: TKMemoWordIndex; const Value: Integer); begin FWordBottomPadding := Value; end; procedure TKMemoContainer.SetWordHeight(Index: TKMemoWordIndex; const Value: Integer); begin FCurrentRequiredHeight := Value; end; procedure TKMemoContainer.SetWordLeft(Index: TKMemoWordIndex; const Value: Integer); begin FOrigin.X := Value; end; procedure TKMemoContainer.SetWordTop(Index: TKMemoWordIndex; const Value: Integer); begin FOrigin.Y := Value; end; procedure TKMemoContainer.SetWordTopPadding(Index: TKMemoWordIndex; const Value: Integer); begin FWordTopPadding := Value; end; procedure TKMemoContainer.SetWordWidth(Index: TKMemoWordIndex; const Value: Integer); begin FCurrentRequiredWidth := Value; end; procedure TKMemoContainer.UpdateAttributes; begin FBlocks.UpdateAttributes; end; function TKMemoContainer.WordIndexToRect(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; AIndex: TKMemoSelectionIndex; ACaret: Boolean): TRect; begin Result := FBlocks.IndexToRect(ACanvas, AIndex, ACaret, False); if not ACaret then begin // expand rect to enable vertical caret movement if Result.Top = 0 then Dec(Result.Top, FBlockStyle.AllPaddingsTop + FWordTopPadding); if Result.Bottom = FBlocks.Height then Inc(Result.Bottom, Height - FBlocks.Height - FBlockStyle.AllPaddingsTop - FWordTopPadding); end; Result := AddRectOffset(Result); end; function TKMemoContainer.WordMeasureExtent(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; ARequiredWidth: Integer): TPoint; begin if FFixedWidth then FCurrentRequiredWidth := FRequiredWidth else FCurrentRequiredWidth := ARequiredWidth; FCurrentRequiredHeight := 0; FBlocks.MeasureExtent(ACanvas, Max(FCurrentRequiredWidth - FBlockStyle.AllPaddingsLeft - FBlockStyle.AllPaddingsRight, 0)); Result := Point(Width, Height); end; function TKMemoContainer.WordMouseAction(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; AAction: TKMemoMouseAction; const APoint: TPoint; AShift: TShiftState): Boolean; var P: TPoint; R, RMargin, RInterior: TRect; Notifier: IKMemoNotifier; Cursor: TCursor; begin Result := False; P := APoint; R := Rect(0, 0, Width, Height); OffsetPoint(P, -Left - RealLeftOffset, -Top - RealTopOffset - FWordTopPadding); RMargin := FBlockStyle.MarginRect(R); RInterior := FBlockStyle.InteriorRect(FBlockStyle.BorderRect(RMargin)); if PtInRect(RInterior, P) then begin OffsetPoint(P, -FBlockStyle.AllPaddingsLeft, -FBlockStyle.AllPaddingsTop); Result := FBlocks.MouseAction(AAction, ACanvas, P, AShift); if not Result then Result := inherited WordMouseAction(ACanvas, AWordIndex, AAction, APoint, AShift); end else if (Position <> mbpText) and PtInRect(R, P) and (ActiveBlocks = FBlocks) then begin Notifier := MemoNotifier; if Notifier <> nil then begin case AAction of maMove: begin if ReadOnly then Cursor := crDefault else begin Cursor := SizingGripsCursor(RMargin, P); if Cursor = crDefault then Cursor := crSizeAll; end; Notifier.SetReqMouseCursor(Cursor); Result := True; end; maLeftDown: begin if ssDouble in AShift then Notifier.EditBlock(Self) else Notifier.SelectBlock(Self, SizingGripsPosition(RMargin, P)); Result := True; end; maRightDown: begin Result := Notifier.SelectBlock(Self, sgpNone); end; end; end; end; end; procedure TKMemoContainer.WordPaintToCanvas(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; ALeft, ATop: Integer); var R, RClip: TRect; PrevRgn: HRGN; begin R := Rect(0, 0, Width, Height); KFunctions.OffsetRect(R, Left + ALeft + RealLeftOffset, Top + ATop + RealTopOffset + FWordTopPadding); R := FBlockStyle.MarginRect(R); FBlockStyle.PaintBox(ACanvas, R); if not ReadOnly and (ActiveBlocks = FBlocks) then SizingGripsDraw(ACanvas, R); R := FBlockStyle.BorderRect(R); Inc(ALeft, Left + FBlockStyle.AllPaddingsLeft + RealLeftOffset); Inc(ATop, Top + FBlockStyle.AllPaddingsTop + RealTopOffset + FWordTopPadding); if FClip then begin RClip := R; TranslateRectToDevice(ACanvas.Handle, RClip); PrevRgn := RgnCreateAndGet(ACanvas.Handle); try if ExtSelectClipRect(ACanvas.Handle, RClip, RGN_AND, PrevRgn) then begin R := FBlockStyle.InteriorRect(R); FBlocks.PaintToCanvas(ACanvas, ALeft, ATop, R); end; finally RgnSelectAndDelete(ACanvas.Handle, PrevRgn); end; ACanvas.Refresh; end else begin R := FBlockStyle.InteriorRect(R); FBlocks.PaintToCanvas(ACanvas, ALeft, ATop, R); end; end; function TKMemoContainer.WordPointToIndex(ACanvas: TCanvas; const APoint: TPoint; AWordIndex: TKMemoWordIndex; AOutOfArea, ASelectionExpanding: Boolean; out APosition: TKMemoLinePosition): TKMemoSelectionIndex; var P: TPoint; R: TRect; begin P := APoint; R := Rect(0, 0, Width, Height); OffsetPoint(P, -Left - RealLeftOffset, -Top - RealTopOffset - FWordTopPadding); if PtInRect(R, P) or (AOutOfArea and (P.X >= R.Left) and (P.X < R.Right)) then begin OffsetPoint(P, -FBlockStyle.AllPaddingsLeft, -FBlockStyle.AllPaddingsTop); Result := FBlocks.PointToIndex(ACanvas, P, AOutOfArea, ASelectionExpanding, APosition); end else Result := -1; end; { TKMemoTableCell } constructor TKMemoTableCell.Create; begin inherited; FClip := True; FParaStyle := TKMemoParaStyle.Create; FParaStyle.OnChanged := ParaStyleChanged; FRequiredBorderWidths := TKRect.Create; FRequiredBorderWidths.OnChanged := RequiredBorderWidthsChanged; FSpan := MakeCellSpan(1, 1); //FBlocks.FixEmptyBlocks; only for testing end; destructor TKMemoTableCell.Destroy; begin FParaStyle.Free; FRequiredBorderWidths.Free; inherited; end; procedure TKMemoTableCell.Assign(ASource: TKObject); begin inherited; if ASource is TKMemoTableCell then begin Span := TKMemoTableCell(ASource).Span; end; end; function TKMemoTableCell.ContentLength: TKMemoSelectionIndex; begin if (FSpan.ColSpan > 0) and (FSpan.RowSpan > 0) then Result := inherited ContentLength else Result := 0; end; function TKMemoTableCell.GetParaStyle: TKMemoParaStyle; begin Result := FParaStyle; end; function TKMemoTableCell.GetParentRow: TKMemoTableRow; begin if Parent <> nil then Result := ParentBlocks.Parent as TKMemoTableRow else Result := nil; end; function TKMemoTableCell.GetColIndex: Integer; var Row: TKMemoTableRow; begin Row := ParentRow; if Row <> nil then Result := Row.Blocks.IndexOf(Self) else Result := -1; end; function TKMemoTableCell.GetParentTable: TKMemoTable; var Row: TKMemoTableRow; begin Row := ParentRow; if Row <> nil then Result := Row.ParentTable else Result := nil; end; function TKMemoTableCell.GetRowIndex: Integer; var Table: TKMemoTable; begin Table := ParentTable; if Table <> nil then Result := Table.Blocks.IndexOf(ParentRow) else Result := -1; end; function TKMemoTableCell.PointToIndex(ACanvas: TCanvas; const APoint: TPoint; AFirstRow, ALastRow, AOutOfArea, ASelectionExpanding: Boolean; out APosition: TKMemoLinePosition): TKMemoSelectionIndex; var P: TPoint; R: TRect; begin P := APoint; R := Rect(0, 0, Width, Height); OffsetPoint(P, -Left - RealLeftOffset, -Top - RealTopOffset - FWordTopPadding); if PtInRect(R, P) or AFirstRow and (P.X >= R.Left) and (P.X < R.Right) and (P.Y < R.Bottom) or ALastRow and (P.X >= R.Left) and (P.X < R.Right) and (P.Y >= R.Top) then begin OffsetPoint(P, -FBlockStyle.AllPaddingsLeft, -FBlockStyle.AllPaddingsTop); Result := FBlocks.PointToIndex(ACanvas, P, AOutOfArea, ASelectionExpanding, APosition); end else Result := -1; end; procedure TKMemoTableCell.ParaStyleChanged(Sender: TObject; AReasons: TKMemoUpdateReasons); begin // take some default paragraph properties to cell style FBlockStyle.ContentPadding.Assign(FParaStyle.ContentPadding); end; procedure TKMemoTableCell.RequiredBorderWidthsChanged(Sender: TObject); var Table: TKMemoTable; begin Table := ParentTable; if (Table <> nil) and Table.UpdateUnlocked then Table.FixupBorders; end; procedure TKMemoTableCell.SetColSpan(Value: Integer); var Table: TKMemoTable; ACol, ARow: Integer; begin if Value <> FSpan.ColSpan then begin Table := ParentTable; if (Table <> nil) and Table.UpdateUnlocked and Table.FindCell(Self, ACol, ARow) then Table.CellSpan[ACol, ARow] := MakeCellSpan(Value, FSpan.RowSpan) else FSpan.ColSpan := Value; end; end; procedure TKMemoTableCell.SetRowSpan(Value: Integer); var Table: TKMemoTable; ACol, ARow: Integer; begin if Value <> FSpan.RowSpan then begin Table := ParentTable; if (Table <> nil) and Table.UpdateUnlocked and Table.FindCell(Self, ACol, ARow) then Table.CellSpan[ACol, ARow] := MakeCellSpan(FSpan.ColSpan, Value) else FSpan.RowSpan := Value; end; end; procedure TKMemoTableCell.SetSpan(const Value: TKCellSpan); var Table: TKMemoTable; ACol, ARow: Integer; begin if (Value.ColSpan <> FSpan.ColSpan) or (Value.RowSpan <> FSpan.RowSpan) then begin Table := ParentTable; if (Table <> nil) and Table.UpdateUnlocked and Table.FindCell(Self, ACol, ARow) then Table.CellSpan[ACol, ARow] := Value else FSpan := Value; end; end; function TKMemoTableCell.WordMeasureExtent(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; ARequiredWidth: Integer): TPoint; begin if (FSpan.ColSpan > 0) and (FSpan.RowSpan > 0) then Result := inherited WordMeasureExtent(ACanvas, AWordIndex, ARequiredWidth) else Result := CreateEmptyPoint; end; procedure TKMemoTableCell.WordPaintToCanvas(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; ALeft, ATop: Integer); begin if (FSpan.ColSpan > 0) and (FSpan.RowSpan > 0) then inherited; end; { TKMemoTableRow } constructor TKMemoTableRow.Create; begin inherited; end; destructor TKMemoTableRow.Destroy; begin inherited; end; function TKMemoTableRow.CanAdd(ABlock: TKMemoBlock): Boolean; begin // table row can only accept table cells Result := ABlock is TKMemoTableCell; end; function TKMemoTableRow.GetParentTable: TKMemoTable; begin if Parent <> nil then Result := ParentBlocks.Parent as TKMemoTable else Result := nil; end; procedure TKMemoTableRow.FixedHeightChanged; var I: Integer; begin for I := 0 to CellCount - 1 do Cells[I].FixedHeight := FixedHeight; end; function TKMemoTableRow.GetTotalLineCount: Integer; begin Result := 1; // do not add lines in cells end; function TKMemoTableRow.GetTotalLineRect(Index: TKMemoTotalLineIndex): TRect; begin Result := CreateEmptyRect; // use line info from Parent instead end; function TKMemoTableRow.GetCellCount: Integer; begin Result := Blocks.Count; end; function TKMemoTableRow.GetCells(Index: Integer): TKMemoTableCell; begin if (Index >= 0) and (Index < Blocks.Count) then Result := Blocks[Index] as TKMemoTableCell else Result := nil; end; procedure TKMemoTableRow.SetCellCount(const Value: Integer); var I: Integer; begin if Value <> CellCount then begin if Value > CellCount then begin for I := CellCount to Value - 1 do Blocks.Add(TKMemoTableCell.Create); end else begin for I := Value to CellCount - 1 do Blocks.Delete(Value); end; end; end; procedure TKMemoTableRow.RequiredHeightChanged; var I: Integer; begin for I := 0 to CellCount - 1 do begin Cells[I].FixedHeight := True; Cells[I].RequiredHeight := RequiredHeight; end; end; { TKMemoTable } constructor TKMemoTable.Create; begin inherited; FCellStyle := TKMemoBlockStyle.Create; FCellStyle.Changeable := False; FColCount := 0; FColWidths := TKMemoIndexObjectList.Create; FBlockStyle.WrapMode := wrNone; end; destructor TKMemoTable.Destroy; begin FCellStyle.Free; FColWidths.Free; inherited; end; procedure TKMemoTable.ApplyDefaultCellStyle; var Cell: TKMemoTableCell; Row: TKMemoTableRow; I, J, W: Integer; begin LockUpdate; try for I := 0 to RowCount - 1 do begin Row := Rows[I]; for J := 0 to Row.CellCount - 1 do begin Cell := Row.Cells[J]; if (Cell.ColSpan > 0) and (Cell.RowSpan > 0) then begin W := FCellStyle.BorderWidth; Cell.BlockStyle.Assign(FCellStyle); Cell.BlockStyle.BorderWidth := 0; Cell.BlockStyle.BorderWidths.All := 0; Cell.RequiredBorderWidths.All := W; end; end; end; FixupBorders; finally UnlockUpdate; end; end; procedure TKMemoTable.Assign(ASource: TKObject); var I: Integer; begin inherited; if ASource is TKMemoTable then begin // here cells are already copied, so just update respective fields to avoid SetSize call LockUpdate; try FColCount := TKMemoTable(ASource).ColCount; FColWidths.SetSize(FColCount); for I := 0 to FColCount - 1 do FColWidths[I].Index := TKMemoTable(ASource).ColWidths[I]; finally UnlockUpdate; end; end; end; procedure TKMemoTable.AssignAttributes(ABlock: TKMemoBlock); begin inherited; if ABlock is TKMemoTable then CellStyle.Assign(TKMemoTable(ABlock).CellStyle); end; function TKMemoTable.CalcTotalCellWidth(ACol, ARow: Integer): Integer; var BaseCol, BaseRow: Integer; Cell: TKMemoTableCell; Row: TKMemoTableRow; I, W: Integer; begin FindBaseCell(ACol, ARow, BaseCol, BaseRow); Row := Rows[BaseRow]; Cell := Row.Cells[BaseCol]; Result := 0; for I := BaseCol to BaseCol + Cell.ColSpan - 1 do begin Cell := Row.Cells[I]; if Cell.RequiredWidth > 0 then W := Cell.RequiredWidth else W := Cell.Width; Inc(Result, W); end; end; function TKMemoTable.CanAdd(ABlock: TKMemoBlock): Boolean; begin // table can only accept table rows Result := ABlock is TKMemoTableRow; end; function TKMemoTable.CellValid(ACol, ARow: Integer): Boolean; begin Result := (ARow >= 0) and (ARow < RowCount) and (ACol >= 0) and (ACol < Rows[ARow].CellCount); end; function TKMemoTable.CellVisible(ACol, ARow: Integer): Boolean; var Span: TKCellSpan; begin Span := CellSpan[ACol, ARow]; Result := (Span.ColSpan > 0) and (Span.RowSpan > 0); end; function TKMemoTable.ColValid(ACol: Integer): Boolean; begin Result := (ACol >= 0) and (ACol < FColCount); end; procedure TKMemoTable.FindBaseCell(ACol, ARow: Integer; out BaseCol, BaseRow: Integer); var Span: TKCellSpan; begin BaseCol := ACol; BaseRow := ARow; Span := GetCellSpan(ACol, ARow); if (Span.ColSpan <= 0) and (Span.RowSpan <= 0) then begin BaseCol := ACol + Span.ColSpan; BaseRow := ARow + Span.RowSpan; end; end; function TKMemoTable.FindCell(ACell: TKMemoTableCell; out ACol, ARow: Integer): Boolean; var I, J: Integer; Row: TKMemoTableRow; begin Result := False; for I := 0 to RowCount - 1 do begin Row := Rows[I]; for J := 0 to Row.CellCount - 1 do if Row.Cells[J] = ACell then begin ACol := J; ARow := I; Result := True; Exit; end; end; end; procedure TKMemoTable.FixupBorders; var Cell: TKMemoTableCell; Row: TKMemoTableRow; PrevColCell: TKMemoTableCell; PrevRowCell: TKMemoTableCell; BaseCol, BaseRow, I, J, Width, Part, CurBaseCol, CurBaseRow: Integer; begin LockUpdate; try for I := 0 to RowCount - 1 do begin Row := Rows[I]; for J := 0 to Row.CellCount - 1 do begin Cell := Row.Cells[J]; // find cells in previous row and column (or base cells corresponding to these positions) // these cells cannot be a part of merged area of cells to which the current cell also belongs FindBaseCell(J, I, CurBaseCol, CurBaseRow); PrevRowCell := nil; if I > 0 then begin FindBaseCell(J, I - 1, BaseCol, BaseRow); if (CurBaseCol <> BaseCol) or (CurBaseRow <> BaseRow) then PrevRowCell := Rows[BaseRow].Cells[BaseCol]; end; PrevColCell := nil; if J > 0 then begin FindBaseCell(J - 1, I, BaseCol, BaseRow); if (CurBaseCol <> BaseCol) or (CurBaseRow <> BaseRow) then PrevColCell := Rows[BaseRow].Cells[BaseCol]; end; // assign default cell borders Cell.BlockStyle.BorderWidth := 0; Cell.BlockStyle.BorderWidths.Assign(Cell.RequiredBorderWidths); if PrevColCell <> nil then begin // we split the border width among two neighbor cells in horizontal direction Width := Max(Cell.RequiredBorderWidths.Left, PrevColCell.RequiredBorderWidths.Right); if Width > 0 then begin Part := DivUp(Width, 2); Cell.BlockStyle.BorderWidths.Left := Part; PrevColCell.BlockStyle.BorderWidths.Right := Width - Part; end; end; if PrevRowCell <> nil then begin // we split the border width among two neighbor cells in vertical direction Width := Max(Cell.RequiredBorderWidths.Top, PrevRowCell.RequiredBorderWidths.Bottom); if Width > 0 then begin Part := DivUp(Width, 2); Cell.BlockStyle.BorderWidths.Top := Part; PrevRowCell.BlockStyle.BorderWidths.Bottom := Width - Part end; end; end; end; finally UnlockUpdate; end; end; procedure TKMemoTable.FixupCellSpan; var I, J: Integer; Span, RefSpan: TKCellSpan; Row: TKMemoTableRow; Cell: TKMemoTableCell; begin LockUpdate; try RefSpan := MakeCellSpan(1, 1); // don't make this too complicated, but maybe it is little bit slower: // reset all negative spans for I := 0 to RowCount - 1 do begin Row := Rows[I]; for J := 0 to Row.CellCount - 1 do begin Cell := Row.Cells[J]; if (Cell.ColSpan <= 0) or (Cell.RowSpan <= 0) then Cell.Span := RefSpan; end; end; // create all spans for I := 0 to RowCount - 1 do begin Row := Rows[I]; for J := 0 to Row.CellCount - 1 do begin Cell := Row.Cells[J]; if (Cell.ColSpan > 1) or (Cell.RowSpan > 1) then begin Span := MakeCellSpan(Min(Cell.ColSpan, Row.CellCount - J), Min(Cell.RowSpan, RowCount - I)); Cell.Span := RefSpan; InternalSetCellSpan(J, I, Span); end; end; end; finally UnlockUpdate; end; end; procedure TKMemoTable.FixupCellSpanFromRTF; function HasSomeCellZeroWidth(ARow: TKMemoTableRow): Boolean; var I: Integer; begin Result := False; for I := 0 to ARow.CellCount - 1 do if ARow.Cells[I].RequiredWidth = 0 then begin Result := True; Exit; end; end; function FindValidBaseCell(ACol, ARow: Integer; out AColDelta, ARowDelta: Integer): TKMemoTableCell; var I, J: Integer; Row: TKMemoTableRow; Cell: TKMemoTableCell; begin Result := nil; AColDelta := 0; ARowDelta := 0; Row := nil; for I := ARow downto 0 do begin Row := Rows[I]; Cell := Row.Cells[ACol]; if (Cell.ColSpan >= 0) and (Cell.RowSpan > 0) or (Cell.ColSpan < 0) and (Cell.RowSpan = 0) then Break else Inc(ARowDelta); end; if Row <> nil then begin for J := ACol downto 0 do begin Cell := Row.Cells[J]; if (Cell.RowSpan >= 0) and (Cell.ColSpan > 0) or (Cell.RowSpan < 0) and (Cell.ColSpan = 0) then begin Result := Cell; Break; end else Inc(AColDelta); end; end; end; var I, J, K, CellCnt, ColDelta, MaxXPos, RowDelta, RowXPos, WDelta, XPos: Integer; Row: TKMemoTableRow; Span: TKCellSpan; LastCell, Cell, TmpCell: TKMemoTableCell; begin // this routine assumes the table was loaded from RTF LockUpdate; try { First update our FColCount and FColWidths properties. This is needed because horizontally merged table cells are stored as a single cell and the only distinguishing factor is their width. So go through the table and find every vertical cell split (end of each cell). } MaxXPos := 0; for I := 0 to RowCount - 1 do begin Row := Rows[I]; XPos := 0; for J := 0 to Row.CellCount - 1 do Inc(XPos, Row.Cells[J].RequiredWidth); MaxXPos := Max(MaxXPos, XPos); end; XPos := 0; K := 0; while XPos < MaxXPos do begin WDelta := MaxInt; for I := 0 to RowCount - 1 do begin Row := Rows[I]; J := 0; RowXPos := 0; while (J < Row.CellCount) and (RowXPos <= XPos) do begin Inc(RowXPos, Row.Cells[J].RequiredWidth); Inc(J); end; if RowXPos > XPos then WDelta := Min(RowXPos - XPos, WDelta); end; Inc(XPos, WDelta); if K < FColCount then FColWidths[K].Index := WDelta else begin Inc(FColCount); FColWidths.AddItem(WDelta); end; Inc(K); end; { Now fill the missing cells for each row that has horizontally merged cells. } for I := 0 to RowCount - 1 do begin Row := Rows[I]; if (Row.CellCount < FColCount) or HasSomeCellZeroWidth(Row) then begin CellCnt := 0; LastCell := Row.Cells[CellCnt]; // this cell must always exist for J := 0 to FColCount - 1 do if LastCell <> nil then begin // fill the gaps for possibly merged cells WDelta := LastCell.RequiredWidth - FColWidths[J].Index; if WDelta = 0 then begin // OK, here this cell was certainly not merged so take next cell Inc(CellCnt); if CellCnt < Row.CellCount then LastCell := Row.Cells[CellCnt] else LastCell := nil; end else if WDelta > 0 then begin // the cell must have been merged here TmpCell := nil; if CellCnt < Row.CellCount - 1 then begin // first check if next cell has zero width TmpCell := Row.Cells[CellCnt + 1]; if TmpCell.RequiredWidth > 0 then TmpCell := nil; end; if TmpCell = nil then begin // otherwise insert new cell TmpCell := TKMemoTableCell.Create; TmpCell.RowSpan := LastCell.RowSpan; Row.Blocks.Insert(CellCnt + 1, TmpCell); end; TmpCell.FixedWidth := True; TmpCell.RequiredWidth := WDelta; TmpCell.ColSpan := 0; // for later fixup LastCell.RequiredWidth := LastCell.RequiredWidth - WDelta; LastCell := TmpCell; Inc(CellCnt); end; end; // delete superfluous cells while Row.CellCount > FColCount do Row.Blocks.Delete(FColCount); end else begin for J := 0 to FColCount - 1 do Row.Cells[J].RequiredWidth := FColWidths[J].Index; end; end; // here we fixup the Span properties for I := 0 to RowCount - 1 do begin Row := Rows[I]; for J := 0 to Row.CellCount - 1 do begin Cell := Row.Cells[J]; Span := Cell.Span; if (Span.ColSpan = 0) or (Span.RowSpan = 0) then begin LastCell := FindValidBaseCell(J, I, ColDelta, RowDelta); if LastCell <> nil then begin LastCell.ColSpan := Max(LastCell.ColSpan, ColDelta + 1); LastCell.RowSpan := Max(LastCell.RowSpan, RowDelta + 1); Cell.ColSpan := -ColDelta; Cell.RowSpan := -RowDelta; end end; Cell.FixedWidth := False; Cell.FixedHeight := False; if (Span.ColSpan > 0) and (Span.RowSpan > 0) then Cell.Blocks.AddParagraph; end; end; finally UnlockUpdate; end; end; function TKMemoTable.GetCells(ACol, ARow: Integer): TKMemoTableCell; begin if CellValid(ACol, ARow) then Result := Rows[ARow].Cells[ACol] else Result := nil; end; function TKMemoTable.GetCellSpan(ACol, ARow: Integer): TKCellSpan; begin if CellValid(ACol, ARow) then Result := Rows[ARow].Cells[ACol].Span else Result := MakeCellSpan(1, 1); end; function TKMemoTable.GetColWidths(Index: Integer): Integer; begin Result := FColWidths[Index].Index; end; function TKMemoTable.GetRowCount: Integer; begin Result := Blocks.Count; end; function TKMemoTable.GetRowHeights(Index: Integer): Integer; begin if (Index >= 0) and (Index < RowCount) then Result := Rows[Index].Height else Result := 0 end; function TKMemoTable.GetRows(Index: Integer): TKMemoTableRow; begin if (Index >= 0) and (Index < RowCount) then Result := Blocks[Index] as TKMemoTableRow else Result := nil; end; procedure TKMemoTable.InternalSetCellSpan(ACol, ARow: Integer; const Value: TKCellSpan); procedure Merge(ACol1, ARow1, ACol2, ARow2: Integer); var I, J: Integer; Row: TKMemoTableRow; Cell: TKMemoTableCell; begin for I := ARow1 to ARow2 - 1 do begin Row := Rows[I]; for J := ACol1 to ACol2 - 1 do begin Cell := Row.Cells[J]; if (I = ACol1) and (J = ARow1) then Cell.Span := MakeCellSpan(ACol2 - ACol1, ARow2 - ARow1) else Cell.Span := MakeCellSpan(ACol1 - J, ARow1 - I); end; end; end; procedure Split(ACol1, ARow1, ACol2, ARow2: Integer); var I, J: Integer; Row: TKMemoTableRow; Cell: TKMemoTableCell; RefSpan: TKCellSpan; begin RefSpan := MakeCellSpan(1, 1); for I := ARow1 to ARow2 - 1 do begin Row := Rows[I]; for J := ACol1 to ACol2 - 1 do begin Cell := Row.Cells[J]; Cell.Span := RefSpan; end; end; end; var I, J, BaseCol, BaseRow: Integer; Span: TKCellSpan; Row: TKMemoTableRow; Cell: TKMemoTableCell; begin LockUpdate; try Span := GetCellSpan(ACol, ARow); if (Span.ColSpan > 1) or (Span.RowSpan > 1) then begin // destroy previously merged area Split(ACol, ARow, ACol + Span.ColSpan, ARow + Span.RowSpan); end; for J := ARow to ARow + Value.RowSpan - 1 do begin Row := Rows[J]; for I := ACol to ACol + Value.ColSpan - 1 do begin Cell := Row.Cells[I]; Span := Cell.Span; if (Span.ColSpan <> 1) or (Span.RowSpan <> 1) then begin // adjust all four overlapping spans FindBaseCell(I, J, BaseCol, BaseRow); if (BaseCol <> ACol) or (BaseRow <> ARow) then begin Span := GetCellSpan(BaseCol, BaseRow); Split(Max(ACol, BaseCol), Max(ARow, BaseRow), Min(ACol + Value.ColSpan, BaseCol + Span.ColSpan), Min(ARow + Value.RowSpan, BaseRow + Span.RowSpan)); Merge(BaseCol, BaseRow, BaseCol + Span.ColSpan, ARow); Merge(BaseCol, ARow + Value.RowSpan, BaseCol + Span.ColSpan, BaseRow + Span.RowSpan); Merge(BaseCol, Max(ARow, BaseRow), ACol, Min(ARow + Value.RowSpan, BaseRow + Span.RowSpan)); Merge(ACol + Value.ColSpan, Max(ARow, BaseRow), BaseCol + Span.ColSpan, Min(ARow + Value.RowSpan, BaseRow + Span.RowSpan)); end; end; if (I = ACol) and (J = ARow) then Cell.Span := Value else // negative cell span - means this cell is hidden // it indicates where base cell for this span is located Cell.Span := MakeCellSpan(ACol - I, ARow - J); end; end; finally UnlockUpdate; end; end; function TKMemoTable.RowValid(ARow: Integer): Boolean; begin Result := (ARow >= 0) and (ARow < RowCount); end; procedure TKMemoTable.SetCellSpan(ACol, ARow: Integer; Value: TKCellSpan); var Span: TKCellSpan; begin if CellValid(ACol, ARow) then begin Value.ColSpan := MinMax(Value.ColSpan, 1, Rows[ARow].CellCount - ACol); Value.RowSpan := MinMax(Value.RowSpan, 1, RowCount - ARow); Span := GetCellSpan(ACol, ARow); if (Span.ColSpan <> Value.ColSpan) or (Span.RowSpan <> Value.RowSpan) then InternalSetCellSpan(ACol, ARow, Value); end; end; procedure TKMemoTable.SetColCount(const Value: Integer); begin SetSize(Value, RowCount); end; procedure TKMemoTable.SetColWidths(Index: Integer; const Value: Integer); var I: Integer; begin if Value <> ColWidths[Index] then begin FColWidths[Index].Index := Value; LockUpdate; try for I := 0 to RowCount - 1 do Rows[I].Cells[Index].RequiredWidth := Value; finally UnlockUpdate; end; end; end; procedure TKMemoTable.SetRowCount(const Value: Integer); begin SetSize(ColCount, Value); end; procedure TKMemoTable.SetRowHeights(Index: Integer; const Value: Integer); begin if (Index >= 0) and (Index < RowCount) then Rows[Index].RequiredHeight := Value; end; procedure TKMemoTable.SetSize(AColCount, ARowCount: Integer); var I, J: Integer; Row: TKMemoTableRow; begin LockUpdate; try if AColCount <> FColCount then begin FColCount := AColCount; for I := 0 to RowCount - 1 do Rows[I].CellCount := FColCount; FColWidths.SetSize(FColCount); end; if ARowCount <> RowCount then begin if ARowCount > RowCount then begin for I := RowCount to ARowCount - 1 do begin Row := TKMemoTableRow.Create; Row.CellCount := FColCount; Row.RequiredWidth := RequiredWidth; for J := 0 to FColCount - 1 do if ColWidths[J] <> 0 then Row.Cells[J].RequiredWidth := ColWidths[J]; Blocks.Add(Row); end; end else begin for I := ARowCount to RowCount - 1 do Blocks.Delete(RowCount - 1); end; end; finally UnlockUpdate; end; end; function TKMemoTable.WordMeasureExtent(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; ARequiredWidth: Integer): TPoint; function GetExtentSpanned(AExtents: TKMemoIndexObjectList; AIndex, ASpan: Integer): Integer; var I: Integer; begin Result := 0; for I := AIndex to AIndex + ASpan - 1 do if I < AExtents.Count then Result := Result + AExtents[I].Index; end; const cMinColSize = 20; var I, J, K, Len, RealColCount, ColWidth, DefColCount, DefSpace, AvailableSpace, OverflowSpace, RequiredSpace, MeasuredWidth, MinSpannedWidth, NewWidth, UndefColCount, UndefColWidth, UndefSpace, TotalSpace, PosX, PosY, VDelta: Integer; Extent, MeasExtent: TPoint; Row: TKMemoTableRow; Cell: TKmemoTableCell; DefColWidths, MeasWidths, MinWidths, Heights: TKMemoIndexObjectList; begin // this is the table layout calculation // first get required table width if FFixedWidth then begin if FRequiredWidth > 0 then // required width given for entire table, scale all column widths ARequiredWidth := FRequiredWidth - FBlockStyle.AllPaddingsLeft + FBlockStyle.AllPaddingsRight else begin // required width not given for entire table, use column widths ARequiredWidth := 0; for I := 0 to FColCount - 1 do Inc(ARequiredWidth, FColWidths[I].Index); end; end else Dec(ARequiredWidth, FBlockStyle.AllPaddingsLeft + FBlockStyle.AllPaddingsRight); // calculate real column count, this may be different from FColCount RealColCount := 0; for I := 0 to RowCount - 1 do RealColCount := Max(RealColCount, Rows[I].CellCount); // calculate predefined column widths DefColCount := 0; DefSpace := 0; for I := 0 to FColCount - 1 do begin Inc(DefSpace, FColWidths[I].Index); if FColWidths[I].Index > 0 then Inc(DefColCount); end; if RealColCount > DefColCount then begin UndefColCount := RealColCount - DefColCount; UndefSpace := Max(ARequiredWidth - DefSpace, UndefColCount * cMinColSize); UndefColWidth := DivDown(UndefSpace, UndefColCount); end else begin UndefSpace := 0; UndefColWidth := cMinColSize; end; TotalSpace := DefSpace + UndefSpace; // now measure cells DefColWidths := TKMemoIndexObjectList.Create; MeasWidths := TKMemoIndexObjectList.Create; MinWidths := TKMemoIndexObjectList.Create; Heights := TKMemoIndexObjectList.Create; try DefColWidths.SetSize(RealColCount); MeasWidths.SetSize(RealColCount); MinWidths.SetSize(RealColCount); Heights.SetSize(RowCount); for J := 0 to RowCount - 1 do Heights[J].Index := 0; // first measure cells with predefined column widths for I := 0 to RealColCount - 1 do begin if (I < FColCount) and (FColWidths[I].Index > 0) then // always scale the predefined column widths to fit into ARequiredWidth // set FixedWidth to true and RequiredWidth to zero or sum of all column widths to get exact column widths ColWidth := Max(MulDiv(FColWidths[I].Index, ARequiredWidth, TotalSpace), cMinColSize) else ColWidth := UndefColWidth; DefColWidths[I].Index := ColWidth; end; // measure unmerged cells for I := 0 to RealColCount - 1 do begin MeasWidths[I].Index := 0; MinWidths[I].Index := 0; for J := 0 to RowCount - 1 do begin Row := Rows[J]; if I < Row.CellCount then begin Cell := Row.Cells[I]; if Cell.ColSpan = 1 then begin Extent := Cell.WordMeasureExtent(ACanvas, 0, cMinColSize); MinWidths[I].Index := Max(MinWidths[I].Index, Extent.X); MeasExtent := Cell.WordMeasureExtent(ACanvas, 0, DefColWidths[I].Index); MeasWidths[I].Index := Max(MeasWidths[I].Index, MeasExtent.X); if Cell.RowSpan = 1 then Heights[J].Index := Max(Heights[J].Index, MeasExtent.Y); end; end; end; if MeasWidths[I].Index = 0 then MeasWidths[I].Index := DefColWidths[I].Index; if MinWidths[I].Index = 0 then MinWidths[I].Index := DefColWidths[I].Index; end; // measure horizontally merged cells for I := 0 to RealColCount - 1 do begin for J := 0 to RowCount - 1 do begin Row := Rows[J]; if I < Row.CellCount then begin Cell := Row.Cells[I]; if Cell.ColSpan > 1 then begin MinSpannedWidth := 0; for K := I to I + Cell.ColSpan - 1 do Inc(MinSpannedWidth, MinWidths[K].Index); Extent := Cell.WordMeasureExtent(ACanvas, 0, cMinColSize); if Extent.X > MinSpannedWidth then begin // equally distribute the width of merged cells across participating columns for K := I to I + Cell.ColSpan - 1 do begin MinWidths[K].Index := DivUp(MinWidths[K].Index * Extent.X, MinSpannedWidth); MeasWidths[K].Index := Max(MeasWidths[K].Index, MinWidths[K].Index); end; end; end; end; end; end; // then, if some MeasWidths were bigger than ColWidth, recalculate remaining columns to fit required width MeasuredWidth := 0; for I := 0 to RealColCount - 1 do Inc(MeasuredWidth, MeasWidths[I].Index); OverflowSpace := MeasuredWidth - ARequiredWidth; if MeasuredWidth > ARequiredWidth then repeat AvailableSpace := 0; RequiredSpace := ARequiredWidth; for I := 0 to RealColCount - 1 do if MeasWidths[I].Index > MinWidths[I].Index then Inc(AvailableSpace, MeasWidths[I].Index) else Dec(RequiredSpace, MinWidths[I].Index); // AvailableSpace = sum of all MeasWidths bigger than MinWidths // RequiredSpace = ARequiredWidth - sum of all unchangeable MeasWidths (lower than or equal to MinWidths) // now distribute OverflowSpace across AvailableSpace if AvailableSpace > 0 then begin for I := 0 to RealColCount - 1 do if (MeasWidths[I].Index > MinWidths[I].Index) and (OverflowSpace > 0) then begin NewWidth := Max(Trunc(MeasWidths[I].Index * RequiredSpace / AvailableSpace), MinWidths[I].Index); if NewWidth >= MinWidths[I].Index then begin Dec(OverflowSpace, MeasWidths[I].Index - NewWidth); if OverflowSpace < 0 then begin Inc(NewWidth, -OverflowSpace); OverflowSpace := 0; end; MeasWidths[I].Index := NewWidth; end; end; end; until (OverflowSpace = 0) or (AvailableSpace = 0); // then, measure again with maximum allowed column width and update vertical extents for I := 0 to RowCount - 1 do begin Row := Rows[I]; for J := 0 to Row.CellCount - 1 do begin Cell := Row.Cells[J]; if CellVisible(J, I) and ((MeasWidths[J].Index <> Cell.Width) or (Cell.ColSpan > 1) or (Cell.RowSpan > 1)) then begin Extent := Cell.WordMeasureExtent(ACanvas, 0, GetExtentSpanned(MeasWidths, J, Cell.ColSpan)); // update vertical extents if Cell.RowSpan = 1 then Heights[I].Index := Max(Heights[I].Index, Extent.Y); end; end; end; // then, update vertical extents for row-spanned cells, because some of these cells might be taller than remaining cells for I := 0 to RowCount - 1 do begin Row := Rows[I]; for J := 0 to Row.CellCount - 1 do begin Cell := Row.Cells[J]; if CellVisible(J, I) and (Cell.RowSpan > 1) then begin VDelta := Cell.Height - GetExtentSpanned(Heights, I, Cell.RowSpan); if VDelta > 0 then Heights[I + Cell.RowSpan - 1].Index := Heights[I + Cell.RowSpan - 1].Index + VDelta; end; end; end; // finally, set cell/row positions and heights ClearLines; Extent.X := 0; for I := 0 to RealColCount - 1 do Inc(Extent.X, MeasWidths[I].Index); Len := 0; PosY := 0; for I := 0 to RowCount - 1 do begin Row := Rows[I]; PosX := 0; for J := 0 to Row.CellCount - 1 do begin Cell := Row.Cells[J]; // Cell.SetBlockExtent(Cell.WordWidth[0], VertExtents[I].Index); // No! Cell is measured by default way Cell.WordLeft[0] := PosX; Cell.WordTop[0] := 0; if CellVisible(J, I) then begin Cell.WordHeight[0] := GetExtentSpanned(Heights, I, Cell.RowSpan); end else begin Cell.WordHeight[0] := Heights[I].Index; end; Inc(PosX, MeasWidths[J].Index); end; Row.SetBlockExtent(Extent.X, Heights[I].Index); Row.WordLeft[0] := 0; Row.WordTop[0] := PosY; Row.WordHeight[0] := Heights[I].Index; Row.AddSingleLine; AddBlockLine(I, Len, I, Len + Row.ContentLength - 1, 0, PosY, Extent.X, Heights[I].Index); Inc(Len, Row.ContentLength); Inc(PosY, Heights[I].Index); end; Extent.Y := PosY; Inc(Extent.X, FBlockStyle.AllPaddingsLeft + FBlockStyle.AllPaddingsRight); Inc(Extent.Y, FBlockStyle.AllPaddingsTop + FBlockStyle.AllPaddingsBottom); SetBlockExtent(Extent.X, Extent.Y); WordLeft[0] := 0; WordTop[0] := 0; WordHeight[0] := 0; finally DefColWidths.Free; MeasWidths.Free; MinWidths.Free; Heights.Free; end; Result := Point(Extent.X, Extent.Y); end; function TKMemoTable.WordMouseAction(ACanvas: TCanvas; AWordIndex: TKMemoWordIndex; AAction: TKMemoMouseAction; const APoint: TPoint; AShift: TShiftState): Boolean; var P: TPoint; R: TRect; I, J: Integer; Row: TKMemoTableRow; Cell: TKMemoTableCell; begin Result := False; P := APoint; R := Rect(0, 0, Width, Height); OffsetPoint(P, -Left - RealLeftOffset, -Top - RealTopOffset - FWordTopPadding); if PtInRect(R, P) then begin OffsetPoint(P, -FBlockStyle.AllPaddingsLeft, -FBlockStyle.AllPaddingsTop); for I := 0 to RowCount - 1 do begin Row := Rows[I]; for J := 0 to Row.CellCount - 1 do begin Cell := Row.Cells[J]; if (Cell.ColSpan > 0) and (Cell.RowSpan > 0) then begin Result := Result or Cell.WordMouseAction(ACanvas, 0, AAction, P, AShift); end; end; Dec(P.Y, Row.Height); end; end; end; function TKMemoTable.WordPointToIndex(ACanvas: TCanvas; const APoint: TPoint; AWordIndex: TKMemoWordIndex; AOutOfArea, ASelectionExpanding: Boolean; out APosition: TKMemoLinePosition): TKMemoSelectionIndex; var P: TPoint; R: TRect; I, J: Integer; Len: TKMemoSelectionIndex; Row: TKMemoTableRow; Cell: TKMemoTableCell; begin Result := -1; P := APoint; R := Rect(0, 0, Width, Height); OffsetPoint(P, -Left - RealLeftOffset, -Top - RealTopOffset - FWordTopPadding); if PtInRect(R, P) or (AOutOfArea and (P.X >= R.Left) and (P.X < R.Right)) then begin OffsetPoint(P, -FBlockStyle.AllPaddingsLeft, -FBlockStyle.AllPaddingsTop); Len := 0; I := 0; while (Result < 0) and (I < RowCount) do begin Row := Rows[I]; J := 0; while (Result < 0) and (J < Row.CellCount) do begin Cell := Row.Cells[J]; if (Cell.ColSpan > 0) and (Cell.RowSpan > 0) then begin Result := Cell.PointToIndex(ACanvas, P, I = 0, I + Cell.RowSpan >= RowCount, AOutOfArea, ASelectionExpanding, APosition); if Result < 0 then Inc(Len, Cell.ContentLength); end; Inc(J); end; Dec(P.Y, Row.Height); Inc(I); end; if Result >= 0 then Inc(Result, Len); end; end; { TKMemoMeasState } procedure TKMemoMeasState.Assign(AState: TKMemoMeasState); begin Assert(AState <> nil); PosX := AState.PosX; PosY := AState.PosY; RightX := AState.RightX; CurIndex := AState.CurIndex; CurBlockIndex := AState.CurBlockIndex; CurWordIndex := AState.CurWordIndex; CurTotalWord := AState.CurTotalWord; LineHeight := AState.LineHeight; ParaWidth := AState.ParaWidth; ParaPosY := AState.ParaPosY; LastIndex := AState.LastIndex; LastBlockIndex := AState.LastBlockIndex; LastWordIndex := AState.LastWordIndex; LastTotalWord := AState.LastTotalWord; RequiredWidth := AState.RequiredWidth; IsBreakable := AState.IsBreakable; IsParagraph := AState.IsParagraph; CurParaStyle := AState.CurParaStyle; CurParagraph := AState.CurParagraph; end; procedure TKMemoMeasState.Clear; begin PosX := 0; PosY := 0; RightX := 0; CurBlockIndex := 0; CurIndex := 0; CurWordIndex := 0; CurTotalWord := 0; LineHeight := 0; ParaWidth := 0; ParaPosY := 0; LastBlockIndex := 0; LastIndex := 0; LastWordIndex := 0; LastTotalWord := 0; RequiredWidth := 0; IsBreakable := False; IsParagraph := False; CurParaStyle := nil; CurParagraph := nil; end; function TKMemoMeasState.Initialized: Boolean; begin Result := CurParaStyle <> nil; end; { TKMemoBlocks } constructor TKMemoBlocks.Create; begin inherited; OwnsObjects := True; FBackState := TKMemoMeasState.Create; FBackState.Clear; FExtent := CreateEmptyPoint; FIgnoreParaMark := False; FLines := TKMemoLines.Create; FMemoNotifier := nil; FParent := nil; FRelPos := TKMemoIndexObjectList.Create; FSelEnd := 0; FSelStart := 0; FState := TKMemoMeasState.Create; FState.Clear; FOnUpdate := nil; Update([muContent]); end; destructor TKMemoBlocks.Destroy; begin FOnUpdate := nil; if FMemoNotifier <> nil then FMemoNotifier.BlocksFreeNotification(Self); FreeAndNil(FLines); FreeAndNil(FRelPos); FBackState.Free; FState.Free; Inc(FUpdateLock); // prevent calls of UpdateAttributes inherited; end; procedure TKMemoBlocks.DoUpdate(AReasons: TKMemoUpdateReasons); begin if Assigned(FOnUpdate) then FOnUpdate(AReasons); end; function TKMemoBlocks.AddAt(AObject: TKMemoBlock; At: TKMemoBlockIndex): TKMemoBlockIndex; begin if AObject <> nil then begin // check if parent can add this item if (FParent = nil) or FParent.CanAdd(AObject) then begin if Empty and (Count > 0) then inherited Delete(0); if (At < 0) or (At >= Count) then begin Result := inherited Add(AObject); end else begin inherited Insert(At, AObject); Result := At; end; end else begin AObject.Free; Result := -1; end; end else Result := -1; end; function TKMemoBlocks.AddContainer(At: TKMemoBlockIndex): TKMemoContainer; begin LockUpdate; try Result := TKMemoContainer.Create; AddAt(Result, At); finally UnlockUpdate; end; end; function TKMemoBlocks.AddHyperlink(ABlock: TKMemoHyperlink; At: TKMemoBlockIndex): TKMemoHyperlink; begin Result := ABlock; Result.TextStyle.Assign(LastTextStyle(At)); Result.DefaultStyle; AddAt(Result, At); end; function TKMemoBlocks.AddHyperlink(const AText, AURL: TKString; At: TKMemoBlockIndex): TKMemoHyperlink; begin Result := TKMemoHyperLink.Create; Result.TextStyle.Assign(LastTextStyle(At)); Result.DefaultStyle; Result.Text := AText; Result.URL := AURL; AddAt(Result, At); end; function TKMemoBlocks.AddImageBlock(AImage: TPicture; At: TKMemoBlockIndex): TKMemoImageBlock; begin Result := TKMemoImageBlock.Create; if AImage <> nil then Result.Image := AImage.Graphic; AddAt(Result, At); end; function TKMemoBlocks.AddImageBlock(const APath: TKString; At: TKMemoBlockIndex): TKMemoImageBlock; begin Result := TKMemoImageBlock.Create; if APath <> '' then Result.LoadFromFile(APath); AddAt(Result, At); end; function TKMemoBlocks.AddParagraph(At: TKMemoBlockIndex): TKMemoParagraph; var PA: TKMemoParagraph; begin Result := TKMemoParagraph.Create; PA := GetNearestParagraphBlock(At); if PA <> nil then begin Result.AssignAttributes(PA); if PA.ParaStyle.NumberStartAt > 0 then begin PA.ParaStyle.NumberStartAt := 0; end; end else begin Result.TextStyle.Assign(LastTextStyle(At)); Result.ParaStyle.Assign(GetDefaultParaStyle); end; AddAt(Result, At); end; function TKMemoBlocks.AddTable(At: TKMemoBlockIndex): TKMemoTable; begin Result := TKMemoTable.Create; AddAt(Result, At); end; function TKMemoBlocks.AddTextBlock(const AText: TKString; At: TKMemoBlockIndex): TKMemoTextBlock; begin Result := TKMemoTextBlock.Create; Result.TextStyle.Assign(LastTextStyle(At)); Result.Text := AText; AddAt(Result, At); end; procedure TKMemoBlocks.Assign(ASource: TKObjectList); begin inherited; if ASource is TKMemoBlocks then begin IgnoreParaMark := TKMemoBlocks(ASource).IgnoreParaMark; end; end; function TKMemoBlocks.BlockIndexToBlock(ABlockIndex: TKMemoBlockIndex): TKMemoBlock; begin if (ABlockIndex >= 0) and (ABlockIndex < Count) then Result := Items[ABlockIndex] else Result := nil; end; procedure TKMemoBlocks.CallAfterUpdate; begin if FUpdateReasons <> [] then begin Update(FUpdateReasons); FUpdateReasons := []; end; end; procedure TKMemoBlocks.CallBeforeUpdate; begin FUpdateReasons := []; end; procedure TKMemoBlocks.Clear; begin LockUpdate; try inherited; FSelEnd := -1; FSelStart := -1; finally UnlockUpdate; end; end; procedure TKMemoBlocks.ClearSelection(ATextOnly: Boolean); var I, First, Last: Integer; Block: TKMemoBlock; Changed: Boolean; begin LockUpdate; try I := 0; First := -1; Last := -1; Changed := False; while I < Count do begin Block := Items[I]; if (Block.SelStart >= 0) and (Block.SelLength > 0) then begin if ATextOnly and (Block is TKMemoContainer) then begin TKMemoContainer(Block).ClearSelection(ATextOnly); end else begin if Block.ContentLength = 0 then begin Delete(I); Changed := True; end else begin if Block.SelLength = Block.SelectableLength(True) then begin Delete(I); Changed := True; Dec(I); end else begin if First < 0 then First := I else Last := I; end; end; end; end; Inc(I); end; if Last >= 0 then begin Items[Last].ClearSelection(ATextOnly); Changed := True; end; if First >= 0 then begin Items[First].ClearSelection(ATextOnly); Changed := True; end; if FSelStart < FSelEnd then FSelEnd := FSelStart else FSelStart := FSelEnd; FSelStart := MinMax(FSelStart, 0, FSelectableLength); FSelEnd := MinMax(FSelEnd, 0, FSelectableLength); if Changed then FixEmptyBlocks; finally UnlockUpdate; end; end; procedure TKMemoBlocks.ConcatEqualBlocks; var I: Integer; Block, LastBlock: TKMemoBlock; begin // concat equal text blocks LockUpdate; try LastBlock := nil; for I := 0 to Count - 1 do begin Block := Items[I]; if Block is TKMemoContainer then TKmemoContainer(Block).Blocks.ConcatEqualBlocks else if (Block is TKMemoTextBlock) and (LastBlock is TKMemoTextBlock) and not (Block is TKMemoParagraph) then begin if TKmemoTextBlock(Block).TextStyle.EqualProperties(TKMemoTextBlock(LastBlock).TextStyle) then begin TKMemoTextBlock(LastBlock).Concat(TKmemoTextBlock(Block)); TKmemoTextBlock(Block).Text := ''; end; end; LastBlock := Block; end; // and delete empty blocks I := 0; while I < Count do begin Block := Items[I]; if (Block is TKMemoTextBlock) and (Items[I].ContentLength = 0) then Delete(I) else Inc(I); end; finally UnlockUpdate; end; end; procedure TKMemoBlocks.DeleteBOL(At: TKMemoSelectionIndex); var LineStart: TKMemoSelectionIndex; TmpPos: TKMemoLinePosition; begin LineStart := LineStartIndexByIndex(At, True, TmpPos); Select(LineStart, At - LineStart); ClearSelection; end; procedure TKMemoBlocks.DeleteChar(At: TKMemoSelectionIndex); var NextIndex: TKMemoSelectionIndex; begin if SelLength <> 0 then ClearSelection else if not IndexAtEndOfContainer(At, True) then begin NextIndex := NextIndexByCharCount(At, 1); Select(At, NextIndex - At, True, True); ClearSelection; end; end; procedure TKMemoBlocks.DeleteEOL(At: TKMemoSelectionIndex); var LineEnd: TKMemoSelectionIndex; TmpPos: TKMemoLinePosition; begin LineEnd := LineEndIndexByIndex(At, True, True, TmpPos); Select(At, LineEnd - At); ClearSelection; end; procedure TKMemoBlocks.DeleteLastChar(At: TKMemoSelectionIndex); var LastIndex: TKMemoSelectionIndex; begin if SelLength <> 0 then ClearSelection else if not IndexAtBeginningOfContainer(At, True) then begin LastIndex := NextIndexByCharCount(At, -1); Select(LastIndex, At - LastIndex, True, True); ClearSelection; end; end; procedure TKMemoBlocks.DeleteLine(At: TKMemoSelectionIndex); var LineStart, LineEnd: TKMemoSelectionIndex; TmpPos: TKMemoLinePosition; begin LineStart := LineStartIndexByIndex(At, True, TmpPos); LineEnd := LineEndIndexByIndex(At, True, True, TmpPos); Select(LineStart, LineEnd - LineStart); ClearSelection; end; function TKMemoBlocks.EOLToNormal(var AIndex: TKMemoSelectionIndex): Boolean; begin Result := False; if GetLinePosition = eolEnd then begin Dec(AIndex); Result := True; end; end; procedure TKMemoBlocks.FixEmptyBlocks; var I: TKMemoBlockIndex; SelectableCnt: Integer; Block: TKMemoBlock; begin // do not leave empty blocks, always add single paragraph SelectableCnt := 0; for I := 0 to Count - 1 do begin Block := Items[I]; if (Block.Position = mbpText) and not (Block is TKMemoContainer) then Inc(SelectableCnt); end; if SelectableCnt = 0 then begin AddParagraph; end; end; procedure TKMemoBlocks.FixEOL(AIndex: TKMemoSelectionIndex; AAdjust: Boolean; var ALinePos: TKMemoLinePosition); var Block: TKMemoBlock; LineIndex: TKMemoLineIndex; LocalIndex: TKMemoSelectionIndex; begin if SelLength = 0 then begin if AAdjust then EOLToNormal(AIndex); if AIndex < 0 then ALinePos := eolInside else begin Block := IndexToBlock(AIndex, LocalIndex); if Block is TKMemoContainer then begin TKMemoContainer(Block).Blocks.FixEOL(LocalIndex, False, ALinePos); end else begin LineIndex := IndexToLineIndex(AIndex); if (LineIndex >= 0) and (AIndex >= LineEndIndex[LineIndex]) then begin Block := Items[FLines[LineIndex].EndBlock]; if Block is TKMemoParagraph then begin ALinePos := eolInside; end else if AIndex > LineEndIndex[LineIndex] then ALinePos := eolEnd; end; end; end; if ALinePos = eolInside then begin FSelStart := Min(FSelStart, FSelectableLength - 1); FSelEnd := Min(FSelEnd, FSelectableLength - 1); end; end; end; function TKMemoBlocks.GetBoundsRect: TRect; begin Result := Rect(0, 0, Width, Height); end; function TKMemoBlocks.GetDefaultTextStyle: TKMemoTextStyle; begin if FParent <> nil then Result := FParent.DefaultTextStyle else if FMemoNotifier <> nil then Result := FMemoNotifier.GetDefaultTextStyle else Result := nil; end; function TKMemoBlocks.GetDefaultParaStyle: TKMemoParaStyle; begin if FParent <> nil then Result := FParent.DefaultParaStyle else if FMemoNotifier <> nil then Result := FMemoNotifier.GetDefaultParaStyle else Result := nil; end; function TKMemoBlocks.GetEmpty: Boolean; begin Result := Count = 0; end; function TKMemoBlocks.GetFirstBlock: TKMemoBlock; begin if Count > 0 then Result := Items[0] else Result := nil; end; function TKMemoBlocks.GetItem(Index: TKMemoBlockIndex): TKMemoBlock; begin Result := TKMemoBlock(inherited GetItem(Index)); end; function TKMemoBlocks.GetLastBlock: TKMemoBlock; begin if Count > 0 then Result := Items[Count - 1] else Result := nil; end; function TKMemoBlocks.GetLastBlockByClass(ABlockIndex: TKMemoBlockIndex; AClass: TKMemoBlockClass): TKMemoBlock; begin Result := nil; while (ABlockIndex > 0) and (Result = nil) and not (Items[ABlockIndex - 1] is TKMemoParagraph) do begin Dec(ABlockIndex); if Items[ABlockIndex] is AClass then Result := Items[ABlockIndex]; end; end; function TKMemoBlocks.GetLineBottom(ALineIndex: TKMemoLineIndex): Integer; begin Result := 0; if (ALineIndex >= 0) and (ALineIndex < LineCount) then Result := FLines[ALineIndex].Position.Y + FLines[ALineIndex].Extent.Y; end; function TKMemoBlocks.GetLineCount: Integer; begin Result := FLines.Count; end; function TKMemoBlocks.GetLineEndIndex(ALineIndex: TKMemoLineIndex): TKMemoSelectionIndex; begin Result := -1; if (ALineIndex >= 0) and (ALineIndex < LineCount) then begin Result := FLines[ALineIndex].EndIndex; end; end; function TKMemoBlocks.GetLineFloat(ALineIndex: TKMemoLineIndex): Boolean; var I: TKMemoBlockIndex; Block: TKMemoBlock; begin Result := True; if (ALineIndex >= 0) and (ALineIndex < LineCount) then begin for I := FLines[ALineIndex].StartBlock to FLines[ALineIndex].EndBlock do begin Block := Items[I]; if Block.WrapMode = wrNone then begin Result := False; Break; end; end; end; end; function TKMemoBlocks.GetLineHeight(ALineIndex: TKMemoLineIndex): Integer; begin if (ALineIndex >= 0) and (ALineIndex < LineCount) then Result := FLines[ALineIndex].Extent.Y else Result := 0; end; function TKMemoBlocks.GetLineInfo(ALineIndex: TKMemoLineIndex): TKMemoLine; begin if (ALineIndex >= 0) and (ALineIndex < LineCount) then Result := FLines[ALineIndex] else Result := nil; end; function TKMemoBlocks.GetLineLeft(ALineIndex: TKMemoLineIndex): Integer; begin Result := 0; if (ALineIndex >= 0) and (ALineIndex < LineCount) then Result := FLines[ALineIndex].Position.X; end; function TKMemoBlocks.GetLinePosition: TKMemoLinePosition; begin if FMemoNotifier <> nil then Result := FMemoNotifier.GetLinePosition else Result := eolInside; end; function TKMemoBlocks.GetLineRect(ALineIndex: TKMemoLineIndex): TRect; begin if (ALineIndex >= 0) and (ALineIndex < LineCount) then FLines[ALineIndex].LineRect else Result := CreateEmptyRect; end; function TKMemoBlocks.GetLineRight(ALineIndex: TKMemoLineIndex): Integer; begin Result := 0; if (ALineIndex >= 0) and (ALineIndex < LineCount) then Result := FLines[ALineIndex].Position.X + FLines[ALineIndex].Extent.X; end; function TKMemoBlocks.GetLineText(ALineIndex: TKMemoLineIndex): TKString; var BlockIndex: TKMemoBlockIndex; WordIndex, St, En: TKMemoWordIndex; Block: TKMemoBlock; begin Result := ''; if (ALineIndex >= 0) and (ALineIndex < LineCount) then begin for BlockIndex := FLines[ALineIndex].StartBlock to FLines[ALineIndex].EndBlock do begin Block := Items[BlockIndex]; if Block.Position = mbpText then begin GetWordIndexes(BlockIndex, ALineIndex, St, En); for WordIndex := St to En do Result := Result + Items[BlockIndex].Words[WordIndex]; end; end; end; end; function TKMemoBlocks.GetLineSize(ALineIndex: TKMemoLineIndex): Integer; var BlockIndex: TKMemoBlockIndex; WordIndex, St, En: TKMemoWordIndex; Block: TKMemoBlock; begin Result := 0; if (ALineIndex >= 0) and (ALineIndex < LineCount) then begin for BlockIndex := FLines[ALineIndex].StartBlock to FLines[ALineIndex].EndBlock do begin Block := Items[BlockIndex]; if Block.Position = mbpText then begin GetWordIndexes(BlockIndex, ALineIndex, St, En); for WordIndex := St to En do Inc(Result, Items[BlockIndex].WordLength[WordIndex]); end; end; end; end; function TKMemoBlocks.GetLineStartIndex(ALineIndex: TKMemoLineIndex): TKMemoSelectionIndex; begin Result := -1; if (ALineIndex >= 0) and (ALineIndex < LineCount) then begin Result := FLines[ALineIndex].StartIndex; end; end; function TKMemoBlocks.GetLineTop(ALineIndex: TKMemoLineIndex): Integer; begin Result := 0; if (ALineIndex >= 0) and (ALineIndex < LineCount) then Result := FLines[ALineIndex].Position.Y; end; function TKMemoBlocks.GetLineWidth(ALineIndex: TKMemoLineIndex): Integer; begin if (ALineIndex >= 0) and (ALineIndex < LineCount) then Result := FLines[ALineIndex].Extent.X else Result := 0; end; function TKMemoBlocks.GetMaxWordLength: TKMemoSelectionIndex; begin if FMemoNotifier <> nil then Result := FMemoNotifier.GetMaxWordLength else Result := cMaxWordLengthDef; end; function TKMemoBlocks.GetNearestAnchorBlockIndex(ABlockIndex: TKMemoBlockIndex): TKMemoBlockIndex; begin Result := -1; if ABlockIndex >= 0 then while (Result < 0) and (ABlockIndex >= 0) do begin if Items[ABlockIndex] is TKMemoParagraph then Result := ABlockIndex; Dec(ABlockIndex); end; end; function TKMemoBlocks.GetNearestParagraphBlockIndex(ABlockIndex: TKMemoBlockIndex): TKMemoBlockIndex; var Block: TKMemoBlock; begin Result := -1; if ABlockIndex >= 0 then while (Result < 0) and (ABlockIndex < Count) do begin Block := Items[ABlockIndex]; if Block is TKMemoParagraph then Result := ABlockIndex; Inc(ABlockIndex); end; end; function TKMemoBlocks.GetNearestParagraphBlock(ABlockIndex: TKMemoBlockIndex): TKMemoParagraph; var BlockIndex: TKMemoBlockIndex; begin BlockIndex := GetNearestParagraphBlockIndex(ABlockIndex); if BlockIndex >= 0 then Result := BlockIndexToBlock(BlockIndex) as TKMemoParagraph else Result := nil; end; function TKMemoBlocks.GetNearestWordIndexes(AIndex: TKMemoSelectionIndex; AAdjust: Boolean; AIncludeWhiteSpaces: Boolean; out AStart, AEnd: TKMemoSelectionIndex): Boolean; var I, BackupBlock, CurBlock: TKMemoBlockIndex; J, BackupWord, CurWord: TKMemoWordIndex; CurIndex, LastIndex, WLen, WLenWOWS: TKMemoSelectionIndex; IsBreakable: Boolean; Block: TKMemoBlock; begin Result := False; if AAdjust then EOLToNormal(AIndex); if AIndex >= 0 then begin CurBlock := -1; CurWord := -1; I := 0; CurIndex := 0; LastIndex := 0; while (CurBlock < 0) and (I < Count) do begin Block := Items[I]; LastIndex := CurIndex; Inc(CurIndex, Block.SelectableLength); if (AIndex >= LastIndex) and (AIndex < CurIndex) then begin CurBlock := I; if Block is TKMemoContainer then begin Result := TKMemoContainer(Block).Blocks.GetNearestWordIndexes(AIndex - LastIndex, False, AIncludeWhiteSpaces, AStart, AEnd); if Result then begin Inc(AStart, LastIndex); Inc(AEnd, LastIndex); end; end else begin J := 0; while (CurWord < 0) and (J < Block.WordCount) and (LastIndex <= AIndex) do begin WLen := Block.WordLength[J]; if AIncludeWhiteSpaces then WLenWOWS := WLen else WLenWOWS := Block.WordLengthWOWS[J]; if (AIndex >= LastIndex) and (AIndex < LastIndex + WLenWOWS) then CurWord := J else Inc(LastIndex, WLen); Inc(J); end; end; end; Inc(I); end; if (CurBlock >= 0) and (CurWord >= 0) then begin Result := True; BackupBlock := CurBlock; BackupWord := CurWord; AStart := LastIndex; AEnd := LastIndex; // we've found the word // go back and find first nonbreakable word Dec(CurWord); if CurWord < 0 then Dec(CurBlock); IsBreakable := False; while not IsBreakable and (CurBlock >= 0) do begin Block := Items[CurBlock]; if CurWord < 0 then CurWord := Block.WordCount - 1; if not (Block is TKMemoTextBlock) then IsBreakable := True else begin while not IsBreakable and (CurWord >= 0) do begin IsBreakable := Block.WordBreakable[CurWord]; if not Isbreakable then begin Dec(AStart, Block.WordLength[CurWord]); Dec(CurWord); end; end; CurWord := -1; Dec(CurBlock); end; end; // go forward and find first nonbreakable word CurBlock := BackupBlock; CurWord := BackupWord; IsBreakable := False; while not IsBreakable and (CurBlock < Count) do begin Block := Items[CurBlock]; if not (Block is TKMemoTextBlock) then IsBreakable := True else begin while not IsBreakable and (CurWord < Block.WordCount) do begin IsBreakable := Block.WordBreakable[CurWord]; if not IsBreakable or AIncludeWhiteSpaces then WLen := Block.WordLength[CurWord] else WLen := Block.WordLengthWOWS[CurWord]; if not (Block is TKMemoParagraph) then Inc(AEnd, WLen); Inc(CurWord); end; CurWord := 0; Inc(CurBlock); end; end; end; end; end; function TKMemoBlocks.GetNextBlockByClass(ABlockIndex: TKMemoBlockIndex; AClass: TKMemoBlockClass): TKMemoBlock; begin Result := nil; while (ABlockIndex < Count - 1) and (Result = nil) and not (Items[ABlockIndex + 1] is TKMemoParagraph) do begin Inc(ABlockIndex); if Items[ABlockIndex] is AClass then Result := Items[ABlockIndex]; end; end; function TKMemoBlocks.GetPageCount(APageHeight: Integer): Integer; var I, J, MaxLine: TKMemoTotalLineIndex; TmpPageBegin: Integer; R: TRect; begin Result := 1; // always at least one page if FLines.Count > 0 then TmpPageBegin := FLines[TKMemoLineIndex(0)].Position.Y else TmpPageBegin := 0; I := 0; J := -1; MaxLine := TotalLineCount - 1; while I <= MaxLine do begin if I <> J then begin R := TotalLineRect[I]; J := I; end; if R.Bottom - TmpPageBegin > APageHeight then begin TmpPageBegin := R.Top; if R.Bottom - R.Top > APageHeight then Inc(TmpPageBegin, APageHeight) else Inc(I); Inc(Result); end else Inc(I); end; end; procedure TKMemoBlocks.GetPageData(APageHeight, APage: Integer; out AOffset, AHeight: Integer); var I, J, MaxLine: TKMemoTotalLineIndex; TmpPageBegin, TmpPage: Integer; R: TRect; begin TmpPage := 0; if FLines.Count > 0 then TmpPageBegin := FLines[TKMemoLineIndex(0)].Position.Y else TmpPageBegin := 0; I := 0; J := -1; MaxLine := TotalLineCount - 1; while (I <= MaxLine) and (TmpPage <= APage) do begin if I <> J then begin R := TotalLineRect[I]; J := I; end; if R.Bottom - TmpPageBegin > APageHeight then begin if TmpPage < APage then begin TmpPageBegin := R.Top; if R.Bottom - R.Top > APageHeight then Inc(TmpPageBegin, APageHeight) else Inc(I); Inc(TmpPage); end else begin // finished measuring current page R.Bottom := R.Top; // take bottom coord of previous line Break; end; end else Inc(I); end; AOffset := TmpPageBegin; AHeight := Min(R.Bottom - TmpPageBegin, APageHeight); end; function TKMemoBlocks.GetParentBlocks: TKMemoBlocks; begin if FParent is TKMemoContainer then Result := TKMemoContainer(FParent).ParentBlocks else Result := nil; end; function TKMemoBlocks.GetParentBlocksForBlock( ABlock: TKMemoBlock): TKMemoBlocks; var I: Integer; Block: TKMemoBlock; begin Result := nil; for I := 0 to Count - 1 do begin Block := Items[I]; if ABlock = Block then begin Result := Self; Exit; end else if Block is TKMemoContainer then begin Result := TKMemoContainer(Block).Blocks.GetParentBlocksForBlock(ABlock); if Result <> nil then Exit; end; end; end; function TKMemoBlocks.GetParentMemo: TKCustomMemo; begin if FMemoNotifier <> nil then Result := FMemoNotifier.GetMemo else Result := nil; end; function TKMemoBlocks.GetRealSelEnd: TKMemoSelectionIndex; begin if FSelStart <= FSelEnd then Result := FSelEnd else Result := FSelStart; end; function TKMemoBlocks.GetRealSelLength: TKMemoSelectionIndex; begin Result := RealSelEnd - RealSelStart; end; function TKMemoBlocks.GetRealSelStart: TKMemoSelectionIndex; begin if FSelStart <= FSelEnd then Result := FSelStart else Result := FSelEnd; end; procedure TKMemoBlocks.GetSelColors(out TextColor, Background: TColor); begin if FMemoNotifier <> nil then FMemoNotifier.GetSelColors(TextColor, Background); end; function TKMemoBlocks.GetSelectionHasPara: Boolean; var I: TKMemoBlockIndex; CurIndex, LastIndex, TmpSelEnd, TmpSelStart: TKMemoSelectionIndex; Block: TKMemoBlock; begin Result := False; if SelLength > 0 then begin TmpSelEnd := RealSelEnd; TmpSelStart := RealSelStart; I := 0; CurIndex := 0; while not Result and (I < Count) do begin Block := Items[I]; LastIndex := CurIndex; Inc(CurIndex, Block.SelectableLength); if (LastIndex <= TmpSelEnd) and (TmpSelStart < CurIndex) then begin if Block is TKMemoContainer then Result := TKMemoContainer(Block).Blocks.SelectionHasPara else if Block is TKMemoParagraph then Result := True; end; Inc(I); end; end end; function TKMemoBlocks.GetSelectionParaStyle: TKMemoParaStyle; var Block: TKMemoBlock; BlockIndex: TKMemoBlockIndex; LocalIndex: TKMemoSelectionIndex; begin BlockIndex := IndexToBlockIndex(RealSelEnd, LocalIndex); if BlockIndex >= 0 then begin Block := Items[BlockIndex]; if Block is TKMemoContainer then Result := TKMemoContainer(Block).Blocks.SelectionParaStyle else begin Block := GetNearestParagraphBlock(BlockIndex); if Block <> nil then Result := Block.ParaStyle else Result := nil; end; end else Result := nil; end; function TKMemoBlocks.GetSelectionTextStyle: TKMemoTextStyle; var Block, LastBlock: TKmemoBlock; BlockIndex: TKMemoBlockIndex; LocalIndex: TKMemoSelectionIndex; begin Result := nil; BlockIndex := IndexToBlockIndex(RealSelEnd, LocalIndex); if BlockIndex >= 0 then begin if BlockIndex > 0 then LastBlock := Items[BlockIndex - 1] else LastBlock := nil; if (LocalIndex > 0) or (LastBlock is TKMemoParagraph) or not (LastBlock is TKMemoTextBlock) then begin Block := Items[BlockIndex]; if Block is TKMemoContainer then Result := TKMemoContainer(Block).Blocks.SelectionTextStyle else if Block is TKMemoTextBlock then Result := TKMemoTextBlock(Block).TextStyle; end else if LastBlock <> nil then begin Result := TKMemoTextBlock(LastBlock).TextStyle end; end; end; function TKMemoBlocks.GetSelLength: TKMemoSelectionIndex; begin Result := FSelEnd - FSelStart; end; function TKMemoBlocks.GetSelText: TKString; var I: TKMemoBlockIndex; Block: TKMemoBlock; begin Result := ''; for I := 0 to Count - 1 do begin Block := Items[I]; if Block.SelLength > 0 then Result := Result + Block.SelText; end; Result := UnicodeStringReplace(Result, NewLineChar, cEOL, [rfReplaceAll]); end; function TKMemoBlocks.GetShowFormatting: Boolean; begin if FMemoNotifier <> nil then Result := FMemoNotifier.GetShowFormatting else Result := False; end; function TKMemoBlocks.GetText: TKString; var I: TKMemoBlockIndex; Block: TKMemoBlock; begin Result := ''; for I := 0 to Count - 1 do begin Block := Items[I]; Result := Result + Block.Text; end; Result := UnicodeStringReplace(Result, NewLineChar, cEOL, [rfReplaceAll]); end; function TKMemoBlocks.GetTotalLeftOffset: Integer; begin if FParent <> nil then begin Result := FParent.Left + FParent.LeftOffset; if FParent is TKMemoContainer then Inc(Result, TKMemoContainer(FParent).BlockStyle.AllPaddingsLeft + TKMemoContainer(FParent).ParentBlocks.TotalLeftOffset); end else Result := 0; end; function TKMemoBlocks.GetTotalLineCount: Integer; var I: TKMemoLineIndex; Line: TKMemoLine; Block: TKMemoBlock; begin Result := 0; for I := 0 to FLines.Count - 1 do begin Line := FLines[I]; Block := Items[Line.StartBlock]; if Block is TKMemoContainer then Inc(Result, TKMemoContainer(Block).TotalLineCount) else Inc(Result); end; end; function TKMemoBlocks.GetTotalLineRect(Index: TKMemoTotalLineIndex): TRect; var I: TKMemoLineIndex; TmpIndex, TmpCount: TKMemoTotalLineIndex; Line: TKMemoLine; Block: TKMemoBlock; R: TRect; begin Result := CreateEmptyRect; TmpIndex := 0; for I := 0 to FLines.Count - 1 do begin Line := FLines[I]; Block := Items[Line.StartBlock]; if Block is TKMemoContainer then begin TmpCount := TKMemoContainer(Block).TotalLineCount; if (Index >= TmpIndex) and (Index < TmpIndex + TmpCount) then begin R := TKMemoContainer(Block).TotalLineRect[Index - TmpIndex]; if R.Bottom = R.Top then // empty line info Result := Line.LineRect else Result := R; Break; end else Inc(TmpIndex, TmpCount); end else begin if Index = TmpIndex then begin Result := Line.LineRect; Break; end else Inc(TmpIndex); end; end; end; function TKMemoBlocks.GetTotalTopOffset: Integer; begin if FParent <> nil then begin Result := FParent.Top + FParent.TopOffset + FParent.WordTopPadding[0]; if FParent is TKMemoContainer then Inc(Result, TKMemoContainer(FParent).BlockStyle.AllPaddingsTop + TKMemoContainer(FParent).ParentBlocks.TotalTopOffset); end else Result := 0; end; procedure TKMemoBlocks.GetWordIndexes(ABlockIndex: TKMemoBlockIndex; ALineIndex: TKMemoLineIndex; out AStart, AEnd: TKMemoWordIndex); begin if ABlockIndex = FLines[ALineIndex].StartBlock then AStart := FLines[ALineIndex].StartWord else AStart := 0; if ABlockIndex = FLines[ALineIndex].EndBlock then AEnd := FLines[ALineIndex].EndWord else AEnd := Items[ABlockIndex].WordCount - 1; end; function TKMemoBlocks.IndexAboveLastLine(AIndex: TKMemoSelectionIndex; AAdjust: Boolean): Boolean; var Block: TKMemoBlock; LineIndex: TKMemoLineIndex; LocalIndex: TKMemoSelectionIndex; begin if AAdjust then EOLToNormal(AIndex); LineIndex := IndexToLineIndex(AIndex); Result := LineIndex < FLines.Count - 1; if not Result then begin Block := IndexToBlock(AIndex, LocalIndex); if Block is TKMemoContainer then Result := TKMemoContainer(Block).Blocks.IndexAboveLastLine(LocalIndex, False) end; end; function TKMemoBlocks.IndexToInnerBlock(AIndex: TKMemoSelectionIndex): TKMemoBlock; var LocalIndex: TKMemoSelectionIndex; begin Result := IndexToBlock(AIndex, LocalIndex); if Result is TKMemoContainer then Result := TKMemoContainer(Result).Blocks.IndexToInnerBlock(LocalIndex); end; function TKMemoBlocks.IndexAtBeginningOfContainer(AIndex: TKMemoSelectionIndex; AAdjust: Boolean): Boolean; var Block: TKMemoBlock; LocalIndex: TKMemoSelectionIndex; begin if AAdjust then EOLToNormal(AIndex); Block := IndexToBlock(AIndex, LocalIndex); if Block is TKMemoContainer then Result := TKMemoContainer(Block).Blocks.IndexAtBeginningOfContainer(LocalIndex, False) else begin NormalToEOL(AIndex); Result := AIndex <= 0; end; end; function TKMemoBlocks.IndexAtEndOfContainer(AIndex: TKMemoSelectionIndex; AAdjust: Boolean): Boolean; var Block: TKMemoBlock; LocalIndex: TKMemoSelectionIndex; begin if AAdjust then EOLToNormal(AIndex); Block := IndexToBlock(AIndex, LocalIndex); if Block is TKMemoContainer then Result := TKMemoContainer(Block).Blocks.IndexAtEndOfContainer(LocalIndex, False) else begin NormalToEOL(AIndex); Result := AIndex >= FSelectableLength; end; end; function TKMemoBlocks.IndexBelowFirstLine(AIndex: TKMemoSelectionIndex; AAdjust: Boolean): Boolean; var Block: TKMemoBlock; LineIndex: TKMemoLineIndex; LocalIndex: TKMemoSelectionIndex; begin if AAdjust then EOLToNormal(AIndex); LineIndex := IndexToLineIndex(AIndex); Result := LineIndex > 0; if not Result then begin Block := IndexToBlock(AIndex, LocalIndex); if Block is TKMemoContainer then Result := TKMemoContainer(Block).Blocks.IndexBelowFirstLine(LocalIndex, False) end; end; function TKMemoBlocks.IndexToBlockIndex(AIndex: TKMemoSelectionIndex; out ALocalIndex: TKMemoSelectionIndex): TKMemoBlockIndex; var I: TKMemoBlockIndex; CurIndex, LastIndex: TKMemoSelectionIndex; begin Result := -1; ALocalIndex := -1; if AIndex >= 0 then begin if AIndex < FSelectableLength then begin I := 0; CurIndex := 0; while (Result < 0) and (I < Count) do begin LastIndex := CurIndex; Inc(CurIndex, Items[I].SelectableLength); if (AIndex >= LastIndex) and (AIndex < CurIndex) then begin Result := I; ALocalIndex := AIndex - LastIndex; end; Inc(I); end; end else if Count > 0 then begin Result := Count - 1; ALocalIndex := Items[Result].SelectableLength; end; end end; function TKMemoBlocks.IndexToBlocks(AIndex: TKMemoSelectionIndex; out ALocalIndex: TKMemoSelectionIndex): TKMemoBlocks; var Block: TKMemoBlock; LocalIndex: TKMemoSelectionIndex; begin Block := IndexToBlock(AIndex, LocalIndex); if Block is TKMemoContainer then Result := TKMemoContainer(Block).Blocks.IndexToBlocks(LocalIndex, ALocalIndex) else begin Result := Self; ALocalIndex := AIndex; end; end; function TKMemoBlocks.IndexToBlock(AIndex: TKMemoSelectionIndex; out ALocalIndex: TKMemoSelectionIndex): TKMemoBlock; var BlockIndex: TKMemoBlockIndex; begin BlockIndex := IndexToBlockIndex(AIndex, ALocalIndex); if BlockIndex >= 0 then Result := Items[BlockIndex] else Result := nil; end; function TKMemoBlocks.IndexToLineIndex(AIndex: TKMemoSelectionIndex): TKMemoLineIndex; var I: TKMemoLineIndex; begin Result := -1; if (AIndex >= 0) and (AIndex < FSelectableLength) then begin for I := 0 to LineCount - 1 do begin if (AIndex >= FLines[I].StartIndex) and (AIndex <= FLines[I].EndIndex) then begin Result := I; Break; end; end; end else if AIndex = FSelectableLength then Result := LineCount - 1; end; function TKMemoBlocks.IndexToRect(ACanvas: TCanvas; AIndex: TKMemoSelectionIndex; ACaret, AAdjust: Boolean): TRect; var LineIndex: TKMemoLineIndex; Tmp: Integer; begin LineIndex := IndexToLineIndex(AIndex); if LineIndex >= 0 then begin Result := LineToRect(ACanvas, AIndex, LineIndex, ACaret); if AAdjust then begin // move the rectangle to the right Tmp := Result.Right - Result.Left; Result.Left := Result.Right; Result.Right := Result.Left + Tmp; end; if not ACaret then begin // expand rect to enable vertical caret movement if (LineIndex > 0) and (Result.Top = LineTop[LineIndex]) then begin Tmp := LineTop[LineIndex] - LineBottom[LineIndex - 1]; if Tmp > 0 then Dec(Result.Top, Tmp); end; if (LineIndex < LineCount - 1) and (Result.Bottom = LineBottom[LineIndex]) then begin Tmp := LineTop[LineIndex + 1] - LineBottom[LineIndex]; if Tmp > 0 then Inc(Result.Bottom, Tmp); end; end; end else Result := Rect(0, 0, 0, Abs(GetDefaultTextStyle.Font.Height)); end; procedure TKMemoBlocks.InsertChar(At: TKMemoSelectionIndex; const AValue: TKChar; AOverWrite: Boolean; ATextStyle: TKMemoTextStyle); var NextIndex: TKMemoSelectionIndex; begin if SelLength <> 0 then begin ClearSelection; At := FSelEnd; end else if AOverwrite then DeleteChar(At); if InsertString(At, True, AValue, ATextStyle) then begin NextIndex := NextIndexByCharCount(At, 1); Select(NextIndex, 0, True, True); end; end; procedure TKMemoBlocks.InsertNewLine(At: TKMemoSelectionIndex); var NextIndex: TKMemoSelectionIndex; AtEnd: Boolean; begin if SelLength > 0 then begin ClearSelection; At := FSelEnd; end; AtEnd := IndexAtEndOfContainer(At, True); // always insert (don't overwrite) if InsertParagraph(At, True) and not AtEnd then begin NextIndex := NextIndexByCharCount(At, 1); Select(NextIndex, 0, True, True); end; end; function TKMemoBlocks.InsertParagraph(AIndex: TKMemoSelectionIndex; AAdjust: Boolean): Boolean; var BlockIndex: TKMemoBlockIndex; LocalIndex: TKMemoSelectionIndex; Block: TKMemoBlock; begin if AAdjust then EOLToNormal(AIndex); LockUpdate; try BlockIndex := IndexToBlockIndex(AIndex, LocalIndex); if BlockIndex >= 0 then begin Block := Items[BlockIndex]; if not (Block is TKMemoContainer) then NormalToEOL(LocalIndex); Result := Block.InsertParagraph(LocalIndex); end else begin AddParagraph; Result := True; end; finally UnlockUpdate; end; end; procedure TKMemoBlocks.InsertPlainText(AIndex: TKMemoSelectionIndex; const AValue: TKString); var I, Ln, St: Integer; S: TKString; begin LockUpdate; try St := 1; I := 1; Ln := Length(Avalue); while I <= Ln do begin if AValue[I] = cLF then begin if I > St then begin S := Copy(AValue, St, I - St); S := UnicodeStringReplace(S, cCR, '', [rfReplaceAll]); // on Unix systems if (S <> '') and InsertString(AIndex, False, S) then begin Inc(AIndex, StringLength(S)); UpdateAttributes; // drb, November 2019 end; end; if InsertParagraph(AIndex, True) then Inc(AIndex); UpdateAttributes; St := I + 1; end; Inc(I); end; if I > St then begin S := Copy(AValue, St, I - St + 1); if S <> '' then if InsertString(AIndex, True, S) then UpdateAttributes; // drb, November 2019 end; finally UnlockUpdate; end; end; function TKMemoBlocks.InsertString(AIndex: TKMemoSelectionIndex; AAdjust: Boolean; const AValue: TKString; ATextStyle: TKMemoTextStyle): Boolean; var BlockIndex: TKMemoBlockIndex; LocalIndex: TKMemoSelectionIndex; Block, NewBlock, LastBlock, NextBlock: TKMemoBlock; begin Result := False; if AAdjust then EOLToNormal(AIndex); LockUpdate; try BlockIndex := IndexToBlockIndex(AIndex, LocalIndex); if BlockIndex >= 0 then begin Block := Items[BlockIndex]; if not (Block is TKMemoContainer) then NormalToEOL(LocalIndex); NewBlock := nil; // get last Block if BlockIndex > 0 then LastBlock := Items[BlockIndex - 1] else LastBlock := nil; // proceed with adding text if ATextStyle <> nil then begin if LocalIndex = 0 then begin // insert new text BlockIndex NewBlock := AddTextBlock(AValue, BlockIndex); end else begin // split current block to add new block with different text style in between NextBlock := Block.Split(LocalIndex); AddAt(NextBlock, BlockIndex + 1); NewBlock := AddTextBlock(AValue, BlockIndex + 1); end; end else if LocalIndex = 0 then begin // we are at local position 0 so we can use previous text block or add new one if (LastBlock is TKMemoTextBlock) and LastBlock.CanAddText then begin // insert character at the end of last BlockIndex Result := LastBlock.InsertString(AValue); end else if Block.CanAddText then begin // insert character at the beginning of current block if previous one cannot be used Result := Block.InsertString(AValue, LocalIndex); end else begin // insert new text block if current block cannot add text NewBlock := AddTextBlock(AValue, BlockIndex); end; end else begin // we are in the middle of current block if Block.CanAddText then begin // current block can insert text, so do it at given location Result := Block.InsertString(AValue, LocalIndex); end else if LocalIndex = Block.ContentLength then begin // current block cannot insert text, so insert new text block // but only when we are at the end of the current block NewBlock := AddTextBlock(AValue, BlockIndex + 1); end; end; if NewBlock <> nil then begin BlockIndex := IndexOf(NewBlock); // get last and next items if BlockIndex > 0 then LastBlock := Items[BlockIndex - 1] else LastBlock := nil; if BlockIndex < Count - 1 then NextBlock := Items[BlockIndex + 1] else NextBlock := nil; // assign attributes from last or next block if LastBlock is TKMemoParagraph then begin // beginning of new line, so take from next text block and, // if there is none, take from last or next paragraph Block := GetNextBlockByClass(BlockIndex, TKMemoTextBlock); if Block <> nil then NewBlock.AssignAttributes(Block) else if NextBlock is TKMemoParagraph then NewBlock.AssignAttributes(NextBlock) else NewBlock.AssignAttributes(LastBlock); end else begin // otherwise take from last text block and, if there is none, // take from next text block Block := GetLastBlockByClass(BlockIndex, TKMemoTextBlock); if Block <> nil then NewBlock.AssignAttributes(Block) else begin Block := GetNextBlockByClass(BlockIndex, TKMemoTextBlock); if Block <> nil then NewBlock.AssignAttributes(Block) else if NextBlock is TKMemoParagraph then NewBlock.AssignAttributes(NextBlock); end; end; if (ATextStyle <> nil) and (NewBlock is TKMemoTextBlock) then TKMemoTextBlock(NewBlock).TextStyle.Assign(ATextStyle); Result := True; end; end else begin AddTextBlock(AValue); Result := True; end; finally UnlockUpdate; end; end; function TKMemoBlocks.InsideOfTable: Boolean; begin if FParent is TKMemoTable then Result := True else if FParent is TKMemoContainer then Result := TKMemoContainer(FParent).ParentBlocks.InsideOfTable else Result := False; end; function TKMemoBlocks.BlockToIndex(ABlock: TKMemoBlock): TKMemoSelectionIndex; var I: TKMemoBlockIndex; LastIndex: TKMemoSelectionIndex; Block: TKMemoBlock; begin Result := -1; if ABlock.Position = mbpText then begin LastIndex := 0; for I := 0 to Count - 1 do begin Block := Items[I]; if ABlock = Block then begin Result := LastIndex; Exit; end else if Block is TKMemoContainer then begin Result := TKMemoContainer(Block).Blocks.BlockToIndex(ABlock); if Result >= 0 then begin Inc(Result, LastIndex); Exit; end; end; Inc(LastIndex, Block.SelectableLength); end; end; end; function TKMemoBlocks.LastTextStyle(ABlockIndex: TKMemoBlockIndex): TKMemoTextStyle; var Block: TKMemoBlock; begin Block := GetLastBlockByClass(ABlockIndex, TKMemoTextBlock); if Block is TKMemoTextBlock then Result := TKMemoTextBlock(Block).TextStyle else Result := DefaultTextStyle; end; function TKMemoBlocks.LineEndIndexByIndex(AIndex: TKMemoSelectionIndex; AAdjust, ASelectionExpanding: Boolean; out ALinePos: TKMemoLinePosition): TKMemoSelectionIndex; var Block: TKMemoBlock; LineIndex: TKMemoLineIndex; LocalIndex: TKMemoSelectionIndex; begin Result := -1; if AAdjust then EOLToNormal(AIndex); ALinePos := eolInside; Block := IndexToBlock(AIndex, LocalIndex); if Block is TKMemoContainer then begin Result := TKMemoContainer(Block).Blocks.LineEndIndexByIndex(LocalIndex, False, ASelectionExpanding, ALinePos); if Result >= 0 then Inc(Result, AIndex - LocalIndex); end; if Result < 0 then begin LineIndex := IndexToLineIndex(AIndex); if LineIndex >= 0 then begin Result := LineEndIndex[LineIndex]; Block := Items[FLines[LineIndex].EndBlock]; if ASelectionExpanding or not (Block is TKMemoParagraph) then begin ALinePos := eolEnd; Inc(Result); end; end else Result := 0; end; end; function TKMemoBlocks.LineStartIndexByIndex(AIndex: TKMemoSelectionIndex; AAdjust: Boolean; out ALinePos: TKMemoLinePosition): TKMemoSelectionIndex; var Block: TKMemoBlock; LineIndex: TKMemoLineIndex; LocalIndex: TKMemoSelectionIndex; begin Result := -1; if AAdjust then EOLToNormal(AIndex); ALinePos := eolInside; Block := IndexToBlock(AIndex, LocalIndex); if Block is TKMemoContainer then begin Result := TKMemoContainer(Block).Blocks.LineStartIndexByIndex(LocalIndex, False, ALinePos); if Result >= 0 then Inc(Result, AIndex - LocalIndex); end; if Result < 0 then begin LineIndex := IndexToLineIndex(AIndex); if LineIndex >= 0 then Result := LineStartIndex[LineIndex] else Result := 0; end; end; function TKMemoBlocks.LineToRect(ACanvas: TCanvas; AIndex: TKMemoSelectionIndex; ALineIndex: TKMemoLineIndex; ACaret: Boolean): TRect; var BlockIndex: TKMemoBlockIndex; WordIndex, St, En: TKMemoWordIndex; LastIndex, CurIndex: TKMemoSelectionIndex; Block: TKMemoBlock; TmpRect: TRect; Found, TmpFound: Boolean; begin Result := CreateEmptyRect; if (ALineIndex >= 0) and (ALineIndex < LineCount) then begin Found := False; TmpFound := False; CurIndex := FLines[ALineIndex].StartIndex; BlockIndex := Flines[ALineIndex].StartBlock; while not Found and (BlockIndex <= FLines[ALineIndex].EndBlock) do begin Block := Items[BlockIndex]; if Block.Position = mbpText then begin GetWordIndexes(BlockIndex, ALineIndex, St, En); WordIndex := St; while not Found and (WordIndex <= En) do begin LastIndex := CurIndex; Inc(CurIndex, Block.WordLength[WordIndex]); if (AIndex = CurIndex) and (Block is TKMemoTextBlock) then begin // take rectangle from last WordIndex TmpRect := Block.WordIndexToRect(ACanvas, WordIndex, AIndex - LastIndex - 1, ACaret); TmpFound := not IsRectEmpty(TmpRect); end else if (AIndex >= LastIndex) and (AIndex < CurIndex) then begin Result := Block.WordIndexToRect(ACanvas, WordIndex, AIndex - LastIndex, ACaret); if TmpFound and ACaret then begin // simulate caret height from last WordIndex // it is better for subscripts and superscripts Result.Top := TmpRect.Top; Result.Bottom := TmpRect.Bottom; end; Found := True; end; Inc(WordIndex); end; end; Inc(BlockIndex); end; end; end; procedure TKMemoBlocks.ListChanged(AList: TKMemoList; ALevel: TKMemoListLevel); var I: TKMemoBlockIndex; Block: TKMemoBlock; PA: TKMemoParagraph; begin // update indentation for all list bound paragraphs according to list level info if (AList <> nil) and (ALevel <> nil) then begin LockUpdate; try for I := 0 to Count - 1 do begin Block := Items[I]; if Block is TKMemoParagraph then begin PA := TKmemoParagraph(Block); if (PA.NumberingList = AList) and (ALevel = PA.NumberingListLevel) then begin PA.ParaStyle.FirstIndent := ALevel.FirstIndent; PA.ParaStyle.LeftPadding := ALevel.LeftIndent; end; end else if Block is TKMemoContainer then TKmemoContainer(Block).Blocks.ListChanged(AList, ALevel); end; finally UnlockUpdate; end; end; end; procedure TKMemoBlocks.LoadFromRTFStream(AStream: TStream; AtIndex: TKMemoSelectionIndex); var Reader: TKMemoRTFReader; begin Reader := TKMemoRTFReader.Create(ParentMemo); try Reader.LoadFromStream(AStream, Self, AtIndex); finally Reader.Free; end; end; procedure TKMemoBlocks.MeasureExtent(ACanvas: TCanvas; ARequiredWidth: Integer); function GetParaStyle(AParagraph: TKMemoParagraph): TKMemoParaStyle; begin if AParagraph <> nil then Result := AParagraph.ParaStyle else Result := DefaultParaStyle; end; function RectCollidesWithNonText(const ARect: TRect; var ACollisionRect: TRect): Boolean; var I: Integer; Block: TKMemoBlock; DoCheck: Boolean; begin Result := False; I := 0; while not Result and (I < FRelPos.Count) do begin Block := Items[FRelPos[I].Index]; //if (Block.Position = mbpAbsolute) or (CurBlock > FRelPos[I].Index) then begin ACollisionRect := Block.BoundsRect; KFunctions.OffsetRect(ACollisionRect, Block.LeftOffset, Block.TopOffset); DoCheck := True; case Block.WrapMode of wrAround, wrTight:; wrAroundLeft, wrTightLeft: ACollisionRect.Right := FState.RightX; wrAroundRight, wrTightRight: ACollisionRect.Left := FState.CurParaStyle.LeftPadding; wrTopBottom: begin ACollisionRect.Left := FState.CurParaStyle.LeftPadding; ACollisionRect.Right := FState.RightX; end; else DoCheck := False; end; if DoCheck then Result := RectInRect(ACollisionRect, ARect); end; Inc(I); end; end; function AddLine: Boolean; var NumberBlock: TKmemoTextBlock; procedure MoveWordsOnLine(ALineIndex: TKMemoLineIndex; AStartPos, AEndPos, ADelta: Integer; var AChunkCnt: Integer); var BlockIndex: TKMemoBlockIndex; WordIndex, St, En: TKMemoWordIndex; Block: TKMemoBlock; begin for BlockIndex := FLines[ALineIndex].StartBlock to FLines[ALineIndex].EndBlock do begin Block := Items[BlockIndex]; if Block.Position = mbpText then begin GetWordIndexes(BlockIndex, ALineIndex, St, En); for WordIndex := St to En do begin if (Block.WordLeft[WordIndex] >= AStartPos) and (Block.WordLeft[WordIndex] + Block.WordWidth[WordIndex] <= AEndPos) then Block.WordLeft[WordIndex] := Block.WordLeft[WordIndex] + ADelta; end; end; end; if (AChunkCnt = 0) and (NumberBlock <> nil) then begin for WordIndex := 0 to NumberBlock.WordCount - 1 do begin NumberBlock.WordLeft[WordIndex] := NumberBlock.WordLeft[WordIndex] + ADelta; end; end; Inc(AChunkCnt); end; var Line, LastLine: TKMemoLine; EndBlock, Block: TKMemoBlock; BlockIndex, CurBlockIndexCopy: TKMemoBlockIndex; CurWordIndexCopy, WordIndex, St, En: TKMemoWordIndex; LineIndex: TKMemoLineIndex; CurIndexCopy: TKMemoSelectionIndex; I, W, Delta, FirstIndent, ChunkCnt, LineLeft, LineRight, BaseLine, StPosX, ParaMarkWidth, BottomPadding, TopPadding: Integer; WasParagraph: Boolean; R, RW: TRect; begin Result := False; if FState.LastTotalWord <> FState.CurTotalWord then begin FBackState.Assign(FState); FState.LastTotalWord := FState.CurTotalWord; // create new line if FLines.Count > 0 then LastLine := FLines[TKMemoLineIndex(FLines.Count - 1)] else LastLine := nil; CurIndexCopy := FState.CurIndex; CurWordIndexCopy := FState.CurWordIndex; CurBlockIndexCopy := FState.CurBlockIndex; if (CurWordIndexCopy <= 0) or (CurBlockIndexCopy >= Count) or (Items[CurBlockIndexCopy].Position <> mbpText) then begin I := 0; while (CurBlockIndexCopy > FState.LastBlockIndex) and ((CurBlockIndexCopy >= Count) or (I = 0) or (Items[CurBlockIndexCopy].Position <> mbpText)) do begin Dec(CurBlockIndexCopy); Inc(I); end; CurWordIndexCopy := Items[CurBlockIndexCopy].WordCount - 1; end else begin Dec(CurWordIndexCopy); end; Dec(CurIndexCopy); Line := TKMemoLine.Create; LineIndex := FLines.Add(Line); Line.StartBlock := FState.LastBlockIndex; Line.EndBlock := CurBlockIndexCopy; Line.StartIndex := FState.LastIndex; Line.EndIndex := CurIndexCopy; Line.StartWord := FState.LastWordIndex; Line.EndWord := CurWordIndexCopy; EndBlock := Items[Line.EndBlock]; // get vertical paddings for this line and width of the paragraph mark (this cannot be included into line width) WasParagraph := (LastLine = nil) or (Items[LastLine.EndBlock] is TKMemoParagraph); if WasParagraph then begin FirstIndent := FState.CurParaStyle.FirstIndent; TopPadding := FState.CurParaStyle.TopPadding; if FState.CurParagraph <> nil then NumberBlock := FState.CurParagraph.NumberBlock else NumberBlock := nil; end else begin FirstIndent := 0; TopPadding := 0; NumberBlock := nil; end; if EndBlock is TKMemoParagraph then begin BottomPadding := FState.CurParaStyle.BottomPadding; ParaMarkWidth := EndBlock.WordWidth[EndBlock.WordCount - 1]; end else begin BottomPadding := 0; ParaMarkWidth := 0; end; // get dominant base line BaseLine := 0; for BlockIndex := Line.StartBlock to Line.EndBlock do begin Block := Items[BlockIndex]; if Block.Position = mbpText then BaseLine := Max(BaseLine, Block.CalcAscent(ACanvas)); end; if NumberBlock <> nil then BaseLine := Max(BaseLine, NumberBlock.CalcAscent(ACanvas)); // adjust line and paragraph heights case FState.CurParaStyle.LineSpacingMode of lsmFactor: begin FState.LineHeight := Round(FState.CurParaStyle.LineSpacingFactor * FState.LineHeight); end; lsmValue: begin if FState.CurParaStyle.LineSpacingValue > 0 then FState.LineHeight := Max(FState.LineHeight, FState.CurParaStyle.LineSpacingValue) else if FState.CurParaStyle.LineSpacingValue < 0 then FState.LineHeight := -FState.CurParaStyle.LineSpacingValue; end; end; Inc(FState.LineHeight, TopPadding + BottomPadding); // adjust all words horizontally if FState.CurParaStyle.HAlign in [halCenter, halRight] then begin // reposition all line chunks like MS WordIndex does it FState.PosX := FState.CurParaStyle.LeftPadding + FirstIndent; StPosX := FState.PosX; W := 0; ChunkCnt := 0; for BlockIndex := Line.StartBlock to Line.EndBlock do begin Block := Items[BlockIndex]; if Block.Position = mbpText then begin GetWordIndexes(BlockIndex, LineIndex, St, En); for WordIndex := St to En do begin if Block.WordLeft[WordIndex] > FState.PosX then begin // space here, get colliding rect RW := Rect(FState.PosX, FState.PosY, FState.PosX + Block.WordWidth[WordIndex], FState.PosY + FState.LineHeight); if RectCollidesWithNonText(RW, R) then begin Delta := R.Left - StPosX - W; case FState.CurParaStyle.HAlign of halCenter: Delta := Delta div 2; end; MoveWordsOnLine(LineIndex, StPosX, R.Left, Delta, ChunkCnt); end; FState.PosX := Block.WordLeft[WordIndex]; StPosX := FState.PosX; W := 0; end; Inc(FState.PosX, Block.WordWidth[WordIndex]); Inc(W, Block.WordWidth[WordIndex]); end; end; end; RW := Rect(StPosX, FState.PosY, FState.RightX + ParaMarkWidth, FState.PosY + FState.LineHeight); if RectCollidesWithNonText(RW, R) then Delta := R.Left - StPosX - W else Delta := FState.RightX + ParaMarkWidth - StPosX - W; case FState.CurParaStyle.HAlign of halCenter: Delta := Delta div 2; end; MoveWordsOnLine(LineIndex, StPosX, FState.RightX + ParaMarkWidth, Delta, ChunkCnt); end; // adjust all words vertically, compute line extent LineRight := FState.CurParaStyle.LeftPadding; LineLeft := FState.RightX; for BlockIndex := Line.StartBlock to Line.EndBlock do begin Block := Items[BlockIndex]; if Block.Position = mbpText then begin GetWordIndexes(BlockIndex, LineIndex, St, En); for WordIndex := St to En do begin Block.WordBaseLine[WordIndex] := BaseLine; Block.WordBottomPadding[WordIndex] := BottomPadding; Block.WordHeight[WordIndex] := FState.LineHeight; Block.WordTopPadding[WordIndex] := TopPadding; R := Block.WordBoundsRect[WordIndex]; LineLeft := Min(LineLeft, R.Left); LineRight := Max(LineRight, R.Right); end; end; end; if NumberBlock <> nil then begin for WordIndex := 0 to NumberBlock.WordCount - 1 do begin NumberBlock.WordBaseLine[WordIndex] := BaseLine; NumberBlock.WordBottomPadding[WordIndex] := BottomPadding; NumberBlock.WordHeight[WordIndex] := FState.LineHeight; NumberBlock.WordTopPadding[WordIndex] := TopPadding; R := NumberBlock.WordBoundsRect[WordIndex]; LineLeft := Min(LineLeft, R.Left); LineRight := Max(LineRight, R.Right); end; end; // adjust paragraph extent if LineRight > ARequiredWidth then Dec(LineRight, ParaMarkWidth); FState.ParaWidth := Max(FState.ParaWidth, LineRight - LineLeft); if EndBlock is TKMemoParagraph then begin TKMemoParagraph(EndBlock).Top := FState.ParaPosY; TKmemoParagraph(EndBlock).Width := FState.ParaWidth; TKmemoParagraph(EndBlock).Height := FState.PosY + FState.LineHeight - FState.ParaPosY - FState.CurParaStyle.BottomPadding; FState.CurParagraph := GetNearestParagraphBlock(FState.CurBlockIndex); FState.CurParaStyle := GetParaStyle(FState.CurParagraph); FState.ParaWidth := 0; FState.ParaPosY := FState.PosY + FState.LineHeight + FState.CurParaStyle.TopPadding; end; // adjust line extent Line.Extent := Point(LineRight - LineLeft, FState.LineHeight); Line.Position := Point(LineLeft, FState.PosY); // other tasks FExtent.X := Max(FExtent.X, LineRight); FState.PosX := FState.CurParaStyle.LeftPadding; if EndBlock is TKMemoParagraph then begin Inc(FState.PosX, FState.CurParaStyle.FirstIndent); end; FState.RightX := ARequiredWidth - FState.CurParaStyle.RightPadding; Inc(FState.PosY, FState.LineHeight); FExtent.Y := Max(FExtent.Y, FState.PosY); FState.LastBlockIndex := FState.CurBlockIndex; FState.LastWordIndex := FState.CurWordIndex; FState.LastIndex := FState.CurIndex; FState.LineHeight := 0; Result := True; end; end; procedure DeleteLine; begin if FLines.Count > 0 then begin FLines.Delete(FLines.Count - 1); FState.Assign(FBackState); end; end; procedure MoveWordToFreeSpace(AWordWidth, AWordHeight: Integer); var TmpHeight: Integer; R: TRect; begin if AWordWidth <> 0 then begin TmpHeight := Max(FState.LineHeight, AWordHeight); while RectCollidesWithNonText(Rect(FState.PosX, FState.PosY, FState.PosX + AWordWidth, FState.PosY + TmpHeight), R) do begin FState.PosX := R.Right; if FState.PosX + AWordWidth > FState.RightX then begin if not AddLine then Inc(FState.PosY, 5); FState.PosX := FState.CurParaStyle.LeftPadding; end; end; end; end; function MeasureNextWords(ACanvas: TCanvas; ACurBlock: TKMemoBlockIndex; ACurWord: TKMemoWordIndex; ARequiredWidth: Integer; IsBreakable: Boolean; var ANBExtent: TPoint): TPoint; var Block: TKMemoBlock; Extent: TPoint; WLen, MaxWLen: Integer; begin Block := Items[ACurBlock]; Result := Block.WordMeasureExtent(ACanvas, ACurWord, ARequiredWidth); ANBExtent := Result; if not IsBreakable then begin Inc(ACurWord); if ACurWord >= Block.WordCount then begin ACurWord := 0; Inc(ACurBlock); end; WLen := 0; MaxWLen := getMaxWordLength; while not IsBreakable and (ACurBlock < Count) and (WLen < MaxWLen) do begin Block := Items[ACurBlock]; if (Block is TKMemoParagraph) or not (Block is TKMemoTextBlock) then IsBreakable := True else begin while not IsBreakable and (ACurWord < Block.WordCount) do begin IsBreakable := Block.WordBreakable[ACurWord]; Extent := Block.WordMeasureExtent(ACanvas, ACurWord, ARequiredWidth); Inc(ANBExtent.X, Extent.X); ANBExtent.Y := Max(ANBExtent.Y, Extent.Y); Inc(WLen, Block.WordLength[ACurWord]); Inc(ACurWord); end; ACurWord := 0; Inc(ACurBlock); end; end; end; end; var Extent, NBExtent: TPoint; I, FirstIndent, WLen, PrevPosX, PrevPosY: Integer; WordIndex: TKMemoWordIndex; OutSide, WasBreakable, WasParagraph: Boolean; Block: TKMemoBlock; NextParagraph: TKMemoParagraph; NextParaStyle: TKMemoParaStyle; S: TKString; begin // this is the main WordIndex processing calculation FExtent := CreateEmptyPoint; if not (FState.Initialized and (FUpdateReasons = [muContentAddOnly]) and (ARequiredWidth = FState.RequiredWidth)) then begin // measure everything, needed after most modifications FLines.Clear; FBackState.Clear; FState.Clear; FState.RequiredWidth := ARequiredWidth; FState.CurParagraph := GetNearestParagraphBlock(0); FState.CurParaStyle := GetParaStyle(FState.CurParagraph); FState.PosX := FState.CurParaStyle.LeftPadding + FState.CurParaStyle.FirstIndent; FState.ParaPosY := FState.CurParaStyle.TopPadding; FState.RightX := ARequiredWidth - FState.CurParaStyle.RightPadding; FState.IsBreakable := True; FState.IsParagraph := False; end else begin // here we don't start from beginning and measure just // the newly added blocks; // it can be used only for blocks added at the end and // placed in text if not FState.IsParagraph then DeleteLine; // continue on previous line when no paragraph was added end; // first measure all absolutely positioned items for I := 0 to FRelPos.Count - 1 do begin Block := Items[FRelPos.Items[I].Index]; Block.MeasureExtent(ACanvas, ARequiredWidth); end; // then measure all other items while FState.CurBlockIndex < Count do begin FState.CurWordIndex := 0; if FState.IsParagraph or (FState.CurBlockIndex = 0) then begin NextParagraph := GetNearestParagraphBlock(FState.CurBlockIndex); NextParaStyle := GetParaStyle(NextParagraph); if NextParagraph <> nil then Block := NextParagraph.NumberBlock else Block := nil; if Block <> nil then begin // we must include the nonselectable bullet/number block into normal text flow AddLine; FState.IsParagraph := False; NBExtent.X := 0; for WordIndex := 0 to Block.WordCount - 1 do begin Extent := Block.WordMeasureExtent(ACanvas, WordIndex, 0); // align the text following the bullet/number within paragraph, if possible S := Block.Words[WordIndex]; if (S = cTab) and (NBExtent.X < -NextParaStyle.FirstIndent) then begin Extent.X := -NextParaStyle.FirstIndent - NBExtent.X; Block.WordWidth[WordIndex] := Extent.X; Block.WordClipped[WordIndex] := True; end; if FRelPos.Count > 0 then MoveWordToFreeSpace(Extent.X, Extent.Y); Block.WordLeft[WordIndex] := FState.PosX; Block.WordTop[WordIndex] := FState.PosY; Inc(FState.PosX, Extent.X); FState.LineHeight := Max(FState.LineHeight, Extent.Y); Inc(NBExtent.X, Extent.X); end; end end else NextParaStyle := FState.CurParaStyle; Block := Items[FState.CurBlockIndex]; case Block.Position of mbpText: begin while FState.CurWordIndex < Block.WordCount do begin WasParagraph := FState.IsParagraph; FState.IsParagraph := (Block is TKMemoParagraph) and (FState.CurWordIndex = Block.WordCount - 1); WLen := Block.WordLength[FState.CurWordIndex]; WasBreakable := FState.IsBreakable or not (Block is TKMemoTextBlock); FState.IsBreakable := Block.WordBreakable[FState.CurWordIndex]; if WasParagraph then FirstIndent := NextParaStyle.FirstIndent else FirstIndent := 0; Extent := MeasureNextWords(ACanvas, FState.CurBlockIndex, FState.CurWordIndex, ARequiredWidth - NextParaStyle.LeftPadding - NextParaStyle.RightPadding - FirstIndent, FState.IsBreakable, NBExtent); OutSide := FState.CurParaStyle.WordWrap and not FState.IsParagraph and WasBreakable and (FState.PosX + NBExtent.X > FState.RightX); if OutSide or WasParagraph then AddLine; if FRelPos.Count > 0 then MoveWordToFreeSpace(NBExtent.X, NBExtent.Y); Block.WordLeft[FState.CurWordIndex] := FState.PosX; Block.WordTop[FState.CurWordIndex] := FState.PosY; Inc(FState.PosX, Extent.X); FState.LineHeight := Max(FState.LineHeight, Extent.Y); Inc(FState.CurWordIndex); Inc(FState.CurIndex, WLen); Inc(FState.CurTotalWord); end; end; mbpRelative: begin // position relative block correctly PrevPosX := FState.PosX; PrevPosY := FState.PosY; try // starting position for relative object is currently always: X by column (currently always 0), Y by paragraph // the object position offsets (LeftOffset, TopOffset) are always counted from this default position FState.PosX := 0; FState.PosY := FState.ParaPosY; //MoveWordToFreeSpace(Block.Width, Block.Height); Block.WordLeft[0] := FState.PosX; Block.WordTop[0] := FState.PosY; FExtent.X := Max(FExtent.X, FState.PosX + Block.Width + Block.LeftOffset); FExtent.Y := Max(FExtent.Y, FState.PosY + Block.Height + Block.TopOffset); finally FState.PosX := PrevPosX; FState.PosY := PrevPosY; end; // always place object anchor to the beginning of new paragraph if FState.IsParagraph then begin AddLine; FState.IsParagraph := False; end; end; mbpAbsolute: begin FExtent.X := Max(FExtent.X, Block.Width + Block.LeftOffset); FExtent.Y := Max(FExtent.Y, Block.Height + Block.TopOffset); end; end; Inc(FState.CurBlockIndex); end; if FState.CurIndex > FState.LastIndex then begin FState.CurWordIndex := 0; AddLine; end; end; function TKMemoBlocks.MouseAction(AAction: TKMemoMouseAction; ACanvas: TCanvas; const APoint: TPoint; AShift: TShiftState): Boolean; var LineIndex: TKMemoLineIndex; BlockIndex: TKmemoBlockIndex; WordIndex, St, En: TKMemoWordIndex; I: Integer; Block: TKmemoBlock; begin Result := False; for LineIndex := 0 to LineCount - 1 do begin if (LineTop[LineIndex] <= APoint.Y) and (APoint.Y < LineBottom[LineIndex]) or (AAction in [maLeftUp, maRightUp, maMidUp]) then begin for BlockIndex := FLines[LineIndex].StartBlock to FLines[LineIndex].EndBlock do begin Block := Items[BlockIndex]; if Block.Position = mbpText then begin GetWordIndexes(BlockIndex, LineIndex, St, En); for WordIndex := St to En do begin Result := Block.WordMouseAction(ACanvas, WordIndex, AAction, APoint, AShift); if Result then Exit; end; end; end; end; end; for I := FRelPos.Count - 1 downto 0 do // reversed Z-order here begin Block := Items[FRelPos[I].Index]; Result := Block.WordMouseAction(ACanvas, 0, AAction, APoint, AShift); if Result then Exit; end; end; function TKMemoBlocks.NextIndexByCharCount(AIndex: TKMemoSelectionIndex; ACharCount: Integer): TKMemoSelectionIndex; begin Result := AIndex + ACharCount; end; function TKMemoBlocks.NextIndexByHorzExtent(ACanvas: TCanvas; AIndex: TKMemoSelectionIndex; AWidth: Integer; out ALinePos: TKMemoLinePosition): TKMemoSelectionIndex; var R: TRect; P: TPoint; begin R := IndexToRect(ACanvas, AIndex, True, EOLToNormal(AIndex)); Result := PointToIndex(ACanvas, Point(R.Left + AWidth, R.Top), True, False, ALinePos); if AIndex = Result then begin R := IndexToRect(ACanvas, AIndex, False, EOLToNormal(AIndex)); if AWidth > 0 then P := Point(R.Right, R.Top) else P := Point(R.Left - 1, R.Top); Result := PointToIndex(ACanvas, P, True, False, ALinePos); end; end; function TKMemoBlocks.NextIndexByRowDelta(ACanvas: TCanvas; AIndex: TKMemoSelectionIndex; ARowDelta, ALeftPos: Integer; out ALinePos: TKMemoLinePosition): TKMemoSelectionIndex; var R: TRect; Y: Integer; begin R := IndexToRect(ACanvas, AIndex, False, EOLToNormal(AIndex)); if ARowDelta >= 0 then Y := R.Bottom else Y := R.Top - 1; Result := PointToIndex(ACanvas, Point(ALeftPos, Y), True, False, ALinePos); end; function TKMemoBlocks.NextIndexByVertExtent(ACanvas: TCanvas; AIndex: TKMemoSelectionIndex; AHeight, ALeftPos: Integer; out ALinePos: TKMemoLinePosition): TKMemoSelectionIndex; var R: TRect; P: TPoint; begin R := IndexToRect(ACanvas, AIndex, True, EOLToNormal(AIndex)); Result := PointToIndex(ACanvas, Point(ALeftPos, R.Top + AHeight), True, False, ALinePos); if AIndex = Result then begin R := IndexToRect(ACanvas, AIndex, False, EOLToNormal(AIndex)); if AHeight > 0 then P := Point(ALeftPos, R.Bottom) else P := Point(ALeftPos, R.Top - 1); Result := PointToIndex(ACanvas, P, True, False, ALinePos); end; end; function TKMemoBlocks.NextIndexByVertValue(ACanvas: TCanvas; AValue, ALeftPos: Integer; ADirection: Boolean; out ALinePos: TKMemoLinePosition): TKMemoSelectionIndex; var Y: Integer; R: TRect; begin R := CreateEmptyRect; Y := AValue; repeat if ADirection then Dec(Y, R.Bottom - R.Top) else Inc(Y, R.Bottom - R.Top); Result := PointToIndex(ACanvas, Point(ALeftPos, Y), True, False, ALinePos); R := IndexToRect(ACanvas, Result, True, False); until (ADirection and (R.Bottom <= AValue)) or (not ADirection and (R.Top >= AValue)); end; function TKMemoBlocks.NormalToEOL(var AIndex: TKMemoSelectionIndex): Boolean; begin Result := False; if GetLinePosition = eolEnd then begin Inc(AIndex); Result := True; end; end; procedure TKMemoBlocks.Notify(Ptr: Pointer; Action: TListNotification); var BlockIndex: TKMemoBlockIndex; begin inherited; case Action of lnAdded: begin // allow much faster incremental measurement of blocks // it can be used only for top level blocks added at the end // with position in text if (TKMemoBlock(Ptr).Position = mbpText) and (TKMemoBlock(Ptr).ParentRootBlocks = TKMemoBlock(Ptr).ParentBlocks) then begin BlockIndex := IndexOf(Ptr); if BlockIndex = Count - 1 then Update([muContentAddOnly]) else Update([muContent]); end else Update([muContent]); end else Update([muContent]); end; end; procedure TKMemoBlocks.NotifyDefaultParaChange; var BlockIndex: TKMemoBlockIndex; begin for BlockIndex := 0 to Count - 1 do Items[BlockIndex].NotifyDefaultParaChange; end; procedure TKMemoBlocks.NotifyDefaultTextChange; var BlockIndex: TKMemoBlockIndex; begin for BlockIndex := 0 to Count - 1 do Items[BlockIndex].NotifyDefaultTextChange; end; procedure TKMemoBlocks.NotifyOptionsChange; var BlockIndex: TKMemoBlockIndex; begin for BlockIndex := 0 to Count - 1 do Items[BlockIndex].NotifyOptionsChange; end; procedure TKMemoBlocks.NotifyPrintBegin; var BlockIndex: TKMemoBlockIndex; begin for BlockIndex := 0 to Count - 1 do Items[BlockIndex].NotifyPrintBegin; end; procedure TKMemoBlocks.NotifyPrintEnd; var BlockIndex: TKMemoBlockIndex; begin for BlockIndex := 0 to Count - 1 do Items[BlockIndex].NotifyPrintEnd; end; procedure TKMemoBlocks.PaintLineBackground(ACanvas: TCanvas; ALineIndex: TKMemoLineIndex; ALeft, ATop: Integer); var R, RClip: TRect; PA: TKMemoParagraph; PrevRgn: HRGN; //Tmp: TRect; begin PA := GetNearestParagraphBlock(FLines[ALineIndex].StartBlock); if (PA <> nil) and ((PA.ParaStyle.Brush.Style <> bsClear) or (PA.ParaStyle.BorderWidth > 0) or PA.ParaStyle.BorderWidths.NonZero) then begin R := Rect(0, 0, Max(FState.RequiredWidth, PA.Width), PA.Height); KFunctions.OffsetRect(R, PA.Left, PA.Top); RClip := R; RClip.Top := Max(RClip.Top, LineTop[ALineIndex]); RClip.Bottom := Min(RClip.Bottom, LineBottom[ALineIndex]); KFunctions.OffsetRect(R, ALeft, ATop); KFunctions.OffsetRect(RClip, ALeft, ATop); //GetCLipBox(ACanvas.Handle, Tmp); // debug line //TranslateRectToDevice(ACanvas.Handle, Tmp); // debug line TranslateRectToDevice(ACanvas.Handle, RClip); PrevRgn := RgnCreateAndGet(ACanvas.Handle); try if ExtSelectClipRect(ACanvas.Handle, RClip, RGN_AND, PrevRgn) then PA.ParaStyle.PaintBox(ACanvas, R); finally RgnSelectAndDelete(ACanvas.Handle, PrevRgn); end; ACanvas.Refresh; end; end; procedure TKMemoBlocks.PaintLineInfo(ACanvas: TCanvas; ALineIndex: TKMemoLineIndex; ALeft, ATop: Integer); var R: TRect; begin R := LineRect[ALineIndex]; KFunctions.OffsetRect(R, ALeft, ATop); ACanvas.Brush.Style := bsClear; ACanvas.Font.Size := 8; ACanvas.Font.Color := clWindowText; ACanvas.Font.Style := []; ACanvas.Rectangle(R); ACanvas.TextOut(R.Right, R.Top, IntToStr(Flines[ALineIndex].StartBlock)); ACanvas.TextOut(R.Right + 20, R.Top, IntToStr(Flines[ALineIndex].EndBlock)); ACanvas.TextOut(R.Right + 40, R.Top, IntToStr(Flines[ALineIndex].StartWord)); ACanvas.TextOut(R.Right + 60, R.Top, IntToStr(Flines[ALineIndex].EndWord)); end; procedure TKMemoBlocks.PaintToCanvas(ACanvas: TCanvas; ALeft, ATop: Integer; const ARect: TRect); var BlockIndex: TKMemoBlockIndex; LineIndex: TKMemoLineIndex; WordIndex, St, En: TKMemoWordIndex; I: Integer; R: TRect; Block: TKMemoBlock; begin // paint text blocks for LineIndex := 0 to LineCount - 1 do begin if (LineBottom[LineIndex] + ATop >= ARect.Top) and (LineTop[LineIndex] + ATop < ARect.Bottom) then begin // fill areas under paragraphs if LineFloat[LineIndex] then begin PaintLineBackground(ACanvas, LineIndex, ALeft, ATop); end; // then paint text blocks for BlockIndex := FLines[LineIndex].StartBlock to FLines[LineIndex].EndBlock do begin Block := Items[BlockIndex]; if Block.Position = mbpText then begin GetWordIndexes(BlockIndex, LineIndex, St, En); for WordIndex := St to En do Block.WordPaintToCanvas(ACanvas, WordIndex, ALeft, ATop); end; end; // paint LineIndex info, only for debug purposes //PaintLineInfo(ACanvas, LineIndex, ALeft, ATop); end; end; // paint numbering blocks for BlockIndex := 0 to Count - 1 do begin Block := Items[BlockIndex]; if Block is TKMemoParagraph then begin Block := TKMemoParagraph(Block).NumberBlock; if Block <> nil then begin R := Block.BoundsRect; KFunctions.OffsetRect(R, ALeft, ATop); if RectInRect(ARect, R) then Block.PaintToCanvas(ACanvas, ALeft, ATop); end; end; end; // paint relative or absolute blocks for I := 0 to FRelPos.Count - 1 do begin Block := Items[FRelPos[I].Index]; R := Block.BoundsRect; KFunctions.OffsetRect(R, Block.LeftOffset + ALeft, Block.TopOffset + ATop); if RectInRect(ARect, R) then Block.PaintToCanvas(ACanvas, ALeft, ATop); end; end; function TKMemoBlocks.PointToIndex(ACanvas: TCanvas; const APoint: TPoint; AOutOfArea, ASelectionExpanding: Boolean; out ALinePos: TKMemoLinePosition): TKMemoSelectionIndex; var LineIndex: TKMemoLineIndex; BeforeFirst, AfterLast, InBetween: Boolean; begin Result := -1; if LineCount > 0 then begin LineIndex := 0; while (Result < 0) and (LineIndex < LineCount) do begin BeforeFirst := (LineIndex = 0) and (APoint.Y < LineTop[LineIndex]); // point below first LineIndex AfterLast := (LineIndex = LineCount - 1) and (APoint.Y >= LineBottom[LineIndex]); // point after last LineIndex InBetween := (LineIndex > 0) and (APoint.Y < LineTop[LineIndex]) and (Apoint.Y >= LineBottom[LineIndex - 1]); // point between two lines if (APoint.Y >= LineTop[LineIndex]) and (APoint.Y < LineBottom[LineIndex]) or AOutOfArea and (BeforeFirst or AfterLast or InBetween) then begin Result := PointToIndexOnLine(ACanvas, LineIndex, APoint, AOutOfArea, ASelectionExpanding, ALinePos) end; Inc(LineIndex); end; end; end; function TKMemoBlocks.PointToIndexOnLine(ACanvas: TCanvas; ALineIndex: TKMemoLineIndex; const APoint: TPoint; AOutOfArea, ASelectionExpanding: Boolean; out ALinePos: TKMemoLinePosition): TKMemoSelectionIndex; var BlockIndex: TKMemoBlockIndex; WordIndex, St, En: TKMemoWordIndex; Index, LocalIndex: TKMemoSelectionIndex; X, XOld: Integer; Block: TKMemoBlock; begin Result := -1; ALinePos := eolInside; if (ALineIndex >= 0) and (ALineIndex < LineCount) then begin Index := FLines[ALineIndex].StartIndex; BlockIndex := FLines[ALineIndex].StartBlock; X := LineLeft[ALineIndex]; while (Result < 0) and (BlockIndex <= FLines[ALineIndex].EndBlock) do begin Block := Items[BlockIndex]; if Block.Position = mbpText then begin GetWordIndexes(BlockIndex, ALineIndex, St, En); WordIndex := St; while (Result < 0) and (WordIndex <= En) do begin XOld := X; X := Block.WordLeft[WordIndex]; LocalIndex := Block.WordPointToIndex(ACanvas, APoint, WordIndex, AOutOfArea, ASelectionExpanding, ALinePos); if LocalIndex >= 0 then begin Result := Index + LocalIndex; end else if (XOld <= APoint.X) and (APoint.X < X) then begin // the point lies between words Result := Index; end; Inc(Index, Block.WordLength[WordIndex]); Inc(WordIndex); end; end; Inc(BlockIndex); end; if (Result < 0) and AOutOfArea then begin if (APoint.X >= LineRight[ALineIndex]) then begin Result := LineEndIndex[ALineIndex]; Block := Items[FLines[ALineIndex].EndBlock]; if ASelectionExpanding or not ((Block is TKMemoContainer) or (Block is TKMemoParagraph)) then begin ALinePos := eolEnd; Inc(Result); end; end else if (APoint.X < LineLeft[ALineIndex]) then begin Result := LineStartIndex[ALineIndex]; end else begin // this should not happen but we must handle this case Result := (LineStartIndex[ALineIndex] + LineEndIndex[ALineIndex]) div 2; end; end; end; end; function TKMemoBlocks.PointToBlocks(const APoint: TPoint): TKMemoBlocks; var BlockIndex: TKMemoBlockIndex; I: Integer; Block: TKMemoBlock; R: TRect; P: TPoint; begin Result := nil; for I := 0 to FRelPos.Count - 1 do begin Block := Items[FRelPos[I].Index]; if Block is TKMemoContainer then begin R := Block.BoundsRect; KFunctions.OffsetRect(R, Block.LeftOffset, Block.TopOffset); if PtInRect(R, APoint) then begin Result := TKMemoContainer(Block).Blocks; Break; end; end; end; if Result = nil then begin for BlockIndex := 0 to Count - 1 do begin Block := Items[BlockIndex]; if Block is TKMemoContainer then begin P := APoint; OffsetPoint(P, -TKMemoContainer(Block).Left - TKMemoContainer(Block).BlockStyle.AllPaddingsLeft, -TKMemoContainer(Block).Top - TKMemoContainer(Block).BlockStyle.AllPaddingsTop); Result := TKMemoContainer(Block).Blocks.PointToBlocks(P); if Result <> nil then break; end; end; end; end; function TKMemoBlocks.PointToRelativeBlock(const APoint: TPoint): TKMemoBlock; var Block: TKMemoBlock; I: Integer; R: TRect; begin Result := nil; for I := 0 to FRelPos.Count - 1 do begin Block := Items[FRelPos[I].Index]; R := Block.BoundsRect; KFunctions.OffsetRect(R, Block.LeftOffset, Block.TopOffset); if PtInRect(R, APoint) then begin Result := Block; Exit; end; end; end; procedure TKMemoBlocks.RestoreUpdateState(AValue: TKMemoUpdateReasons); begin FUpdateReasons := AValue; end; procedure TKMemoBlocks.SaveToRTFStream(AStream: TStream; ASelectedOnly: Boolean); var Writer: TKMemoRTFWriter; begin Writer := TKMemoRTFWriter.Create(ParentMemo); try Writer.SaveToStream(AStream, ASelectedOnly, Self); finally Writer.Free; end; end; function TKMemoBlocks.SaveUpdateState: TKMemoUpdateReasons; begin Result := FUpdateReasons; end; function TKMemoBlocks.Select(ASelStart, ASelLength: TKMemoSelectionIndex; ADoScroll: Boolean; ATextOnly: Boolean): Boolean; var BlockIndex: TKMemoBlockIndex; LastIndex, CurIndex, NewSelEnd, MaxIndex, LocalSelLength: TKMemoSelectionIndex; Block: TKMemoBlock; begin NewSelEnd := ASelStart + ASelLength; if FLines.Count > 0 then Block := Items[FLines[TKMemoLineIndex(FLines.Count - 1)].EndBlock] else Block := nil; if (ASelLength <> 0) or not (Block is TKMemoParagraph) then MaxIndex := FSelectableLength else MaxIndex := FSelectableLength - 1; NewSelEnd := MinMax(NewSelEnd, -1, MaxIndex); ASelStart := MinMax(ASelStart, -1, MaxIndex); if (ASelStart <> FSelStart) or (NewSelEnd <> FSelEnd) then begin FSelStart := ASelStart; FSelEnd := NewSelEnd; CurIndex := 0; LockUpdate; try // children have always FSelEnd >= FSelStart if NewSelEnd < ASelStart then KFunctions.Exchange(Integer(ASelStart), Integer(NewSelEnd)); for BlockIndex := 0 to Count - 1 do begin Block := Items[BlockIndex]; if Block.Position = mbpText then begin LastIndex := CurIndex; Inc(CurIndex, Block.SelectableLength); if (ASelStart >= LastIndex) and (NewSelEnd < CurIndex) then begin // selection within the same block Block.Select(ASelStart - LastIndex, NewSelEnd - ASelStart, ADoScroll); end else if (ASelStart >= LastIndex) and (ASelStart < CurIndex) and (NewSelEnd >= CurIndex) then // selection starts in this block Block.Select(ASelStart - LastIndex, CurIndex - ASelStart, ADoScroll) else if (ASelStart < LastIndex) and (NewSelEnd >= LastIndex) and (NewSelEnd < CurIndex) then // selection ends in this block Block.Select(0, NewSelEnd - LastIndex, ADoScroll) else if (ASelStart <= LastIndex) and (NewSelEnd >= CurIndex) then begin // selection goes through this block if not ATextOnly and ((ASelLength <> 0) and (Block.Position <> mbpText)) then LocalSelLength := Block.SelectableLength(True) else LocalSelLength := CurIndex - LastIndex; Block.Select(0, LocalSelLength, ADoScroll) end else Block.Select(-1, 0, ADoScroll); end; end; if ADoScroll then begin Exclude(FUpdateReasons, muSelection); Include(FUpdateReasons, muSelectionScroll) end else begin Include(FUpdateReasons, muSelection); Exclude(FUpdateReasons, muSelectionScroll); end; finally UnlockUpdate; end; Result := True end else Result := False; end; procedure TKMemoBlocks.SetExtent(AWidth, AHeight: Integer); begin FExtent := Point(AWidth, AHeight); end; procedure TKMemoBlocks.SetRangeParaStyle(AFrom, ATo: TKMemoSelectionIndex; AStyle: TKMemoParaStyle); var BlockIndex: TKMemoBlockIndex; CurIndex, LastIndex: TKMemoSelectionIndex; Block: TKMemoBlock; WasRange: Boolean; begin if AFrom > ATo then Exchange(AFrom, ATo); LockUpdate; try WasRange := False; CurIndex := 0; for BlockIndex := 0 to Count - 1 do begin Block := Items[BlockIndex]; LastIndex := CurIndex; Inc(CurIndex, Block.SelectableLength); if (LastIndex <= ATo) and (AFrom < CurIndex) then begin WasRange := True; if Block is TKMemoParagraph then // selection through this block TKMemoParagraph(Block).ParaStyle.Assign(AStyle) else if Block is TKMemoContainer then TKMemoContainer(Block).Blocks.SetRangeParaStyle(AFrom - LastIndex, ATo - LastIndex, AStyle) end else if WasRange and (Block is TKMemoParagraph) then begin // this is the nearest paragraph TKMemoParagraph(Block).ParaStyle.Assign(AStyle); WasRange := False; end; end; finally UnlockUpdate; end; end; procedure TKMemoBlocks.SetRangeTextStyle(AFrom, ATo: TKMemoSelectionIndex; AStyle: TKMemoTextStyle); var BlockIndex: TKMemoBlockIndex; CurIndex, LastIndex: TKMemoSelectionIndex; Block, Block1, Block2: TKMemoBlock; begin if AFrom > ATo then Exchange(AFrom, ATo); LockUpdate; try BlockIndex := 0; CurIndex := 0; while BlockIndex < Count do begin Block := Items[BlockIndex]; LastIndex := CurIndex; Inc(CurIndex, Block.SelectableLength); if Block is TKMemoContainer then begin if (LastIndex <= ATo) and (AFrom < CurIndex) then TKMemoContainer(Block).Blocks.SetRangeTextStyle(AFrom - LastIndex, ATo - LastIndex, AStyle) end else if Block is TKMemoTextBlock then begin if (AFrom <= LastIndex) and (ATo >= CurIndex) then begin // selection goes through this block TKMemoTextBlock(Block).TextStyle.Assign(AStyle); end else if (AFrom > LastIndex) and (ATo < CurIndex) then begin // selection within the same block, split it to three parts Block1 := Block.Split(AFrom - LastIndex); if Block1 <> nil then begin Inc(BlockIndex); AddAt(Block1, BlockIndex); Block2 := Block1.Split(ATo - AFrom); if Block2 <> nil then begin Inc(BlockIndex); AddAt(Block2, BlockIndex); end; TKMemoTextBlock(Block1).TextStyle.Assign(AStyle); end; end else if (AFrom > LastIndex) and (AFrom < CurIndex) and (ATo >= CurIndex) then begin // selection starts in this block, split it to two parts Block1 := Block.Split(AFrom - LastIndex); if Block1 <> nil then begin Inc(BlockIndex); AddAt(Block1, BlockIndex); TKMemoTextBlock(Block1).TextStyle.Assign(AStyle); end; end else if (AFrom <= LastIndex) and (ATo > LastIndex) and (ATo < CurIndex) then begin // selection ends in this block, split it to two parts Block1 := Block.Split(ATo - LastIndex); if Block1 <> nil then begin Inc(BlockIndex); AddAt(Block1, BlockIndex); TKMemoTextBlock(Block).TextStyle.Assign(AStyle); end; end; end; Inc(BlockIndex); end; finally UnlockUpdate; end; end; procedure TKMemoBlocks.SetIgnoreParaMark(const Value: Boolean); begin if Value <> FIgnoreParaMark then begin FIgnoreParaMark := Value; Update([muExtent]); end; end; procedure TKMemoBlocks.SetItem(Index: TKMemoBlockIndex; const Value: TKMemoBlock); begin inherited SetItem(Index, Value); end; procedure TKMemoBlocks.SetLineText(ALineIndex: TKMemoLineIndex; const AValue: TKString); var St, Len: TKMemoSelectionIndex; PA: TKMemoParagraph; begin if (ALineIndex >= 0) and (ALineIndex < LineCount) then begin LockUpdate; try St := FLines[ALineIndex].StartIndex; Len := FLines[ALineIndex].EndIndex - FLines[ALineIndex].StartIndex; Select(St, Len); ClearSelection; AddTextBlock(AValue, St); PA := AddParagraph(St + 1); PA.ParaStyle.WordWrap := False; // to allow multiple lines to be added finally UnlockUpdate; end; end; end; procedure TKMemoBlocks.SetMemoNotifier(const Value: IKMemoNotifier); var BlockIndex: TKMemoBlockIndex; begin FMemoNotifier := Value; for BlockIndex := 0 to Count - 1 do if Items[BlockIndex] is TKMemoContainer then TKMemoContainer(Items[BlockIndex]).Blocks.MemoNotifier := FMemoNotifier; end; procedure TKMemoBlocks.SetSelectionParaStyle(const Value: TKMemoParaStyle); begin if (SelLength <> 0) or (FSelEnd >= 0) and (FSelStart >= 0) then SetRangeParaStyle(RealSelStart, RealSelEnd, Value); end; procedure TKMemoBlocks.SetSelectionTextStyle(const Value: TKMemoTextStyle); begin if (SelLength <> 0) or (FSelEnd >= 0) and (FSelStart >= 0) then SetRangeTextStyle(RealSelStart, RealSelEnd, Value); end; procedure TKMemoBlocks.SetText(const AValue: TKString); begin LockUpdate; try Clear; InsertPlainText(0, AValue); FixEmptyBlocks; finally UnlockUpdate; end; end; function TKMemoBlocks.SplitForInsert(AAtIndex: TKMemoSelectionIndex; out ABlockIndex: TKMemoBlockIndex): TKMemoBlocks; var ContLocalIndex, BlockLocalIndex: TKMemoSelectionIndex; Block, NewBlock: TKMemoBlock; begin if AAtIndex < 0 then begin Result := Self; ABlockIndex := Count; // just append new blocks end else begin Result := IndexToBlocks(AAtIndex, ContLocalIndex); // get active inner blocks if Result <> nil then begin ABlockIndex := Result.IndexToBlockIndex(ContLocalIndex, BlockLocalIndex); // get block index within active blocks if ABlockIndex >= 0 then begin // if active block is splittable do it and make space for new blocks Block := Result.Items[ABlockIndex]; NewBlock := Block.Split(BlockLocalIndex); if NewBlock <> nil then begin Inc(ABlockIndex); Result.AddAt(NewBlock, ABlockIndex); end; end else ABlockIndex := Result.Count; // just append new blocks to active blocks end else begin Result := Self; ABlockIndex := Result.Count; // just append new blocks to active blocks end; end; end; procedure TKMemoBlocks.Update(AReasons: TKMemoUpdateReasons); begin if UpdateUnlocked then begin if AReasons * [muContent, muContentAddOnly] <> [] then UpdateAttributes; DoUpdate(AReasons); end else FUpdateReasons := FUpdateReasons + AReasons; end; procedure TKMemoBlocks.UpdateAttributes; function NumberToText(ANumber: Integer; AStyle: TKMemoParaNumbering): TKString; begin Result := ''; case AStyle of pnuArabic: Result := IntToStr(ANumber); pnuLetterLo, pnuLetterHi: Result := IntToLatin(ANumber, AStyle = pnuLetterHi); pnuRomanLo, pnuRomanHi: Result := IntToRoman(ANumber, AStyle = pnuRomanHi); end; end; procedure FormatNumberString(AListTable: TKMemoListTable; AStyle: TKMemoParaStyle; ANumberBlock: TKMemoTextBlock); var I, MaxLevel, LevelCount, LevelCounter: Integer; Item: TKMemoNumberingFormatItem; Numbering: TKMemoParaNumbering; List: TKMemoList; ListLevel, ItemLevel: TKMemoListLevel; S: TKString; begin // format using the numbering format List := AListTable.FindByID(AStyle.NumberingList); if List <> nil then begin S := ''; MaxLevel := -1; ListLevel := List.Levels[AStyle.NumberingListLevel]; LevelCount := ListLevel.NumberingFormat.LevelCount; for I := 0 to ListLevel.NumberingFormat.Count - 1 do begin Item := ListLevel.NumberingFormat.Items[I]; if (Item.Level >= 0) and (Item.Text = '') then begin ItemLevel := List.Levels[Item.Level]; Numbering := ItemLevel.Numbering; if not (Numbering in [pnuNone, pnuBullets, pnuArrowTwoBullets, pnuArrowOneBullets, pnuCircleBullets, pnuTriangleBullets]) then begin LevelCounter := ItemLevel.LevelCounter; if AStyle.NumberStartAt > 0 then LevelCounter := AStyle.NumberStartAt else if Item.Level >= LevelCount - 1 then // we only increase the last level Inc(LevelCounter); S := S + NumberToText(LevelCounter, Numbering); ItemLevel.LevelCounter := LevelCounter; MaxLevel := Item.Level; end; end else S := S + Item.Text; end; if Maxlevel >= 0 then // set all counters for subordinated list levels to zero List.Levels.ClearLevelCounters(MaxLevel + 1); S := S + cTab; ANumberBlock.Text := S; if ListLevel.NumberingFontChanged then ANumberBlock.TextStyle.Font.Assign(ListLevel.NumberingFont); end; end; var BlockIndex: TKMemoBlockIndex; Block: TKMemoBlock; PA: TKMemoParagraph; NumberBlock: TKMemoTextBlock; ListTable: TKMemoListTable; State: TKMemoUpdateReasons; begin State := SaveUpdateState; Inc(FUpdateLock); try if MemoNotifier <> nil then ListTable := MemoNotifier.GetListTable else ListTable := nil; if State <> [muContentAddOnly] then begin FRelPos.Clear; FSelectableLength := 0; if ListTable <> nil then ListTable.ClearLevelCounters; BlockIndex := 0; end else begin BlockIndex := FState.LastBlockIndex; end; while BlockIndex < Count do begin Block := Items[BlockIndex]; if Block.Position = mbpText then begin if Block is TKMemoParagraph then begin PA := TKMemoParagraph(Block); PA.LockUpdate; try PA.AssignAttributes(GetLastBlockByClass(BlockIndex, TKMemoTextBlock)); // TODO: make this line optional if ListTable <> nil then begin NumberBlock := PA.NumberBlock; if NumberBlock <> nil then begin NumberBlock.TextStyle.Assign(PA.TextStyle); FormatNumberString(ListTable, PA.ParaStyle, NumberBlock); end; end; finally PA.UnlockUpdate; end; end; Inc(FSelectableLength, Block.SelectableLength); end else begin FRelPos.AddItem(BlockIndex); end; Inc(BlockIndex); end; finally Dec(FUpdateLock); RestoreUpdateState(State); end; if Count > 0 then begin FSelStart := MinMax(FSelStart, 0, FSelectableLength); FSelEnd := MinMax(FSelEnd, 0, FSelectableLength); end else begin FSelStart := -1; FSelEnd := -1; end; end; { TKMemoEditAction } function TKMemoEditAction.HandlesTarget(Target: TObject): Boolean; begin Result := Target is TKCustomMemo; end; procedure TKMemoEditAction.ExecuteTarget(Target: TObject); begin TKMemo(Target).ExecuteCommand(GetEditCommand); end; procedure TKMemoEditAction.UpdateTarget(Target: TObject); begin Enabled := TKMemo(Target).CommandEnabled(GetEditCommand); end; { TKMemoEditSelectAllAction } function TKMemoEditSelectAllAction.GetEditCommand: TKEditCommand; begin Result := ecSelectAll; end; { TKMemoEditCopyAction } function TKMemoEditCopyAction.GetEditCommand: TKEditCommand; begin Result := ecCopy; end; { TKMemoEditCutAction } function TKMemoEditCutAction.GetEditCommand: TKEditCommand; begin Result := ecCut; end; { TKMemoEditPasteAction } function TKMemoEditPasteAction.GetEditCommand: TKEditCommand; begin Result := ecPaste; end; end. tomboy-ng_0.39-1/kcontrols/source/kcontrols.pas0000644000175000017500000041357014346341266021504 0ustar dbannondbannon{ @abstract(This file is part of the KControls component suite for Delphi and Lazarus.) @author(Tomas Krysl) Copyright (c) 2020 Tomas Krysl

License:
This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html. } unit kcontrols; // lowercase name because of Lazarus/Linux {$include kcontrols.inc} {$WEAKPACKAGEUNIT ON} interface uses {$IFDEF FPC} LCLType, LCLIntf, LMessages, LCLProc, LResources, {$ELSE} Windows, Messages, {$ENDIF} SysUtils, Classes, Graphics, Controls, Contnrs, Printers, Forms, KFunctions {$IFDEF USE_THEMES} , Themes {$IFNDEF FPC} , UxTheme {$ENDIF} {$ENDIF} ; type { This array serves as storage place for all colors. } TKColorArray = array of TColor; { Declares possible indexes for colors available in @link(TKPreviewColors). } TKPreviewColorIndex = Integer; { Declares print options - possible values for the @link(TKPrintPageSetup.Options) property. } TKPrintOption = ( { If there are more printed copies these will be collated. } poCollate, { The printed shape will be scaled to fit on page. } poFitToPage, { Every even page will be printed with mirrored (swapped) margins. } poMirrorMargins, { Page numbers will be added to the bottom of each printed page. } poPageNumbers, { Paints the selection in control's specific manner. } poPaintSelection, { Title will be printed to the top of each printed page. } poTitle, { Color page will be printed instead of B/W page. } poUseColor, { Print line numbers if applicable. } poLineNumbers, { Wrap long lines if applicable. } poWrapLines ); { Print options can be arbitrary combined. } TKPrintOptions = set of TKPrintOption; { Declares possible values for the @link(TKPrintPageSetup.Range) property. } TKPrintRange = ( { All pages will be printed. } prAll, { Only selected block will be printed. } prSelectedOnly, { Only given range of pages will be printed. } prRange ); { Declares measurement units for KControls printing system. } TKPrintUnits = ( { Corresponding value is given in millimeters. } puMM, { Corresponding value is given in centimeters. } puCM, { Corresponding value is given in inches. } puInch, { Corresponding value is given in hundredths of inches. } puHundredthInch ); const {$IFNDEF FPC} { @exclude } KM_MOUSELEAVE = WM_MOUSELEAVE; { @exclude } LM_USER = WM_USER; { @exclude } LM_CANCELMODE = WM_CANCELMODE; { @exclude } LM_CHAR = WM_CHAR; { @exclude } LM_CLEAR = WM_CLEAR; { @exclude } LM_CLOSEQUERY = WM_CLOSE; { @exclude } LM_COPY = WM_COPY; { @exclude } LM_CUT = WM_CUT; { @exclude } LM_DROPFILES = WM_DROPFILES; { @exclude } LM_ERASEBKGND = WM_ERASEBKGND; { @exclude } LM_GETDLGCODE = WM_GETDLGCODE; { @exclude } LM_HSCROLL = WM_HSCROLL; { @exclude } LM_KEYDOWN = WM_KEYDOWN; { @exclude } LM_KILLFOCUS = WM_KILLFOCUS; { @exclude } LM_LBUTTONDOWN = WM_LBUTTONDOWN; { @exclude } LM_LBUTTONUP = WM_LBUTTONUP; { @exclude } LM_MOUSEMOVE = WM_MOUSEMOVE; { @exclude } LM_MOVE = WM_MOVE; { @exclude } LM_PASTE = WM_PASTE; { @exclude } LM_PAINT = WM_PAINT; { @exclude } LM_SETFOCUS = WM_SETFOCUS; { @exclude } LM_SIZE = WM_SIZE; { @exclude } LM_VSCROLL = WM_VSCROLL; { @exclude } LCL_MAJOR = 0; { @exclude } LCL_MINOR = 0; { @exclude } LCL_RELEASE = 0; {$ELSE} { @exclude } KM_MOUSELEAVE = LM_MOUSELEAVE; // LCL 0.9.27+, for older it was LM_LEAVE { @exclude } //WM_CTLCOLORBTN = Messages.WM_CTLCOLORBTN; { @exclude } //WM_CTLCOLORSTATIC = Messages.WM_CTLCOLORSTATIC; {$ENDIF} { Base for custom messages used by KControls suite. } KM_BASE = LM_USER + 1024; { Custom message. } KM_LATEUPDATE = KM_BASE + 1; { Recalculate scroll box size and scrollbars. } KM_SCROLL = KM_BASE + 2; { Constant for horizontal resize cursor. } crHResize = TCursor(101); { Constant for vertical resize cursor. } crVResize = TCursor(102); { Constant for uncaptured dragging cursor. } crDragHandFree = TCursor(103); { Constant for captured dragging cursor. } crDragHandGrip = TCursor(104); { Default value for the @link(TKCustomControl.BorderStyle) property. } cBorderStyleDef = bsSingle; cRectBottomDef = 0; cRectLeftDef = 0; cRectRightDef = 0; cRectTopDef = 0; { Minimum for the @link(TKPrintPageSetup.Copies) property } cCopiesMin = 1; { Maximum for the @link(TKPrintPageSetup.Copies) property } cCopiesMax = 1000; { Default value for the @link(TKPrintPageSetup.Copies) property } cCopiesDef = 1; { Default value for the @link(TKPrintPageSetup.UnitMarginBottom) property } cMarginBottomDef = 2.0; { Default value for the @link(TKPrintPageSetup.UnitMarginLeft) property } cMarginLeftDef = 1.5; { Default value for the @link(TKPrintPageSetup.UnitMarginRight) property } cMarginRightDef = 1.5; { Default value for the @link(TKPrintPageSetup.UnitMarginTop) property } cMarginTopDef = 1.8; { Default value for the @link(TKPrintPageSetup.Options) property. } cOptionsDef = [poFitToPage, poPageNumbers, poUseColor]; cOptionsAll = [Low(TKPrintOption)..High(TKPrintOption)]; { Default value for the @link(TKPrintPageSetup.Options) property. } cRangeDef = prAll; { Default value for the @link(TKPrintPageSetup.Scale) property } cScaleDef = 100; { Minimum for the @link(TKPrintPageSetup.Scale) property } cScaleMin = 10; { Maximum for the @link(TKPrintPageSetup.Scale) property } cScaleMax = 500; { Default DPI value } cDPIDef = 96; { Minimum DPI value } cDPIMin = 50; { Maximum DPI value } cDPIMax = 1000; { Default value for the @link(TKPrintPageSetup.Units) property. } cUnitsDef = puCM; { Default value for the @link(TKPreviewColors.Paper) color property. } cPaperDef = clWhite; { Default value for the @link(TKPreviewColors.BkGnd) color property. } cBkGndDef = clAppWorkSpace; { Default value for the @link(TKPreviewColors.Border) color property. } cBorderDef = clBlack; { Default value for the @link(TKPreviewColors.SelectedBorder) color property. } cSelectedBorderDef = clNavy; { Index for the @link(TKPreviewColors.Paper) property. } ciPaper = TKPreviewColorIndex(0); { Index for the @link(TKPreviewColors.BkGnd) property. } ciBkGnd = TKPreviewColorIndex(1); { Index for the @link(TKPreviewColors.Border) property. } ciBorder = TKPreviewColorIndex(2); { Index for the @link(TKPreviewColors.SelectedBorder) property. } ciSelectedBorder = TKPreviewColorIndex(3); { Maximum color array index } ciPreviewColorsMax = ciSelectedBorder; { Constant for control scrollbars. It means: Leave that scrollbar untouched. } cScrollNoAction = -1; { Constant for control scrollbars. It means: Use given Delta to update scrollbar. } cScrollDelta = -2; { Internal flag for TKPrintPreview. } cPF_Dragging = $00000001; { Internal flag for TKPrintPreview. } cPF_UpdateRange = $00000002; type {$IFNDEF FPC} { @exclude } TLMessage = TMessage; { @exclude } TLMCopy = TWMCopy; { @exclude } TLMMouse = TWMMouse; { @exclude } TLMNoParams = TWMNoParams; { @exclude } TLMKey = TWMKey; { @exclude } TLMChar = TWMChar; { @exclude } TLMEraseBkGnd = TWMEraseBkGnd; { @exclude } TLMHScroll = TWMHScroll; { @exclude } TLMKillFocus = TWMKillFocus; { @exclude } TLMMove = TWMMove; { @exclude } TLMPaint = TWMPaint; { @exclude } TLMPaste = TWMPaste; { @exclude } TLMSetFocus = TWMSetFocus; { @exclude } TLMSize = TWMSize; { @exclude } TLMVScroll = TWMVScroll; {$IFNDEF COMPILER17_UP} { Support for Win64 messaging. } LONG_PTR = Longint; {$ENDIF} {$ENDIF} {$IFDEF FPC} TKClipboardFormat = TClipboardFormat; {$ELSE} TKClipboardFormat = Word; {$ENDIF} { Declares possible values for the @link(ScaleMode) property } TKPreviewScaleMode = ( { Apply scale defined by the @link(Scale) property } smScale, { Scale the page so that it horizontally fits to the window client area } smPageWidth, { Scale the page so that it fits to the window client area } smWholePage); { @abstract(Declares @link(TKPrintPreview.OnChanged) event handler)
    Parameters:
  • Sender - identifies the event caller
} TKPreviewChangedEvent = procedure(Sender: TObject) of object; { @abstract(Declares the information structure for the @link(TKCustomControl.MeasurePages) method)
    Members:
  • OutlineWidth - printed outline width (maximum of all pages) in desktop pixels
  • OutlineHeight - printed outline height (maximum of all pages) in desktop pixels
  • ControlHorzPageCount - number of pages to split control shape into
  • ControlVertPageCount - number of pages to split control shape into
  • ExtraLeftHorzPageCount - number of horizontal pages to the left of control
  • ExtraLeftVertPageCount - number of vertical pages to the left of control
  • ExtraRightHorzPageCount - number of horizontal pages to the right of control
  • ExtraRightVertPageCount - number of vertical pages to the right of control
} TKPrintMeasureInfo = record OutlineWidth: Integer; OutlineHeight: Integer; ControlHorzPageCount: Integer; ControlVertPageCount: Integer; ExtraLeftHorzPageCount: Integer; ExtraLeftVertPageCount: Integer; ExtraRightHorzPageCount: Integer; ExtraRightVertPageCount: Integer; end; { Declares possible values for the Status parameter in the @link(TKPrintNotifyEvent) event } TKPrintStatus = ( { This event occurs at the beginning of the print job - you may show an Abort dialog here } epsBegin, { This event occurs after each page has been printed - you may update the Page/Copy information in the Abort dialog } epsNewPage, { This event occurs at the end of the print job - you may hide the Abort dialog here } epsEnd ); { @abstract(Declares @link(TKCustomControl.OnPrintNotify) event handler)
    Parameters:
  • Sender - identifies the event caller
  • Status - specifies the event type
  • Abort - set to True to abort the print job
Remark: At certain time slots, the print spooler allows the message queue to be processed for the thread where the print job is running. This e.g. allows the user to press a button on the Abort dialog. Because this message loop can be invoked e.g. during a Printer.Canvas.TextRect function and any painting messages may hover in the message queue, any functions used both to print a job and to process particular messages should be reentrant to avoid conflicts. Perhaps should print jobs be run in seperate threads? } TKPrintNotifyEvent = procedure(Sender: TObject; Status: TKPrintStatus; var Abort: Boolean) of object; { @abstract(Declares @link(TKCustomControl.OnPrintPaint) event handler)
    Parameters:
  • Sender - identifies the event caller
} TKPrintPaintEvent = procedure(Sender: TObject) of object; TKPrintPageSetup = class; TKPrintPreview = class; TKRect = class(TPersistent) private FLeft, FTop, FRight, FBottom: Integer; FOnChanged: TNotifyEvent; procedure SetBottom(const Value: Integer); procedure SetLeft(const Value: Integer); procedure SetRight(const Value: Integer); procedure SetTop(const Value: Integer); procedure SetAll(const Value: Integer); function GetHeight: Integer; function GetWidth: Integer; protected procedure Changed; public constructor Create; procedure Assign(Source: TPersistent); override; procedure AssignFromRect(const ARect: TRect); procedure AssignFromValues(ALeft, ATop, ARight, ABottom: Integer); function ContainsPoint(const APoint: TPoint): Boolean; function EqualProperties(const ARect: TKRect): Boolean; function NonZero: Boolean; function OffsetRect(ARect: TKRect): TRect; overload; function OffsetRect(const ARect: TRect): TRect; overload; property All: Integer write SetAll; property OnChanged: TNotifyEvent read FOnChanged write FOnChanged; published property Left: Integer read FLeft write SetLeft default cRectLeftDef; property Top: Integer read FTop write SetTop default cRectTopDef; property Right: Integer read FRight write SetRight default cRectRightDef; property Bottom: Integer read FBottom write SetBottom default cRectBottomDef; property Width: Integer read GetWidth; property Height: Integer read GetHeight; end; { Base class for all visible controls in KControls. } { TKCustomControl } TKCustomControl = class(TCustomControl) private {$IF DEFINED(FPC) OR NOT DEFINED(COMPILER10_UP)} FParentBackground: Boolean; FParentDoubleBuffered: Boolean; {$IFEND} {$IFNDEF FPC} FBorderStyle: TBorderStyle; {$ENDIF} {$IFNDEF COMPILER10_UP} FMouseInClient: Boolean; {$ENDIF} FMemoryCanvas: TCanvas; FMemoryCanvasRect: TRect; FPageSetup: TKPrintPageSetup; FUpdateLock: Integer; FOnPrintNotify: TKPrintNotifyEvent; FOnPrintPaint: TKPrintPaintEvent; {$IFNDEF FPC} procedure CMCancelMode(var Msg: TMessage); message CM_CANCELMODE; procedure CMCtl3DChanged(var Msg: TMessage); message CM_CTL3DCHANGED; {$ENDIF} procedure CMMouseLeave(var Msg: TLMessage); message CM_MOUSELEAVE; function GetCanPrint: Boolean; function GetPageSetup: TKPrintPageSetup; function GetPageSetupAllocated: Boolean; procedure KMLateUpdate(var Msg: TLMessage); message KM_LATEUPDATE; {$IFNDEF FPC} procedure SetBorderStyle(Value: TBorderStyle); {$ENDIF} procedure SetPageSetup(Value: TKPrintPageSetup); {$IFNDEF FPC} procedure WMCancelMode(var Msg: TWMCancelMode); message WM_CANCELMODE; {$ENDIF} {$IFNDEF COMPILER10_UP} procedure WMMouseLeave(var Msg: TLMessage); message KM_MOUSELEAVE; {$ENDIF} {$IFNDEF FPC} procedure WMNCPaint(var Msg: TWMNCPaint); message WM_NCPAINT; procedure WMSetCursor(var Msg: TWMSetCursor); message WM_SETCURSOR; {$ENDIF} procedure WMSize(var Msg: TLMSize); message LM_SIZE; {$IFNDEF FPC} {$IFDEF USE_THEMES} procedure WMThemeChanged(var Msg: TMessage); message WM_THEMECHANGED; {$ENDIF} {$ENDIF} protected { Holds the mutually inexclusive state as cXF... flags. } FFlags: Cardinal; { Defines the message queue for late update. } FMessages: array of TLMessage; { Previous size of control client area. } FOldClientSize: TPoint; { Gains access to the list of associated previews. } FPreviewList: TList; FResizeCalled: Boolean; { Adds a preview control to the internal list of associated previews. } procedure AddPreview(APreview: TKPrintPreview); { Gives the descendant the possibility to adjust the associated TKPrintPageSetup instance just before printing. } procedure AdjustPageSetup; virtual; { Calls @link(TKCustomControl.UpdateSize) only when the control client area has been really modified. } procedure CallUpdateSize; virtual; { Cancels any dragging or resizing operations performed by mouse. } procedure CancelMode; virtual; { Overriden method. Calls @link(TKCustomControl.UpdateSize). } procedure CreateHandle; override; { Defines additional styles. } procedure CreateParams(var Params: TCreateParams); override; {$IFDEF FPC} { Overriden method. Calls @link(TKCustomControl.UpdateSize). } procedure DoOnChangeBounds; override; {$ENDIF} { If Value is True, includes the flag specified by AFLag to @link(FFlags). If Value is False, excludes the flag specified by AFLag from @link(FFlags). } procedure FlagAssign(AFlag: Cardinal; Value: Boolean); { Excludes the flag specified by AFLag from @link(FFlags). } procedure FlagClear(AFlag: Cardinal); { Includes the flag specified by AFLag to @link(FFlags). } procedure FlagSet(AFlag: Cardinal); { If the flag specified by AFLag is included in @link(FFlags), FlagToggle excludes it and vice versa. } procedure FlagToggle(AFlag: Cardinal); { Invalidates the page setup settings. If page setup is required again, it's UpdateSettings method is called. } procedure InvalidatePageSetup; { Invalidates a rectangular part of the client area if control updating is not locked by @link(TKCustomControl.LockUpdate). } procedure InvalidateRectArea(const R: TRect); virtual; { Returns True if the control has a selection. } function InternalGetSelAvail: Boolean; virtual; { Called in UnlockUpdate. Allows the changes to be reflected. } procedure InternalUnlockUpdate; virtual; { Determines if control can be painted with OS themes. } function IsThemed: Boolean; virtual; { Called from KM_LATEUPDATE. Performs late update. Override to adapt. } procedure LateUpdate(var Msg: TLMessage); virtual; { Updates information about printed shape. } procedure MeasurePages(var Info: TKPrintMeasureInfo); virtual; { Retrieves a message from message queue if there is one. Used for late update.} function MessagePeek(out Msg: TLMessage): Boolean; { Puts a new message into the message queue. Used for late update.} procedure MessagePoke(const Msg: TLMessage); { Searches the message queue for given message code. } function MessageSearch(MsgCode: Cardinal): Boolean; { Responds to WM_MOUSELEAVE message. } procedure MouseFormLeave; virtual; { Overriden method - see Delphi help. } procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; { Notifies all associated previews about a change in the associated page setup. } procedure NotifyPreviews; { Overriden method - see Delphi help. Paints the entire control client area. } procedure Paint; override; { Paints a page to a printer/preview canvas. } procedure PaintPage; virtual; { Paints the control to the specified canvas. Must always be overriden. } procedure PaintToCanvas(ACanvas: TCanvas); virtual; abstract; { Adds a message to message queue for late update. Set IfNotExists to True to add that message only if the specified message code does not exist in the message queue at this moment. } procedure PostLateUpdate(const Msg: TLMessage; IfNotExists: Boolean = False); { Calls the @link(TKCustomControl.OnPrintNotify) event } procedure PrintNotify(Status: TKPrintStatus; var Abort: Boolean); virtual; { Calls the @link(TKCustomControl.OnPrintPaint) event } procedure PrintPaint; virtual; { Allows descendant to make necessary adjustments before printing or painting to preview starts. } procedure PrintPaintBegin; virtual; { Allows descendant to make necessary adjustments after printing or painting to preview ended. } procedure PrintPaintEnd; virtual; { Remove a preview control to the internal list of associated previews. } procedure RemovePreview(APreview: TKPrintPreview); { Respond to resize calls} procedure Resize; override; { Updates mouse cursor according to the state determined from current mouse position. Returns True if cursor has been changed. } function SetMouseCursor(X, Y: Integer): Boolean; virtual; { Updates the control size. Responds to WM_SIZE under Delphi and similar notifications under Lazarus. } procedure UpdateSize; virtual; public { Creates the instance. Assigns default values to properties, allocates default column, row and cell data. } constructor Create(AOwner: TComponent); override; { Destroys the instance along with all allocated column, row and cell data. See TObject.Destroy in Delphi help. } destructor Destroy; override; { Determines whether a flag specified by AFlag is included in @link(FFlags). } function Flag(AFlag: Cardinal): Boolean; { Invalidates the entire control if control updating is not locked by @link(TKCustomControl.LockUpdate). } procedure Invalidate; override; { Locks control updating so that all possibly slow operations such as all Invalidate... methods will not be performed. This is useful e.g. when assigning many properties at one time. Every LockUpdate call must have a corresponding @link(TKCustomControl.UnlockUpdate) call, please use a try-finally section. } procedure LockUpdate; virtual; { Prints the control. } procedure PrintOut; { Unlocks back to normal control updating and calls InternalUnlockUpdate to reflect (possible) multiple changes made. Each @link(LockUpdate) call must be always followed by the UnlockUpdate call. } procedure UnlockUpdate; virtual; { Returns True if control updating is not locked, i.e. there is no open LockUpdate and UnlockUpdate pair. } function UpdateUnlocked: Boolean; virtual; { Determines whether a single line border is drawn around the control. Set BorderStyle to bsSingle to add a single line border around the control. Set BorderStyle to bsNone to omit the border. } {$IFDEF FPC} property BorderStyle default cBorderStyleDef; {$ELSE} property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default cBorderStyleDef; {$ENDIF} { Returns True if the control has anything to print and a printer is installed. } property CanPrint: Boolean read GetCanPrint; {$IFNDEF COMPILER10_UP} { This property has the same meaning as the MouseInClient property introduced into TWinControl in BDS 2006. } property MouseInClient: Boolean read FMouseInClient; {$ENDIF} { Setting this property causes the control to be painted to MemoryCanvas in it's Paint method. This approach replaces PaintTo as it does not work good for all LCL widget sets. The control is painted normally on it's Canvas and then copied only once to MemoryCanvas. MemoryCanvas is then set to nil (not freed) to indicate the copying is complete. } property MemoryCanvas: TCanvas read FMemoryCanvas write FMemoryCanvas; { Specifies what rectangular part of the control should be copied on MemoryCanvas. } property MemoryCanvasRect: TRect read FMemoryCanvasRect write FMemoryCanvasRect; { This event is called at certain phases of the actually running print job. } property OnPrintNotify: TKPrintNotifyEvent read FOnPrintNotify write FOnPrintNotify; { This event is called after the shape was drawn onto the printer canvas. } property OnPrintPaint: TKPrintPaintEvent read FOnPrintPaint write FOnPrintPaint; { Specifies the page setup component used for this control. } property PageSetup: TKPrintPageSetup read GetPageSetup write SetPageSetup; {Returns True if page setup component is allocated for this control. } property PageSetupAllocated: Boolean read GetPageSetupAllocated; { Just to be compatible with Delphi. } {$IF DEFINED(FPC) OR NOT DEFINED(COMPILER10_UP)} property ParentBackground: Boolean read FParentBackground write FParentBackground default True; property ParentDoubleBuffered: Boolean read FParentDoubleBuffered write FParentDoubleBuffered default True; {$IFEND} end; { Declares possible values for the @link(TKCustomColors.ColorScheme) property. } TKColorScheme = ( { GetColor returns normal color currently defined for each item } csNormal, { GetColor returns gray for text and line colors and white for background colors } csGrayed, { GetColor returns brighter version of normal color } csBright, { GetColor returns grayscaled color versions } csGrayScale ); { Declares possible indexes e.g. for the @link(TKCustomColors.Color) property. } TKColorIndex = Integer; { @abstract(Declares the color description structure returned by @link(TKCustomColors.ColorData) property)
    Members:
  • Index - color index
  • Color - current color value
  • Default - default color value
  • Name - color name
} TKColorData = record Index: TKColorIndex; Color: TColor; Default: TColor; Name: string; end; { @abstract(Declares @link(TKCustomColors) color item description)
    Members:
  • Def - default color value
  • Name - color name (can be localized)
} TKColorSpec = record Def: TColor; Name: string; end; { @abstract(Container for all colors used by specific control) This container allows to group many colors into one item in object inspector. Colors are accessible via published properties or several public Color* properties. } TKCustomColors = class(TPersistent) private function GetColorData(Index: TKColorIndex): TKColorData; function GetColorEx(Index: TKColorIndex): TColor; function GetColorName(Index: TKColorIndex): string; function GetDefaultColor(Index: TKColorIndex): TColor; procedure SetColorEx(Index: TKColorIndex; Value: TColor); procedure SetColors(const Value: TKColorArray); protected FControl: TKCustomControl; FColorScheme: TKColorScheme; FBrightColors: TKColorArray; FColors: TKColorArray; { Returns the specific color. Use for property assignments. } function GetColor(Index: TKColorIndex): TColor; { Returns color specification structure for given index. } function GetColorSpec(Index: TKColorIndex): TKColorSpec; virtual; { Returns maximum color index. } function GetMaxIndex: Integer; virtual; { Initializes the color array. } procedure Initialize; virtual; { Returns the specific color according to ColorScheme. } function InternalGetColor(Index: TKColorIndex): TColor; virtual; { Replaces the specific color. } procedure InternalSetColor(Index: TKColorIndex; Value: TColor); virtual; { Replaces the specific color. Use for property assignments. } procedure SetColor(Index: TKColorIndex; Value: TColor); public { Creates the instance. You can create a custom instance and pass it e.g. to a @link(TKCustomGrid.Colors) property. The AGrid parameter has no meaning in this case and you may set it to nil. } constructor Create(AControl: TKCustomControl); virtual; { Copies the properties of another instance that inherits from TPersistent into this TKGridColors instance. } procedure Assign(Source: TPersistent); override; { Clears cached brighter colors. } procedure ClearBrightColors; virtual; { Returns always normal color - regardless of the ColorScheme setting. } property Color[Index: TKColorIndex]: TColor read GetColorEx write SetColorEx; { Returns always a complete color description } property ColorData[Index: TKColorIndex]: TKColorData read GetColorData; { Returns (localizable) color name. } property ColorName[Index: TKColorIndex]: string read GetColorName; { Returns array of normal colors. } property Colors: TKColorArray read FColors write SetColors; { Specifies color scheme for reading of published properties - see GetColor in source code. } property ColorScheme: TKColorScheme read FColorScheme write FColorScheme; { Returns default color. } property DefaultColor[Index: TKColorIndex]: TColor read GetDefaultColor; end; { @abstract(Declares @link(TKPrintPageSetup.OnPrintMeasure) event handler)
    Parameters:
  • Sender - identifies the event caller
  • Info - print measure info structure already filled by the associated control
} TKPrintMeasureEvent = procedure(Sender: TObject; var Info: TKPrintMeasureInfo) of object; { @abstract(Class to specify the print job parameters) } TKPrintPageSetup = class(TKPersistent) private FActive: Boolean; FCanvas: TCanvas; FControl: TKCustomControl; FControlHorzPageCount: Integer; FControlPageCount: Integer; FControlVertPageCount: Integer; FCopies: Integer; FCurrentCopy: Integer; FCurrentPage: Integer; FCurrentScale: Double; FDesktopPixelsPerInchX: Integer; FDesktopPixelsPerInchY: Integer; FEndPage: Integer; FExtraLeftHorzPageCount: Integer; FExtraLeftPageCount: Integer; FExtraLeftVertPageCount: Integer; FExtraRightHorzPageCount: Integer; FExtraRightPageCount: Integer; FExtraRightVertPageCount: Integer; FIsValid: Boolean; FMappedControlPaintAreaWidth: Integer; FMappedExtraSpaceLeft: Integer; FMappedExtraSpaceRight: Integer; FMappedFooterSpace: Integer; FMappedHeaderSpace: Integer; FMappedMarginBottom: Integer; FMappedMarginLeft: Integer; FMappedMarginLeftMirrored: Integer; FMappedMarginRight: Integer; FMappedMarginRightMirrored: Integer; FMappedMarginTop: Integer; FMappedOutlineHeight: Integer; FMappedOutlineWidth: Integer; FMappedPaintAreaHeight: Integer; FMappedPaintAreaWidth: Integer; FMappedPageHeight: Integer; FMappedPageWidth: Integer; FOptions: TKPrintOptions; FOrientation: TPrinterOrientation; FPageCount: Integer; FPreviewing: Boolean; FPrinterControlPaintAreaWidth: Integer; FPrinterExtraSpaceLeft: Integer; FPrinterExtraSpaceRight: Integer; FPrinterFooterSpace: Integer; FPrinterHeaderSpace: Integer; FPrinterMarginBottom: Integer; FPrinterMarginLeft: Integer; FPrinterMarginLeftMirrored: Integer; FPrinterMarginRight: Integer; FPrinterMarginRightMirrored: Integer; FPrinterMarginTop: Integer; FPrinterName: string; FPrinterPageHeight: Integer; FPrinterPageWidth: Integer; FPrinterPaintAreaHeight: Integer; FPrinterPaintAreaWidth: Integer; FPrinterPixelsPerInchX: Integer; FPrinterPixelsPerInchY: Integer; FPrintingMapped: Boolean; FRange: TKPrintRange; FStartPage: Integer; FScale: Integer; FTitle: string; FUnitControlPaintAreaWidth: Double; FUnitExtraSpaceLeft: Double; FUnitExtraSpaceRight: Double; FUnitFooterSpace: Double; FUnitHeaderSpace: Double; FUnitMarginBottom: Double; FUnitMarginLeft: Double; FUnitMarginRight: Double; FUnitMarginTop: Double; FUnitPaintAreaHeight: Double; FUnitPaintAreaWidth: Double; FUnits: TKPrintUnits; FValidating: Boolean; FOnPrintMeasure: TKPrintMeasureEvent; FOnUpdateSettings: TNotifyEvent; function GetCurrentPageControl: Integer; function GetCurrentPageExtraLeft: Integer; function GetCurrentPageExtraRight: Integer; function GetIsDefaultPrinter: Boolean; procedure SetCopies(Value: Integer); procedure SetEndPage(Value: Integer); procedure SetUnitExtraSpaceLeft(Value: Double); procedure SetUnitExtraSpaceRight(Value: Double); procedure SetUnitFooterSpace(Value: Double); procedure SetUnitHeaderSpace(Value: Double); procedure SetUnitMarginBottom(Value: Double); procedure SetUnitMarginLeft(Value: Double); procedure SetUnitMarginRight(Value: Double); procedure SetUnitMarginTop(Value: Double); procedure SetOptions(Value: TKPrintOptions); procedure SetOrientation(AValue: TPrinterOrientation); procedure SetPrinterName(const Value: string); procedure SetPrintingMapped(Value: Boolean); procedure SetRange(Value: TKPrintRange); procedure SetScale(Value: Integer); procedure SetStartPage(Value: Integer); procedure SetUnits(Value: TKPrintUnits); protected function GetCanPrint: Boolean; virtual; function GetSelAvail: Boolean; virtual; { Called before new Units are set. Converts the margins to inches by default. } procedure AfterUnitsChange; virtual; { Called after new Units are set. Converts the margins from inches by default. } procedure BeforeUnitsChange; virtual; { Paints a page to APreview.Canvas. } procedure PaintPageToPreview(APreview: TKPrintPreview); virtual; { Prints the page number at the bottom of the page, horizontally centered. } procedure PrintPageNumber(Value: Integer); virtual; { Prints the title at the top of the page. } procedure PrintTitle; virtual; { Inherited method. Calls UpdateSettings. } procedure Update; override; { Updates entire printing information. } procedure UpdateSettings; virtual; public { Creates the instance. Assigns default values to properties. } constructor Create(AControl: TKCustomControl); reintroduce; virtual; { Copies shareable properties of another TKPrintPageSetup instance to this instance. } procedure Assign(Source: TPersistent); override; { Returns a value mapped from desktop horizontal units to printer horizontal units. } function HMap(Value: Integer): Integer; { Invalidates the settings. } procedure Invalidate; { Prints the associated control. } procedure PrintOut; { Validates the settings. } procedure Validate; { Returns a value mapped from desktop vertical units to printer vertical units. } function VMap(Value: Integer): Integer; { Returns True if printing or previewing is active. } property Active: Boolean read FActive; { Returns True if the control is associated and has anything to print. } property CanPrint: Boolean read GetCanPrint; { Returns the Printer.Canvas or TkPrintPreview.Canvas. Do not access outside print job. } property Canvas: TCanvas read FCanvas; { Returns the control to which this TKPrintPageSetup instance is assigned. } property Control: TKCustomControl read FControl; { Returns the maximum amount of control pages for horizontal axis. } property ControlHorzPageCount: Integer read FControlHorzPageCount; { Returns the maximum amount of control pages for vertical axis. } property ControlVertPageCount: Integer read FControlVertPageCount; { Specifies the number of copies to print. } property Copies: Integer read FCopies write SetCopies; { Returns the currently printed copy. } property CurrentCopy: Integer read FCurrentCopy; { Returns the currently printed page. } property CurrentPage: Integer read FCurrentPage; { Returns the currently printed page relative to the control shape. It must be used with associated control to print page. } property CurrentPageControl: Integer read GetCurrentPageControl; { Returns the currently printed page relative to the extra left shape. } property CurrentPageExtraLeft: Integer read GetCurrentPageExtraLeft; { Returns the currently printed page relative to the extra left shape. } property CurrentPageExtraRight: Integer read GetCurrentPageExtraRight; { Returns the horizontal scale for the printed shape, without dimension. } property CurrentScale: Double read FCurrentScale; { Returns the control paint area width on canvas in units depending on PrintingMapped. } property MappedControlPaintAreaWidth: Integer read FMappedControlPaintAreaWidth; { Returns the width of extra left paint area on canvas in units depending on PrintingMapped. } property MappedExtraSpaceLeft: Integer read FMappedExtraSpaceLeft; { Returns the width of extra right paint area on canvas in units depending on PrintingMapped. } property MappedExtraSpaceRight: Integer read FMappedExtraSpaceRight; { Returns the footer space in units depending on PrintingMapped. } property MappedFooterSpace: Integer read FMappedFooterSpace; { Returns the header space in units depending on PrintingMapped. } property MappedHeaderSpace: Integer read FMappedHeaderSpace; { Returns the bottom margin in units depending on PrintingMapped. } property MappedMarginBottom: Integer read FMappedMarginBottom; { Returns the left margin in units depending on PrintingMapped. } property MappedMarginLeft: Integer read FMappedMarginLeft; { Returns the left margin respecting current page in units depending on PrintingMapped. } property MappedMarginLeftMirrored: Integer read FMappedMarginLeftMirrored; { Returns the right margin in units depending on PrintingMapped. } property MappedMarginRight: Integer read FMappedMarginRight; { Returns the left margin respecting current page in units depending on PrintingMapped. } property MappedMarginRightMirrored: Integer read FMappedMarginRightMirrored; { Returns the top margin in units depending on PrintingMapped. } property MappedMarginTop: Integer read FMappedMarginTop; { Returns the printed shape height (maximum of all pages) in units depending on PrintingMapped. } property MappedOutlineHeight: Integer read FMappedOutlineHeight; { Returns the printed shape width (maximum of all pages) in units depending on PrintingMapped. } property MappedOutlineWidth: Integer read FMappedOutlineWidth; { Returns the paint area height on canvas in units depending on PrintingMapped. } property MappedPaintAreaHeight: Integer read FMappedPaintAreaHeight; { Returns the paint area width on canvas in units depending on PrintingMapped. } property MappedPaintAreaWidth: Integer read FMappedPaintAreaWidth; { Returns the page height in units depending on PrintingMapped. } property MappedPageHeight: Integer read FMappedPageHeight; { Returns the page width in units depending on PrintingMapped. } property MappedPageWidth: Integer read FMappedPageWidth; { Returns the amount of pixels per inch for the desktop device context's horizontal axis } property DesktopPixelsPerInchX: Integer read FDesktopPixelsPerInchX; { Returns the amount of pixels per inch for the desktop device context's vertical axis } property DesktopPixelsPerInchY: Integer read FDesktopPixelsPerInchY; { Specifies last page printed if Range is eprRange. } property EndPage: Integer read FEndPage write SetEndPage; { Returns extra horizontal pages needed to print extra left space. } property ExtraLeftHorzPageCount: Integer read FExtraLeftHorzPageCount; { Returns extra vertical pages needed to print extra left space. } property ExtraLeftVertPageCount: Integer read FExtraLeftVertPageCount; { Returns extra horizontal pages needed to print extra right space. } property ExtraRightHorzPageCount: Integer read FExtraRightHorzPageCount; { Returns extra vertical pages needed to print extra right space. } property ExtraRightVertPageCount: Integer read FExtraRightVertPageCount; { Returns True if default printer is selected otherwise Talse. Because of VCL.Printers bug, there is no way to use any printer when False. } property IsDefaultPrinter: Boolean read GetIsDefaultPrinter; { Specifies the printing options. } property Options: TKPrintOptions read FOptions write SetOptions; { Specifies the paper orientation. } property Orientation: TPrinterOrientation read FOrientation write SetOrientation; { Returns the amount of all pages. Includes the extra left and right areas. } property PageCount: Integer read FPageCount; { Returns True if painting to a TKPrintPreview.Canvas is active. } property Previewing: Boolean read FPreviewing; { Returns the control paint area width in printer device context's units. } property PrinterControlPaintAreaWidth: Integer read FPrinterControlPaintAreaWidth; { Returns the left extra space in printer device context's units. } property PrinterExtraSpaceLeft: Integer read FPrinterExtraSpaceLeft; { Returns the right extra space in printer device context's units. } property PrinterExtraSpaceRight: Integer read FPrinterExtraSpaceRight; { Returns the footer space in printer device context's units. } property PrinterFooterSpace: Integer read FPrinterFooterSpace; { Returns the header space in printer device context's units. } property PrinterHeaderSpace: Integer read FPrinterHeaderSpace; { Returns the bottom margin in printer device context's units. } property PrinterMarginBottom: Integer read FPrinterMarginBottom; { Returns the left margin in printer device context's units. } property PrinterMarginLeft: Integer read FPrinterMarginLeft; { Returns the left margin in printer device context's units with respect to current page. } property PrinterMarginLeftMirrored: Integer read FPrinterMarginLeftMirrored; { Returns the right margin in printer device context's units. } property PrinterMarginRight: Integer read FPrinterMarginRight; { Returns the left margin in printer device context's units with respect to current page. } property PrinterMarginRightMirrored: Integer read FPrinterMarginRightMirrored; { Returns the top margin in printer device context's units. } property PrinterMarginTop: Integer read FPrinterMarginTop; { Specifies the printer name. } property PrinterName: string read FPrinterName write SetPrinterName; { Returns the page height in printer device context's pixels. } property PrinterPageHeight: Integer read FPrinterPageHeight; { Returns the page width in printer device context's pixels. } property PrinterPageWidth: Integer read FPrinterPageWidth; { Returns the paint area height in printer device context's units. } property PrinterPaintAreaHeight: Integer read FPrinterPaintAreaHeight; { Returns the paint area width in printer device context's units. } property PrinterPaintAreaWidth: Integer read FPrinterPaintAreaWidth; { Returns the amount of pixels per inch for the printer device context's horizontal axis } property PrinterPixelsPerInchX: Integer read FPrinterPixelsPerInchX; { Returns the amount of pixels per inch for the printer device context's vertical axis } property PrinterPixelsPerInchY: Integer read FPrinterPixelsPerInchY; { Specifies the units for MappedX properties. If True, those extents are given in printer device context's pixels, otherwise in desktop device context's pixels. It can be adjusted by the descendant in the AdjustPageSetup method. } property PrintingMapped: Boolean read FPrintingMapped write SetPrintingMapped; { Specifies the printing range. } property Range: TKPrintRange read FRange write SetRange; { Returns True if the associated control has a selection. } property SelAvail: Boolean read GetSelAvail; { Specifies first page printed if Range is eprRange. } property StartPage: Integer read FStartPage write SetStartPage; { Specifies the requested scale for the printed shape, in percent. If epoFitToPage is specified in Options, this parameter is ignored. } property Scale: Integer read FScale write SetScale; { Specifies the document title as it appears in printer manager. } property Title: string read FTitle write FTitle; { Returns the control paint area width on canvas in Units. } property UnitControlPaintAreaWidth: Double read FUnitControlPaintAreaWidth; { Specifies the horizontal space that should stay free for application specific contents at the left side of printed control. Value is given in Units. } property UnitExtraSpaceLeft: Double read FUnitExtraSpaceLeft write SetUnitExtraSpaceLeft; { Specifies the horizontal space that should stay free for application specific contents at the right side of printed control. Value is given in Units. } property UnitExtraSpaceRight: Double read FUnitExtraSpaceRight write SetUnitExtraSpaceRight; { Specifies the vertical space that should stay free for application specific footer. Value is given in Units. } property UnitFooterSpace: Double read FUnitFooterSpace write SetUnitFooterSpace; { Specifies the vertical space that should stay free for application specific header. Value is given in Units. } property UnitHeaderSpace: Double read FUnitHeaderSpace write SetUnitHeaderSpace; { Specifies the bottom margin. Value is given in Units. } property UnitMarginBottom: Double read FUnitMarginBottom write SetUnitMarginBottom; { Specifies the left margin. Value is given in Units. } property UnitMarginLeft: Double read FUnitMarginLeft write SetUnitMarginLeft; { Specifies the right margin. Value is given in Units. } property UnitMarginRight: Double read FUnitMarginRight write SetUnitMarginRight; { Specifies the top margin. Value is given in Units. } property UnitMarginTop: Double read FUnitMarginTop write SetUnitMarginTop; { Returns the paint area height on canvas in Units. } property UnitPaintAreaHeight: Double read FUnitPaintAreaHeight; { Returns the paint area width on canvas in Units. } property UnitPaintAreaWidth: Double read FUnitPaintAreaWidth; { Specifies the units for print margins. } property Units: TKPrintUnits read FUnits write SetUnits; { Allows to customize measure info filled from associated control just before respective calculations are performed. } property OnPrintMeasure: TKPrintMeasureEvent read FOnPrintMeasure write FOnPrintMeasure; { Allows to inspect settings before printing information is updated. } property OnUpdateSettings: TNotifyEvent read FOnUpdateSettings write FOnUpdateSettings; end; { @abstract(Container for all colors used by @link(TKPrintPreview) class) This container allows to group many colors into one item in object inspector. Colors are accessible via published properties or several public Color* properties. } TKPreviewColors = class(TKCustomColors) protected { Returns color specification structure for given index. } function GetColorSpec(Index: TKColorIndex): TKColorSpec; override; { Returns maximum color index. } function GetMaxIndex: Integer; override; published { Specifies the paper background color. } property Paper: TColor index ciPaper read GetColor write SetColor default cPaperDef; { Specifies the color of the background around paper. } property BkGnd: TColor index ciBkGnd read GetColor write SetColor default cBkGndDef; { Specifies the color of the paper border. } property Border: TColor index ciBorder read GetColor write SetColor default cBorderDef; { Specifies the color of the paper border when the control has input focus. } property SelectedBorder: TColor index ciSelectedBorder read GetColor write SetColor default cSelectedBorderDef; end; { @abstract(Print preview control for the TKCustomControl component) } TKPrintPreview = class(TKCustomControl) private FColors: TKPreviewColors; FControl: TKCustomControl; FMouseWheelAccumulator: Integer; FPage: Integer; FPageOld: Integer; FPageSize: TPoint; FExtent: TPoint; FPageOffset: TPoint; FScale: Integer; FScaleMode: TKPreviewScaleMode; FScrollExtent: TPoint; FScrollPos: TPoint; FScrollPosOld: TPoint; FX: Integer; FY: Integer; FOnChanged: TKPreviewChangedEvent; FPixelsPerInchX: Integer; FPixelsPerInchY: Integer; function GetCurrentScale: Integer; function GetEndPage: Integer; function GetStartPage: Integer; procedure SetColors(const Value: TKPreviewColors); procedure SetControl(Value: TKCustomControl); procedure SetPage(Value: Integer); procedure SetPixelsPerInchX(Value: Integer); procedure SetPixelsPerInchY(Value: Integer); procedure SetScale(Value: Integer); procedure SetScaleMode(Value: TKPreviewScaleMode); procedure WMEraseBkgnd(var Msg: TLMessage); message LM_ERASEBKGND; procedure WMGetDlgCode(var Msg: TLMNoParams); message LM_GETDLGCODE; procedure WMHScroll(var Msg: TLMHScroll); message LM_HSCROLL; procedure WMKillFocus(var Msg: TLMKillFocus); message LM_KILLFOCUS; procedure WMSetFocus(var Msg: TLMSetFocus); message LM_SETFOCUS; procedure WMVScroll(var Msg: TLMVScroll); message LM_VSCROLL; protected FCurrentCanvas: TCanvas; { Initializes a scroll message handling. } procedure BeginScrollWindow; { Defines additional styles. } procedure CreateParams(var Params: TCreateParams); override; { Overriden method - handles mouse wheel messages. } function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean; override; { Calls the ScrollWindowEx function to complete a scroll message. } procedure EndScrollWindow; { Returns current page rectangle inside of the window client area. } function GetPageRect: TRect; { Processes virtual key strokes. } procedure KeyDown(var Key: Word; Shift: TShiftState); override; { Processes scrollbar messages.
    Parameters:
  • ScrollBar - scrollbar type from OS
  • ScrollCode - scrollbar action from OS
  • Delta - scrollbar position change
} procedure ModifyScrollBar(ScrollBar, ScrollCode, Delta: Integer); { Initializes drag&scroll functionality. } procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; { Performs drag&scroll functionality. } procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; { Finalizes drag&scroll functionality. } procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; { Notifies about associated TKCustomControl control removal. } procedure Notification(AComponent: TComponent; Operation: TOperation); override; { Paints paper and control shape. } procedure Paint; override; { Paints the control to given canvas. } procedure PaintToCanvas(ACanvas: TCanvas); override; { Calls the @link(OnChanged) event. } procedure Changed; { Grants the input focus to the control when possible and the control has had none before. } procedure SafeSetFocus; { Updates mouse cursor. } function SetMouseCursor(X, Y: Integer): Boolean; override; { Updates page sizes and scrollbar ranges. } procedure UpdateScrollRange; { Updates the control size. } procedure UpdateSize; override; property CurrentCanvas: TCanvas read FCurrentCanvas; public { Performs necessary initializations - default values to properties. } constructor Create(AOwner: TComponent); override; { Destroy instance... } destructor Destroy; override; { Shows first page for the given range. } procedure FirstPage; { Shows last page for the given range. } procedure LastPage; { Shows next page. } procedure NextPage; { Paints the current page to another canvas, without the top and left space around paper. } procedure PaintTo(ACanvas: TCanvas); { Shows previous page. } procedure PreviousPage; { Updates the preview. } procedure UpdatePreview; { Returns the page scaling with regard to the @link(ScaleMode) property. } property CurrentScale: Integer read GetCurrentScale; { Returns the current page area rectangle in desktop pixels. } property PageRect: TRect read GetPageRect; { Returns the last page for the given range. } property EndPage: Integer read GetEndPage; { Returns the first page for the given range. } property StartPage: Integer read GetStartPage; published { Inherited property - see Delphi help. } property Align; { Inherited property - see Delphi help. } property Anchors; { See TKCustomControl.@link(TKCustomControl.BorderStyle) for details. } property BorderStyle; { Inherited property - see Delphi help. } property BorderWidth; { Specifies all colors used by TKPrintPreview's default painting. } property Colors: TKPreviewColors read FColors write SetColors; { Inherited property - see Delphi help. } property Constraints; { Specifies the associated control. } property Control: TKCustomControl read FControl write SetControl; { Inherited property - see Delphi help. } property DragCursor; { Inherited property - see Delphi help. } property DragKind; { Inherited property - see Delphi help. } property DragMode; { Specifies the currently displayed page. } property Page: Integer read FPage write SetPage default 1; { Inherited property - see Delphi help. } property ParentShowHint; { Inherited property - see Delphi help. } property PopupMenu; { The horizontal DPI at which to show the 100% scaled page. } property PixelsPerInchX: Integer read FPixelsPerInchX write SetPixelsPerInchX default cDPIDef; { The vertical DPI at which to show the 100% scaled page. } property PixelsPerInchY: Integer read FPixelsPerInchY write SetPixelsPerInchY default cDPIDef; { Specifies the user defined page scale - i.e. when ScaleMode = smScale. } property Scale: Integer read FScale write SetScale default 100; { Specifies the scale mode to display and scroll previewed pages. } property ScaleMode: TKPreviewScaleMode read FScaleMode write SetScaleMode default smPageWidth; { Inherited property - see Delphi help. } property ShowHint; { Inherited property - see Delphi help. } property TabStop; { Inherited property - see Delphi help. } property TabOrder; { Inherited property - see Delphi help. } property Visible; { Called whenever print preview is updated. } property OnChanged: TKPreviewChangedEvent read FOnChanged write FOnChanged; { Inherited property - see Delphi help. } property OnClick; { Inherited property - see Delphi help. } property OnContextPopup; { Inherited property - see Delphi help. } property OnDblClick; { Inherited property - see Delphi help. } property OnDockDrop; { Inherited property - see Delphi help. } property OnDockOver; { Inherited property - see Delphi help. } property OnDragDrop; { Inherited property - see Delphi help. } property OnDragOver; { Inherited property - see Delphi help. } property OnEndDock; { Inherited property - see Delphi help. } property OnEndDrag; { Inherited property - see Delphi help. } property OnEnter; { Inherited property - see Delphi help. } property OnExit; { Inherited property - see Delphi help. } property OnGetSiteInfo; { Inherited property - see Delphi help. } property OnKeyDown; { Inherited property - see Delphi help. } property OnKeyPress; { Inherited property - see Delphi help. } property OnKeyUp; { Inherited property - see Delphi help. } property OnMouseDown; {$IFDEF COMPILER9_UP} { Inherited property - see Delphi help. } property OnMouseEnter; { Inherited property - see Delphi help. } property OnMouseLeave; {$ENDIF} { Inherited property - see Delphi help. } property OnMouseMove; { Inherited property - see Delphi help. } property OnMouseUp; { Inherited property - see Delphi help. } property OnMouseWheel; { Inherited property - see Delphi help. } property OnMouseWheelDown; { Inherited property - see Delphi help. } property OnMouseWheelUp; { Inherited property - see Delphi help. } property OnResize; { Inherited property - see Delphi help. } property OnStartDock; { Inherited property - see Delphi help. } property OnStartDrag; { Inherited property - see Delphi help. } property OnUnDock; end; { Under Windows this function calls the WinAPI TrackMouseEvent. Under other OSes the implementation is still missing. } procedure CallTrackMouseEvent(Control: TWinControl; var Status: Boolean); { Center window identified by CenteredWnd with regard to another window BoundWnd. } procedure CenterWindowInWindow(CenteredWnd, BoundWnd: HWnd); { Center window identified by CenteredWnd with regard to main screen. } procedure CenterWindowOnScreen(CenteredWnd: HWnd); { Load clipboard data to AStream in a format specified by AFormat (if any). Loads also AText if clipboard has some data in text format. } function ClipboardLoadStreamAs(const AFormat: TKClipboardFormat; AStream: TStream; var AText: TKString): Boolean; overload; { Load clipboard data to AStream in a format specified by AFormat (if any). Loads also AText if clipboard has some data in text format. } function ClipboardLoadStreamAs(const AFormat: string; AStream: TStream; var AText: TKString): Boolean; overload; { Save data from AStream to clipboard in a format specified by AFormat. Optional AText can be saved in text format. } function ClipboardSaveStreamAs(const AFormat: string; AStream: TStream; const AText: TKString): Boolean; { Enables or disables all children of AParent depending on AEnabled. If ARecursive is True then the function applies to whole tree of controls owned by AParent. } procedure EnableControls(AParent: TWinControl; AEnabled: Boolean; ARecursive: Boolean = True); { Fills the message record. } function FillMessage(Msg: Cardinal; WParam: WPARAM; LParam: LPARAM): TLMessage; { Searches for a child control. Can search recursively. } function FindChildControl(AParent: TWinControl; const AName: string; ARecursive: Boolean = True): TControl; { Returns the Text property of any TWinControl instance as WideString (up to Delphi 2007) or string (Delphi 2009, Lazarus). } function GetControlText(Value: TWinControl): TKString; { Returns current status of Shift, Alt and Ctrl keys. } function GetShiftState: TShiftState; { Converts a value given in inches into a value given in specified units.
    Parameters:
  • Units - measurement units for the output value
  • Value - input value to convert
} function InchesToValue(Units: TKPrintUnits; Value: Double): Double; { Open URL in external browser. } procedure OpenURLWithShell(const AText: TKString); { Converts value given in specified units into a value given in inches.
    Parameters:
  • Units - measurement units for the input value
  • Value - input value to convert
} function ValueToInches(Units: TKPrintUnits; Value: Double): Double; { Under Windows this function calls the WinAPI SetWindowRgn. Under other OSes the implementation is still missing. } procedure SetControlClipRect(AControl: TWinControl; const ARect: TRect); { Modifies the Text property of any TWinControl instance. The value is given as WideString (up to Delphi 2007) or string (Delphi 2009, Lazarus). } procedure SetControlText(Value: TWinControl; const Text: TKString); procedure DPIScaleAllForms(FromDPI: Integer = 96); procedure DPIScaleControl(Control: TControl; FromDPI: Integer = 96); function DPIScaleValue(Value: Int64; FromDPI: Integer = 96): Int64; implementation uses {$IFDEF FPC} {$IFDEF MSWINDOWS}Windows,{$ENDIF} {$ELSE} ShlObj, ShellApi, {$ENDIF} ClipBrd, Math, Types, KGraphics, KMessageBox, KRes; const cPreviewHorzBorder = 30; cPreviewVertBorder = 30; cPreviewShadowSize = 3; procedure CallTrackMouseEvent(Control: TWinControl; var Status: Boolean); {$IFDEF MSWINDOWS} var TE: TTrackMouseEvent; begin if not Status then begin TE.cbSize := SizeOf(TE); TE.dwFlags := TME_LEAVE; TE.hwndTrack := Control.Handle; TE.dwHoverTime := HOVER_DEFAULT; TrackMouseEvent(TE); Status := True; end; end; {$ELSE} begin // This is a TODO for Lazarus team. end; {$ENDIF} procedure CenterWindowOnScreen(CenteredWnd: HWnd); var R: TRect; begin GetWindowRect(CenteredWnd, R); R.Left := Max((Screen.Width - R.Right + R.Left) div 2, 0); R.Top := Max((Screen.Height - R.Bottom + R.Top) div 2, 0); SetWindowPos(CenteredWnd, 0, R.Left, R.Top, 0, 0, SWP_NOSIZE or SWP_NOZORDER); end; procedure CenterWindowInWindow(CenteredWnd, BoundWnd: HWnd); var R1, R2: TRect; begin GetWindowRect(CenteredWnd, R1); GetWindowRect(BoundWnd, R2); R1.Left := Max((R2.Right - R2.Left - R1.Right + R1.Left) div 2, 0); R1.Top := Max((R2.Bottom - R2.Top - R1.Bottom + R1.Top) div 2, 0); SetWindowPos(CenteredWnd, 0, R1.Left, R1.Top, 0, 0, SWP_NOSIZE or SWP_NOZORDER); end; function ClipboardLoadStreamAs(const AFormat: TKClipboardFormat; AStream: TStream; var AText: TKString): Boolean; var Data: HGLOBAL; begin Result := False; {$IFDEF FPC} with Clipboard do begin if (AFormat <> 0) and HasFormat(AFormat) then begin Clipboard.GetFormat(AFormat, AStream); Result := True; end else begin AText := AsText; Result := AText <> ''; end; end; {$ELSE} if AFormat <> 0 then begin Data := 0; try with Clipboard do begin Open; try if HasFormat(AFormat) then begin Data := GetAsHandle(AFormat); if Data <> 0 then begin AStream.Write(GlobalLock(Data)^, GlobalSize(Data)); GlobalUnlock(Data); Result := True; end; end else begin AText := AsText; Result := AText <> ''; end; finally Close; end; end; except GlobalFree(Data); end; end else Clipboard.AsText := AText; {$ENDIF} end; function ClipboardLoadStreamAs(const AFormat: string; AStream: TStream; var AText: TKString): Boolean; begin {$IFDEF FPC} Result := ClipboardLoadStreamAs(RegisterClipboardFormat(AFormat), AStream, AText); {$ELSE} Result := ClipboardLoadStreamAs(RegisterClipboardFormat(PChar(AFormat)), AStream, AText); {$ENDIF} end; function ClipboardSaveStreamAs(const AFormat: string; AStream: TStream; const AText: TKString): Boolean; var Fmt: TKClipboardFormat; Data: HGLOBAL; begin Result := False; {$IFDEF FPC} with Clipboard do begin Clear; AsText := AText; Fmt := RegisterClipboardFormat(AFormat); if Fmt <> 0 then begin AStream.Seek(0, soFromBeginning); AddFormat(Fmt, AStream); Result := True; end; end; {$ELSE} Clipboard.Clear; Fmt := RegisterClipboardFormat(PChar(AFormat)); if Fmt <> 0 then begin Data := GlobalAlloc(GHND or GMEM_SHARE, AStream.Size); if Data <> 0 then try AStream.Seek(0, soFromBeginning); AStream.Read(GlobalLock(Data)^, AStream.Size); GlobalUnlock(Data); with Clipboard do begin Open; try Clipboard.AsText := AText; SetAsHandle(Fmt, Data); finally Close; end; end; Result := True; except GlobalFree(Data); end; end else Clipboard.AsText := AText; {$ENDIF} end; procedure EnableControls(AParent: TWinControl; AEnabled, ARecursive: Boolean); procedure DoEnable(AParent: TWinControl); var I: Integer; begin if AParent <> nil then for I := 0 to AParent.ControlCount - 1 do begin AParent.Controls[I].Enabled := AEnabled; if ARecursive and (AParent.Controls[I] is TWinControl) then DoEnable(TWinControl(AParent.Controls[I])); end; end; begin DoEnable(AParent); end; function FillMessage(Msg: Cardinal; WParam: WPARAM; LParam: LPARAM): TLMessage; begin Result.Msg := Msg; Result.LParam := LParam; Result.WParam := WParam; Result.Result := 0; end; function FindChildControl(AParent: TWinControl; const AName: string; ARecursive: Boolean): TControl; function DoSearch(AParent: TWinControl): TControl; var I: Integer; Ctrl: TControl; begin Result := nil; if AParent <> nil then for I := 0 to AParent.ControlCount - 1 do begin Ctrl := AParent.Controls[I]; if Ctrl.Name = AName then Result := Ctrl else if ARecursive and (Ctrl is TWinControl) then Result := DoSearch(TWinControl(Ctrl)); if Result <> nil then Break; end; end; begin Result := DoSearch(AParent); end; function GetControlText(Value: TWinControl): TKString; function GetTextBuffer(Value: TWinControl): string; begin SetLength(Result, Value.GetTextLen); if Length(Result) > 0 then Value.GetTextBuf(PChar(Result), Length(Result) + 1); end; begin {$IFDEF FPC} Result := GetTextBuffer(Value); // conversion from UTF8 forced anyway {$ELSE} {$IFDEF STRING_IS_UNICODE} Result := GetTextBuffer(Value); {$ELSE} if Value.HandleAllocated and (Win32Platform = VER_PLATFORM_WIN32_NT) then // unicode fully supported begin SetLength(Result, GetWindowTextLengthW(Value.Handle)); GetWindowTextW(Value.Handle, PWideChar(Result), Length(Result) + 1); end else Result := GetTextBuffer(Value); {$ENDIF} {$ENDIF} end; function GetShiftState: TShiftState; begin Result := []; if GetKeyState(VK_SHIFT) < 0 then Include(Result, ssShift); if GetKeyState(VK_CONTROL) < 0 then Include(Result, ssCtrl); if GetKeyState(VK_MENU) < 0 then Include(Result, ssAlt); end; function InchesToValue(Units: TKPrintUnits; Value: Double): Double; begin case Units of puMM: Result := Value * 25.4; puCM: Result := Value * 2.54; puHundredthInch: Result := Value * 100; else Result := Value; end; end; procedure OpenURLWithShell(const AText: TKString); begin {$IFDEF FPC} OpenURL(AText); {$ELSE} ShellExecuteW(Application.MainForm.Handle, 'open', PWideChar(AText), nil, nil, SW_SHOWNORMAL); {$ENDIF} end; procedure SetControlClipRect(AControl: TWinControl; const ARect: TRect); begin if AControl.HandleAllocated then begin {$IFDEF MSWINDOWS} SetWindowRgn(AControl.Handle, CreateRectRgn(0, 0, ARect.Right - ARect.Left, ARect.Bottom - ARect.Top), True); {$ELSE} //how to do that? {$ENDIF} end; end; procedure SetControlText(Value: TWinControl; const Text: TKString); procedure SetTextBuffer(Value: TWinControl; const Text: string); begin Value.SetTextBuf(PChar(Text)); end; begin {$IFDEF FPC} SetTextBuffer(Value, Text); // conversion to UTF8 forced anyway {$ELSE} {$IFDEF STRING_IS_UNICODE} SetTextBuffer(Value, Text); {$ELSE} if Value.HandleAllocated and (Win32Platform = VER_PLATFORM_WIN32_NT) then // unicode fully supported SetWindowTextW(Value.Handle, PWideChar(Text)) else SetTextBuffer(Value, Text); {$ENDIF} {$ENDIF} end; function ValueToInches(Units: TKPrintUnits; Value: Double): Double; begin case Units of puMM: Result := Value / 25.4; puCM: Result := Value / 2.54; puHundredthInch: Result := Value / 100; else Result := Value; end; end; procedure DPIScaleAllForms(FromDPI: Integer); var i: integer; begin {$IFNDEF FPC} {$IFNDEF COMPILER19_UP} if Screen.PixelsPerInch = FromDPI then exit; for i := 0 to Screen.FormCount - 1 do DPIScaleControl(Screen.Forms[i], FromDPI); {$ENDIF} {$ENDIF} end; procedure DPIScaleControl(Control: TControl; FromDPI: Integer); var WinControl: TWinControl; begin {$IFNDEF FPC} {$IFNDEF COMPILER19_UP} if Screen.PixelsPerInch = FromDPI then exit; if Control is TWinControl then begin WinControl := TWinControl(Control); WinControl.ScaleBy(Screen.PixelsPerInch, FromDPI); end; {$ENDIF} {$ENDIF} end; function DPIScaleValue(Value: Int64; FromDPI: Integer): Int64; begin {$IF DEFINED(FPC) OR DEFINED(COMPILER19_UP)} Result := Value; {$ELSE} Result := Value * Screen.PixelsPerInch div FromDPI; {$IFEND} end; { TKRect } constructor TKRect.Create; begin inherited Create; FOnChanged := nil; FBottom := cRectBottomDef; FLeft := cRectLeftDef; FRight := cRectRightDef; FTop := cRectTopDef; end; procedure TKRect.Assign(Source: TPersistent); begin if Source is TKRect then begin Bottom := TKRect(Source).Bottom; Left := TKRect(Source).Left; Right := TKRect(Source).Right; Top := TKRect(Source).Top; end; end; procedure TKRect.AssignFromRect(const ARect: TRect); begin FBottom := ARect.Bottom; FLeft := ARect.Left; FRight := ARect.Right; FTop := ARect.Top; end; procedure TKRect.AssignFromValues(ALeft, ATop, ARight, ABottom: Integer); begin FBottom := ABottom; FLeft := ALeft; FRight := ARight; FTop := ATop; end; procedure TKRect.Changed; begin if Assigned(FOnChanged) then FOnChanged(Self); end; function TKRect.ContainsPoint(const APoint: TPoint): Boolean; begin Result := (FLeft <= APoint.X) and (APoint.X < FRight) and (FTop <= APoint.Y) and (APoint.Y < FBottom); end; function TKRect.EqualProperties(const ARect: TKRect): Boolean; begin Result := (ARect <> nil) and (FLeft = ARect.Left) and (FRight = ARect.Right) and (FTop = ARect.Top) and (FBottom = ARect.Bottom); end; function TKRect.GetHeight: Integer; begin Result := FBottom - FTop; end; function TKRect.GetWidth: Integer; begin Result := FRight - FLeft; end; function TKRect.NonZero: Boolean; begin Result := (FLeft <> 0) or (FTop <> 0) or (FRight <> 0) or (FBottom <> 0); end; function TKRect.OffsetRect(ARect: TKRect): TRect; begin if ARect <> nil then Result := Rect(ARect.Left + FLeft, ARect.Top + FTop, ARect.Right - FRight, ARect.Bottom - FBottom) else Result := CreateEmptyRect; end; function TKRect.OffsetRect(const ARect: TRect): TRect; begin Result := Rect(ARect.Left + FLeft, ARect.Top + FTop, ARect.Right - FRight, ARect.Bottom - FBottom); end; procedure TKRect.SetAll(const Value: Integer); begin Bottom := Value; Left := Value; Right := Value; Top := Value; end; procedure TKRect.SetBottom(const Value: Integer); begin if FBottom <> Value then begin FBottom := Value; Changed; end; end; procedure TKRect.SetLeft(const Value: Integer); begin if FLeft <> Value then begin FLeft := Value; Changed; end; end; procedure TKRect.SetRight(const Value: Integer); begin if FRight <> Value then begin FRight := Value; Changed; end; end; procedure TKRect.SetTop(const Value: Integer); begin if FTop <> Value then begin FTop := Value; Changed; end; end; { TKCustomControl } constructor TKCustomControl.Create(AOwner: TComponent); begin inherited; BorderStyle := cBorderStyleDef; FFlags := 0; FMemoryCanvas := nil; FMessages := nil; {$IFNDEF COMPILER10_UP} FMouseInClient := False; {$ENDIF} FOldClientSize.X := 0; FOldClientSize.Y := 0; FPageSetup := nil; {$IF DEFINED(FPC) OR NOT DEFINED(COMPILER10_UP)} FParentBackground := True; FParentDoubleBuffered := True; {$IFEND} FPreviewList := TList.Create; FUpdateLock := 0; FOnPrintNotify := nil; FOnPrintPaint := nil; end; destructor TKCustomControl.Destroy; begin inherited; FMessages := nil; FreeAndNil(FPreviewList); FreeAndNil(FPageSetup); end; procedure TKCustomControl.AddPreview(APreview: TKPrintPreview); begin if Assigned(APreview) then FPreviewList.Add(APreview); end; procedure TKCustomControl.AdjustPageSetup; begin end; procedure TKCustomControl.CallUpdateSize; var W, H: Integer; begin if HandleAllocated then begin W := ClientWidth; H := ClientHeight; if (FOldClientSize.X <> W) or (FOldClientSize.Y <> H) then begin UpdateSize; FOldClientSize.X := W; FOldClientSize.Y := H; end; end; end; procedure TKCustomControl.CancelMode; begin end; {$IFNDEF FPC} procedure TKCustomControl.CMCancelMode(var Msg: TLMessage); begin inherited; CancelMode; end; procedure TKCustomControl.CMCtl3DChanged(var Msg: TLMessage); begin inherited; RecreateWnd; end; {$ENDIF} procedure TKCustomControl.CMMouseLeave(var Msg: TLMessage); begin inherited; try MouseFormLeave; except end; end; procedure TKCustomControl.CreateHandle; begin inherited; CallUpdateSize; end; procedure TKCustomControl.CreateParams(var Params: TCreateParams); begin inherited; {$IFNDEF FPC} with Params do begin WindowClass.style := CS_DBLCLKS; if BorderStyle = bsSingle then if NewStyleControls and Ctl3D then begin Style := Style and not WS_BORDER; ExStyle := ExStyle or WS_EX_CLIENTEDGE; end else Style := Style or WS_BORDER; end; {$ENDIF} end; {$IFDEF FPC} procedure TKCustomControl.DoOnChangeBounds; begin inherited; if csDesigning in ComponentState then PostLateUpdate(FillMessage(LM_SIZE, 0, 0), True) else CallUpdateSize; end; {$ENDIF} function TKCustomControl.Flag(AFlag: Cardinal): Boolean; begin Result := FFlags and AFlag <> 0; end; procedure TKCustomControl.FlagAssign(AFlag: Cardinal; Value: Boolean); begin if Value then FlagSet(AFlag) else FlagClear(AFlag); end; procedure TKCustomControl.FlagClear(AFlag: Cardinal); begin FFlags := FFlags and not AFlag; end; procedure TKCustomControl.FlagSet(AFlag: Cardinal); begin FFlags := FFlags or AFlag; end; procedure TKCustomControl.FlagToggle(AFlag: Cardinal); begin FFlags := FFlags xor AFlag; end; function TKCustomControl.GetCanPrint: Boolean; begin Result := PageSetup.CanPrint; end; function TKCustomControl.GetPageSetup: TKPrintPageSetup; begin if not Assigned(FPageSetup) and not (csDestroying in ComponentState) then begin FPageSetup := TKPrintPageSetup.Create(Self); AdjustPageSetup; end; if Assigned(FPageSetup) then FPageSetup.Validate; Result := FPageSetup; end; function TKCustomControl.GetPageSetupAllocated: Boolean; begin Result := Assigned(FPageSetup); end; function TKCustomControl.InternalGetSelAvail: Boolean; begin Result := False; end; procedure TKCustomControl.InternalUnlockUpdate; begin end; procedure TKCustomControl.Invalidate; begin if UpdateUnlocked and HandleAllocated then inherited; end; procedure TKCustomControl.InvalidatePageSetup; begin if Assigned(FPageSetup) then FPageSetup.Invalidate; end; procedure TKCustomControl.InvalidateRectArea(const R: TRect); begin if UpdateUnlocked and HandleAllocated then InvalidateRect(Handle, @R, False); end; function TKCustomControl.IsThemed: Boolean; begin Result := True; end; procedure TKCustomControl.KMLateUpdate(var Msg: TLMessage); var M: TLMessage; begin if MessagePeek(M) then LateUpdate(M); end; procedure TKCustomControl.LateUpdate(var Msg: TLMessage); begin case Msg.Msg of LM_SIZE: CallUpdateSize; end; end; procedure TKCustomControl.LockUpdate; begin Inc(FUpdateLock); end; procedure TKCustomControl.MeasurePages(var Info: TKPrintMeasureInfo); begin end; function TKCustomControl.MessagePeek(out Msg: TLMessage): Boolean; var ALen: Integer; begin ALen := Length(FMessages); if ALen > 0 then begin Dec(ALen); Msg := FMessages[ALen]; SetLength(FMessages, ALen); Result := True; end else Result := False; end; procedure TKCustomControl.MessagePoke(const Msg: TLMessage); var ALen: Integer; begin ALen := Length(FMessages); SetLength(FMessages, ALen + 1); FMessages[ALen] := Msg; end; function TKCustomControl.MessageSearch(MsgCode: Cardinal): Boolean; var I: Integer; begin Result := False; for I := 0 to Length(FMessages) - 1 do if FMessages[I].Msg = MsgCode then begin Result := True; Exit; end; end; procedure TKCustomControl.MouseFormLeave; begin end; procedure TKCustomControl.MouseMove(Shift: TShiftState; X, Y: Integer); begin inherited; {$IFNDEF COMPILER10_UP} CallTrackMouseEvent(Self, FMouseInClient); {$ENDIF} {$IFDEF FPC} if not MouseCapture then SetMouseCursor(X, Y); {$ENDIF} end; procedure TKCustomControl.NotifyPreviews; var I: Integer; begin for I := 0 to FPreviewList.Count - 1 do TKPrintPreview(FPreviewList[I]).UpdatePreview; end; procedure TKCustomControl.Paint; begin PaintToCanvas(Canvas); if Assigned(FMemoryCanvas) then begin {$IFDEF MSWINDOWS} // this is the best method but does not work both on QT and GTK! MoveWindowOrg(FMemoryCanvas.Handle, -FMemoryCanvasRect.Left, -FMemoryCanvasRect.Top); try PaintToCanvas(FMemoryCanvas); finally MoveWindowOrg(FMemoryCanvas.Handle, FMemoryCanvasRect.Left, FMemoryCanvasRect.Top); end; {$ELSE} FMemoryCanvas.CopyRect(Rect(0, 0, FMemoryCanvasRect.Right - FMemoryCanvasRect.Left, FMemoryCanvasRect.Bottom - FMemoryCanvasRect.Top), Canvas, FMemoryCanvasRect); {$ENDIF} FMemoryCanvas := nil; end; end; procedure TKCustomControl.PostLateUpdate(const Msg: TLMessage; IfNotExists: Boolean); var MessageExists: Boolean; TmpMsg: tagMSG; begin if HandleAllocated then begin MessageExists := MessageSearch(Msg.Msg); if not MessageExists or not IfNotExists then begin MessagePoke(Msg); PostMessage(Handle, KM_LATEUPDATE, 0, 0); end; // resend lost message if MessageExists and not PeekMessage(TmpMsg, Handle, KM_LATEUPDATE, KM_LATEUPDATE, PM_NOREMOVE) then PostMessage(Handle, KM_LATEUPDATE, 0, 0); end; end; procedure TKCustomControl.PrintNotify(Status: TKPrintStatus; var Abort: Boolean); begin if Assigned(FOnPrintNotify) then FOnPrintNotify(Self, Status, Abort); end; procedure TKCustomControl.PrintPaint; begin if Assigned(FOnPrintPaint) then FOnPrintPaint(Self); end; procedure TKCustomControl.PrintPaintBegin; begin end; procedure TKCustomControl.PrintPaintEnd; begin end; procedure TKCustomControl.PrintOut; begin GetPageSetup.PrintOut; end; procedure TKCustomControl.PaintPage; begin end; procedure TKCustomControl.RemovePreview(APreview: TKPrintPreview); begin if Assigned(FPreviewList) and (FPreviewList.IndexOf(APreview) >= 0) then FPreviewList.Remove(APreview); end; procedure TKCustomControl.Resize; begin inherited; // Needs to be handled in Lazarus as well! // DoOnChangeBounds is not called in LCL when eg. scrollbars change their visibility etc. PostLateUpdate(FillMessage(LM_SIZE, 0, 0), True); end; {$IFNDEF FPC} procedure TKCustomControl.SetBorderStyle(Value: TBorderStyle); begin if FBorderStyle <> Value then begin FBorderStyle := Value; RecreateWnd; end; end; {$ENDIF} function TKCustomControl.SetMouseCursor(X, Y: Integer): Boolean; begin Result := False; end; procedure TKCustomControl.SetPageSetup(Value: TKPrintPageSetup); begin if Value <> FPageSetup then GetPageSetup.Assign(Value); end; procedure TKCustomControl.UnlockUpdate; begin if FUpdateLock > 0 then begin Dec(FUpdateLock); if FUpdateLock = 0 then InternalUnlockUpdate; end; end; procedure TKCustomControl.UpdateSize; begin end; function TKCustomControl.UpdateUnlocked: Boolean; begin Result := FUpdateLock = 0; end; {$IFNDEF FPC} procedure TKCustomControl.WMCancelMode(var Msg: TWMCancelMode); begin inherited; CancelMode; end; {$ENDIF} {$IFNDEF COMPILER10_UP} procedure TKCustomControl.WMMouseLeave(var Msg: TLMessage); begin { this is because of CM_MOUSELEAVE is not sent if mouse has left client area and entered any of the standard control scrollbars. This behavior has been fixed via TrackMouseEvent in BDS 2006. } inherited; FMouseInClient := False; Perform(CM_MOUSELEAVE, 0, 0); end; {$ENDIF} {$IFNDEF FPC} procedure TKCustomControl.WMNCPaint(var Msg: TWMNCPaint); {$IFDEF USE_THEMES} var R: TRect; ExStyle: Integer; TempRgn: HRGN; BorderWidth, BorderHeight: Integer; {$ENDIF} begin {$IFDEF USE_THEMES} with ThemeServices do if IsThemed and ThemesEnabled then begin // If OS themes are enabled and the client edge border is set for the window then prevent the default window proc // from painting the old border to avoid flickering. ExStyle := GetWindowLong(Handle, GWL_EXSTYLE); if (ExStyle and WS_EX_CLIENTEDGE) <> 0 then begin GetWindowRect(Handle, R); // Determine width of the client edge. BorderWidth := GetSystemMetrics(SM_CXEDGE); BorderHeight := GetSystemMetrics(SM_CYEDGE); InflateRect(R, -BorderWidth, -BorderHeight); TempRgn := CreateRectRgnIndirect(R); // Exclude the border from the message region if there is one. Otherwise just use the inflated // window area region. if Msg.Rgn <> 1 then CombineRgn(TempRgn, Msg.Rgn, TempRgn, RGN_AND); DefWindowProc(Handle, Msg.Msg, Integer(TempRgn), 0); DeleteObject(TempRgn); PaintBorder(Self, True); end else inherited; end else {$ENDIF} inherited; end; procedure TKCustomControl.WMSetCursor(var Msg: TWMSetCursor); var MousePt: TPoint; begin if (Msg.HitTest = HTCLIENT) and (Msg.CursorWnd = Handle) then begin MousePt := ScreenToClient(Mouse.CursorPos); if SetMouseCursor(MousePt.X, MousePt.Y) then Msg.Result := 1 else inherited end else inherited; end; {$ENDIF} procedure TKCustomControl.WMSize(var Msg: TLMSize); begin FResizeCalled := False; inherited; {$IFnDEF FPC} if not FResizeCalled then PostLateUpdate(FillMessage(LM_SIZE, 0, 0), True); {$ENDIF} end; {$IFNDEF FPC} {$IFDEF USE_THEMES} procedure TKCustomControl.WMThemeChanged(var Msg: TLMessage); begin if IsThemed then begin inherited; ThemeServices.UpdateThemes; RedrawWindow(Handle, nil, 0, RDW_INVALIDATE or RDW_VALIDATE or RDW_FRAME); end; end; {$ENDIF} {$ENDIF} { TKCustomColors } constructor TKCustomColors.Create(AControl: TKCustomControl); begin inherited Create; FControl := AControl; Initialize; ClearBrightColors; end; procedure TKCustomColors.Assign(Source: TPersistent); begin inherited; if Source is TKCustomColors then begin Colors := TKCustomColors(Source).Colors; FControl.Invalidate; end end; procedure TKCustomColors.ClearBrightColors; var I: TKColorIndex; begin for I := 0 to Length(FBrightColors) - 1 do FBrightColors[I] := clNone; end; function TKCustomColors.GetColor(Index: TKColorIndex): TColor; begin Result := InternalGetColor(Index); end; function TKCustomColors.GetColorData(Index: TKColorIndex): TKColorData; var ColorSpec: TKColorSpec; begin Result.Index := Index; Result.Color := FColors[Index]; ColorSpec := GetColorSpec(Index); Result.Default := ColorSpec.Def; Result.Name := ColorSpec.Name; end; function TKCustomColors.GetColorEx(Index: TKColorIndex): TColor; begin Result := FColors[Index]; end; function TKCustomColors.GetColorName(Index: TKColorIndex): string; begin Result := GetColorSpec(Index).Name; end; function TKCustomColors.GetColorSpec(Index: TKColorIndex): TKColorSpec; begin Result.Def := clNone; Result.Name := ''; end; function TKCustomColors.GetDefaultColor(Index: TKColorIndex): TColor; begin Result := GetColorSpec(Index).Def; end; function TKCustomColors.GetMaxIndex: Integer; begin Result := -1; end; procedure TKCustomColors.Initialize; var I, MaxIndex: TKColorIndex; begin MaxIndex := GetMaxIndex; SetLength(FColors, MaxIndex + 1); SetLength(FBrightColors, MaxIndex + 1); for I := 0 to Length(FColors) - 1 do FColors[I] := GetColorSpec(I).Def; end; function TKCustomColors.InternalGetColor(Index: TKColorIndex): TColor; begin case FColorScheme of csBright: begin if FBrightColors[Index] = clNone then FBrightColors[Index] := BrightColor(FColors[Index], 0.5, bsOfTop); Result := FBrightColors[Index]; end; csGrayScale: Result := ColorToGrayScale(FColors[Index]); else Result := FColors[Index]; end; end; procedure TKCustomColors.InternalSetColor(Index: TKColorIndex; Value: TColor); begin if FColors[Index] <> Value then begin FColors[Index] := Value; FBrightColors[Index] := clNone; if not (csLoading in FControl.ComponentState) then FControl.Invalidate; end; end; procedure TKCustomColors.SetColor(Index: TKColorIndex; Value: TColor); begin InternalSetColor(Index, Value); end; procedure TKCustomColors.SetColorEx(Index: TKColorIndex; Value: TColor); begin if FColors[Index] <> Value then begin FColors[Index] := Value; FBrightColors[Index] := clNone; end; end; procedure TKCustomColors.SetColors(const Value: TKColorArray); var I: Integer; begin for I := 0 to Min(Length(FColors), Length(Value)) - 1 do FColors[I] := Value[I]; ClearBrightColors; end; { TKPrintPageSetup } constructor TKPrintPageSetup.Create(AControl: TKCustomControl); begin inherited Create; FActive := False; FCanvas := nil; FControl := AControl; FControlHorzPageCount := 0; FControlPageCount := 0; FControlVertPageCount := 0; FCopies := cCopiesDef; FCurrentCopy := 0; FCurrentPage := 0; FCurrentScale := 0; FMappedOutlineHeight := 0; FMappedOutlineWidth := 0; FDesktopPixelsPerInchX := 0; FDesktopPixelsPerInchY := 0; FEndPage := 0; FExtraLeftHorzPageCount := 0; FExtraLeftPageCount := 0; FExtraLeftVertPageCount := 0; FExtraRightHorzPageCount := 0; FExtraRightPageCount := 0; FExtraRightVertPageCount := 0; FIsValid := False; FOptions := cOptionsDef; FOrientation := poPortrait; FPageCount := 0; FPreviewing := False; FPrinterExtraSpaceLeft := 0; FPrinterExtraSpaceRight := 0; FPrinterFooterSpace := 0; FPrinterHeaderSpace := 0; FPrinterMarginBottom := 0; FPrinterMarginLeft := 0; FPrinterMarginLeftMirrored := 0; FPrinterMarginRight := 0; FPrinterMarginRightMirrored := 0; FPrinterMarginTop := 0; FPrinterName := ''; FPrinterPageHeight := 0; FPrinterPageWidth := 0; FPrinterPixelsPerInchX := 0; FPrinterPixelsPerInchY := 0; FPrintingMapped := True; FRange := cRangeDef; FStartPage := 0; FScale := cScaleDef; FTitle := ''; FUnitExtraSpaceLeft := 0; FUnitExtraSpaceRight := 0; FUnitFooterSpace := 0; FUnitHeaderSpace := 0; FUnitMarginBottom := cMarginBottomDef; FUnitMarginLeft := cMarginLeftDef; FUnitMarginRight := cMarginRightDef; FUnitMarginTop := cMarginTopDef; FUnitPaintAreaHeight := 0; FUnitPaintAreaWidth := 0; FUnits := cUnitsDef; FValidating := False; FOnPrintMeasure := nil; FOnUpdateSettings := nil; end; function TKPrintPageSetup.GetCanPrint: Boolean; begin Result := Assigned(FControl) and (FPageCount > 0) and (Printer.Printers.Count > 0); end; function TKPrintPageSetup.GetCurrentPageControl: Integer; begin if (FCurrentPage > FExtraLeftPageCount) and (FCurrentPage <= FExtraLeftPageCount + FControlPageCount) then Result := FCurrentPage - FExtraLeftPageCount else Result := 0; // we are in extra left or right area end; function TKPrintPageSetup.GetCurrentPageExtraLeft: Integer; begin if (FCurrentPage > 0) and (FCurrentPage <= FExtraLeftPageCount) then Result := FCurrentPage - FExtraLeftPageCount else Result := 0; // we are in control or extra right area end; function TKPrintPageSetup.GetCurrentPageExtraRight: Integer; begin if FCurrentPage > FExtraLeftPageCount + FControlPageCount then Result := FCurrentPage - FExtraLeftPageCount - FControlPageCount else Result := 0; // we are in control or extra left area end; function TKPrintPageSetup.GetIsDefaultPrinter: Boolean; begin try Result := Printer.PrinterIndex > -MaxInt; except Result := False; end; end; function TKPrintPageSetup.GetSelAvail: Boolean; begin if Assigned(FControl) then Result := FControl.InternalGetSelAvail else Result := False; end; procedure TKPrintPageSetup.AfterUnitsChange; begin FUnitExtraSpaceLeft := InchesToValue(FUnits, FUnitExtraSpaceLeft); FUnitExtraSpaceRight := InchesToValue(FUnits, FUnitExtraSpaceRight); FUnitFooterSpace := InchesToValue(FUnits, FUnitFooterSpace); FUnitHeaderSpace := InchesToValue(FUnits, FUnitHeaderSpace); FUnitMarginBottom := InchesToValue(FUnits, FUnitMarginBottom); FUnitMarginLeft := InchesToValue(FUnits, FUnitMarginLeft); FUnitMarginRight := InchesToValue(FUnits, FUnitMarginRight); FUnitMarginTop := InchesToValue(FUnits, FUnitMarginTop); end; procedure TKPrintPageSetup.Assign(Source: TPersistent); begin if Source is TKPrintPageSetup then begin LockUpdate; try Copies := TKPrintPageSetup(Source).Copies; EndPage := TKPrintPageSetup(Source).EndPage; Options := TKPrintPageSetup(Source).Options; PrinterName := TKPrintPageSetup(Source).PrinterName; Range := TKPrintPageSetup(Source).Range; StartPage := TKPrintPageSetup(Source).StartPage; Scale := TKPrintPageSetup(Source).Scale; Title := TKPrintPageSetup(Source).Title; UnitExtraSpaceLeft := TKPrintPageSetup(Source).UnitExtraSpaceLeft; UnitExtraSpaceRight := TKPrintPageSetup(Source).UnitExtraSpaceRight; UnitFooterSpace := TKPrintPageSetup(Source).UnitFooterSpace; UnitHeaderSpace := TKPrintPageSetup(Source).UnitHeaderSpace; UnitMarginBottom := TKPrintPageSetup(Source).UnitMarginBottom; UnitMarginLeft := TKPrintPageSetup(Source).UnitMarginLeft; UnitMarginRight := TKPrintPageSetup(Source).UnitMarginRight; UnitMarginTop := TKPrintPageSetup(Source).UnitMarginTop; Units := TKPrintPageSetup(Source).Units; OnUpdateSettings := TKPrintPageSetup(Source).OnUpdateSettings; finally UnlockUpdate; end; end; end; procedure TKPrintPageSetup.BeforeUnitsChange; begin FUnitExtraSpaceLeft := ValueToInches(FUnits, FUnitExtraSpaceLeft); FUnitExtraSpaceRight := ValueToInches(FUnits, FUnitExtraSpaceRight); FUnitFooterSpace := ValueToInches(FUnits, FUnitFooterSpace); FUnitHeaderSpace := ValueToInches(FUnits, FUnitHeaderSpace); FUnitMarginBottom := ValueToInches(FUnits, FUnitMarginBottom); FUnitMarginLeft := ValueToInches(FUnits, FUnitMarginLeft); FUnitMarginRight := ValueToInches(FUnits, FUnitMarginRight); FUnitMarginTop := ValueToInches(FUnits, FUnitMarginTop); end; function TKPrintPageSetup.HMap(Value: Integer): Integer; begin Result := MulDiv(Value, FPrinterPixelsPerInchX, FDesktopPixelsPerInchX); end; procedure TKPrintPageSetup.Invalidate; begin FIsValid := False; end; procedure TKPrintPageSetup.PaintPageToPreview(APreview: TKPrintPreview); var PaperWidth, PaperHeight, DesktopPageWidth, DesktopPageHeight, SaveIndex, LeftOffset: Integer; R, PageRect: TRect; begin if UpdateUnlocked and Assigned(FControl) then begin if FActive then Invalidate else begin FCanvas := APreview.CurrentCanvas; FActive := True; FPreviewing := True; try FControl.PrintPaintBegin; FCurrentCopy := 1; FCurrentPage := APreview.Page; if (poMirrorMargins in FOptions) and (FCurrentPage and 1 <> 0) then begin FPrinterMarginLeftMirrored := FPrinterMarginRight; FPrinterMarginRightMirrored := FPrinterMarginLeft; end else begin FPrinterMarginLeftMirrored := FPrinterMarginLeft; FPrinterMarginRightMirrored := FPrinterMarginRight; end; R := APreview.PageRect; PaperWidth := R.Right - R.Left; PaperHeight := R.Bottom - R.Top; if CurrentPageControl > 0 then begin SaveIndex := SaveDC(FCanvas.Handle); try if poFitToPage in FOptions then LeftOffset := FPrinterExtraSpaceLeft else LeftOffset := 0; // change the canvas mapping mode to scale the page outline CanvasSetOffset(FCanvas, R.Left + MulDiv(FPrinterMarginLeftMirrored + LeftOffset, PaperWidth, FPrinterPageWidth), R.Top + MulDiv(FPrinterMarginTop + FPrinterHeaderSpace, PaperHeight, FPrinterPageHeight)); if FPrintingMapped then begin DesktopPageWidth := MulDiv(FPrinterPageWidth, FDesktopPixelsPerInchX, FPrinterPixelsPerInchX); DesktopPageHeight := MulDiv(FPrinterPageHeight, FDesktopPixelsPerInchY, FPrinterPixelsPerInchY); CanvasSetScale(FCanvas, Round(PaperWidth * FCurrentScale), Round(PaperHeight * FCurrentScale), DesktopPageWidth, DesktopPageHeight); end else CanvasSetScale(FCanvas, PaperWidth, PaperHeight, FPrinterPageWidth, FPrinterPageHeight); FControl.PaintPage; finally RestoreDC(FCanvas.Handle, SaveIndex); end; end; PaperWidth := R.Right - R.Left; PaperHeight := R.Bottom - R.Top; SaveIndex := SaveDC(FCanvas.Handle); try CanvasSetOffset(FCanvas, R.Left, R.Top); CanvasSetScale(FCanvas, PaperWidth, PaperHeight, FPrinterPageWidth, FPrinterPageHeight); PageRect := Rect(0, 0, FPrinterPageWidth, FPrinterPageHeight); TranslateRectToDevice(FCanvas.Handle, PageRect); SelectClipRect(FCanvas.Handle, PageRect); FControl.PrintPaint; finally RestoreDC(FCanvas.Handle, SaveIndex); end; SaveIndex := SaveDC(FCanvas.Handle); try CanvasSetOffset(FCanvas, R.Left, R.Top); CanvasSetScale(FCanvas, PaperWidth, PaperHeight, FPrinterPageWidth, FPrinterPageHeight); PageRect := Rect(0, 0, FPrinterPageWidth, FPrinterPageHeight); TranslateRectToDevice(FCanvas.Handle, PageRect); SelectClipRect(FCanvas.Handle, PageRect); PrintTitle; PrintPageNumber(FCurrentPage); finally RestoreDC(FCanvas.Handle, SaveIndex); end; FControl.PrintPaintEnd; finally FActive := False; FPreviewing := False; FCanvas := nil; end; end; end; end; procedure TKPrintPageSetup.PrintPageNumber(Value: Integer); var S: string; begin if poPageNumbers in FOptions then begin SetBkMode(FCanvas.Handle, TRANSPARENT); FCanvas.Brush.Style := bsClear; FCanvas.Font.Color := clBlack; FCanvas.Font.Height := 1; FCanvas.Font.Height := VMap(16); FCanvas.Font.Name := 'Arial'; FCanvas.Font.Pitch := fpDefault; FCanvas.Font.Style := [fsBold]; S := Format('- %d -', [Value]); FCanvas.TextOut(FPrinterMarginLeftMirrored + (FPrinterPageWidth - FPrinterMarginLeft - FPrinterMarginRight - FCanvas.TextWidth(S)) div 2, FPrinterPageHeight - FPrinterMarginBottom + VMap(5), S); end; end; procedure TKPrintPageSetup.PrintTitle; begin if poTitle in FOptions then begin SetBkMode(FCanvas.Handle, TRANSPARENT); FCanvas.Brush.Style := bsClear; FCanvas.Font.Color := clBlack; FCanvas.Font.Height := 1; FCanvas.Font.Height := VMap(16); FCanvas.Font.Name := 'Arial'; FCanvas.Font.Pitch := fpDefault; FCanvas.Font.Style := [fsBold]; FCanvas.TextOut(FPrinterMarginLeftMirrored, FPrinterMarginTop - VMap(36), Title); FCanvas.Brush.Style := bsSolid; FCanvas.Brush.Color := clBlack; FCanvas.FillRect(Rect(FPrinterMarginLeftMirrored, FPrinterMarginTop - VMap(14), FPrinterPageWidth - FPrinterMarginRight, FPrinterMarginTop - VMap(12))); end; end; procedure TKPrintPageSetup.PrintOut; function DoPrint: Boolean; var LeftOffset, SaveIndex: Integer; PageRect: TRect; begin Result := False; if (poMirrorMargins in FOptions) and (FCurrentPage and 1 <> 0) then begin FPrinterMarginLeftMirrored := FPrinterMarginRight; FPrinterMarginRightMirrored := FPrinterMarginLeft; end else begin FPrinterMarginLeftMirrored := FPrinterMarginLeft; FPrinterMarginRightMirrored := FPrinterMarginRight; end; if CurrentPageControl > 0 then begin SaveIndex := SaveDC(FCanvas.Handle); try if poFitToPage in FOptions then LeftOffset := FPrinterExtraSpaceLeft else LeftOffset := 0; CanvasSetOffset(FCanvas, FPrinterMarginLeftMirrored + LeftOffset, FPrinterMarginTop + FPrinterHeaderSpace); if FPrintingMapped then begin // change the canvas mapping mode to scale the page outline CanvasSetScale(FCanvas, Round(FPrinterPageWidth * FCurrentScale), Round(FPrinterPageHeight * FCurrentScale), MulDiv(FPrinterPageWidth, FDesktopPixelsPerInchX, FPrinterPixelsPerInchX), MulDiv(FPrinterPageHeight, FDesktopPixelsPerInchY, FPrinterPixelsPerInchY)); end else CanvasResetScale(FCanvas); FControl.PaintPage; finally RestoreDC(FCanvas.Handle, SaveIndex); end; end; SaveIndex := SaveDC(FCanvas.Handle); try CanvasResetScale(FCanvas); PageRect := Rect(0, 0, FPrinterPageWidth, FPrinterPageHeight); TranslateRectToDevice(FCanvas.Handle, PageRect); SelectClipRect(FCanvas.Handle, PageRect); FControl.PrintPaint; finally RestoreDC(FCanvas.Handle, SaveIndex); end; SaveIndex := SaveDC(FCanvas.Handle); try CanvasResetScale(FCanvas); PageRect := Rect(0, 0, FPrinterPageWidth, FPrinterPageHeight); TranslateRectToDevice(FCanvas.Handle, PageRect); SelectClipRect(FCanvas.Handle, PageRect); PrintTitle; PrintPageNumber(FCurrentPage); finally RestoreDC(FCanvas.Handle, SaveIndex); end; FControl.PrintNotify(epsNewPage, Result); if ((FCurrentPage < FEndPage) or (FCurrentCopy < FCopies)) and not Result then Printer.NewPage; end; var I, J, PrinterCount: Integer; AbortPrint: Boolean; { Orientation: TPrinterOrientation; PaperSize: TPaperSize; APageWidth, ApageHeight, APaperWidth, APaperHeight: Integer; PrinterType: TPrinterType; APaperRect: TPaperRect;} begin if UpdateUnlocked and Assigned(FControl) and not FActive then begin UpdateSettings; if FPageCount > 0 then begin if IsDefaultPrinter then begin PrinterCount := 0; try AbortPrint := False; PrinterCount := Printer.Printers.Count; Printer.Title := FTitle; Printer.Copies := 1; { PrinterType := Printer.PrinterType; APageWidth := Printer.PageWidth; APageHeight := Printer.PageHeight; APaperRect := Printer.PaperSize.PaperRect; Orientation := Printer.Orientation;} Printer.BeginDoc; FActive := True; try FCanvas := Printer.Canvas; FControl.PrintNotify(epsBegin, AbortPrint); { Printer.Canvas.Font.Name := 'Arial'; Printer.Canvas.Font.color := clBlack; Printer.Canvas.Font.height := 100; Printer.Canvas.TextOut(200, 200, 'hello!');} if not AbortPrint then begin FControl.PrintPaintBegin; try if poCollate in FOptions then for I := 1 to FCopies do begin FCurrentCopy := I; for J := FStartPage to FEndPage do begin FCurrentPage := J; AbortPrint := DoPrint; if AbortPrint then Break; end; if AbortPrint then Break; end else for J := FStartPage to FEndPage do begin FCurrentPage := J; for I := 1 to FCopies do begin FCurrentCopy := I; AbortPrint := DoPrint; if AbortPrint then Break; end; if AbortPrint then Break; end finally FControl.PrintPaintEnd; end; end; FCurrentPage := 0; FCurrentCopy := 0; FControl.PrintNotify(epsEnd, AbortPrint); finally FActive := False; Printer.EndDoc; FCanvas := nil; end; except if PrinterCount = 0 then KMsgBox(sPSErrPrintSetup, sPSErrNoPrinterInstalled, [mbOk], miStop) else KMsgBox(sPSErrPrintSetup, sPSErrPrinterUnknown, [mbOk], miStop); end; end else KMsgBox(sPSErrPrintSetup, sPSErrNoDefaultPrinter, [mbOk], miStop); end; end; end; procedure TKPrintPageSetup.SetCopies(Value: Integer); begin if FActive then Exit; if Value <> FCopies then begin FCopies := Value; Changed; end; end; procedure TKPrintPageSetup.SetEndPage(Value: Integer); begin if FActive then Exit; if Value <> FEndPage then begin FEndPage := Value; Changed; end; end; procedure TKPrintPageSetup.SetOptions(Value: TKPrintOptions); begin if FActive then Exit; if Value <> FOptions then begin FOptions := Value; Changed; end; end; procedure TKPrintPageSetup.SetOrientation(AValue: TPrinterOrientation); begin if AValue <> FOrientation then begin FOrientation := AValue; Changed; end; end; procedure TKPrintPageSetup.SetPrinterName(const Value: string); begin if FActive then Exit; if Value <> FPrinterName then begin FPrinterName := Value; Changed; end; end; procedure TKPrintPageSetup.SetPrintingMapped(Value: Boolean); begin if FActive then Exit; if Value <> FPrintingMapped then begin FPrintingMapped := Value; Changed; end; end; procedure TKPrintPageSetup.SetRange(Value: TKPrintRange); begin if FActive then Exit; if Value <> FRange then begin FRange := Value; Changed; end; end; procedure TKPrintPageSetup.SetScale(Value: Integer); begin if FActive then Exit; if Value <> FScale then begin FScale := Value; Changed; end; end; procedure TKPrintPageSetup.SetStartPage(Value: Integer); begin if FActive then Exit; if Value <> FStartPage then begin FStartPage := Value; Changed; end; end; procedure TKPrintPageSetup.SetUnitExtraSpaceLeft(Value: Double); begin if FActive then Exit; if Value <> FUnitExtraSpaceLeft then begin FUnitExtraSpaceLeft := Value; Changed; end; end; procedure TKPrintPageSetup.SetUnitExtraSpaceRight(Value: Double); begin if FActive then Exit; if Value <> FUnitExtraSpaceRight then begin FUnitExtraSpaceRight := Value; Changed; end; end; procedure TKPrintPageSetup.SetUnitFooterSpace(Value: Double); begin if FActive then Exit; if Value <> FUnitFooterSpace then begin FUnitFooterSpace := Value; Changed; end; end; procedure TKPrintPageSetup.SetUnitHeaderSpace(Value: Double); begin if FActive then Exit; if Value <> FUnitHeaderSpace then begin FUnitHeaderSpace := Value; Changed; end; end; procedure TKPrintPageSetup.SetUnitMarginBottom(Value: Double); begin if FActive then Exit; if Value <> FUnitMarginBottom then begin FUnitMarginBottom := Value; Changed; end; end; procedure TKPrintPageSetup.SetUnitMarginLeft(Value: Double); begin if FActive then Exit; if Value <> FUnitMarginLeft then begin FUnitMarginLeft := Value; Changed; end; end; procedure TKPrintPageSetup.SetUnitMarginRight(Value: Double); begin if FActive then Exit; if Value <> FUnitMarginRight then begin FUnitMarginRight := Value; Changed; end; end; procedure TKPrintPageSetup.SetUnitMarginTop(Value: Double); begin if FActive then Exit; if Value <> FUnitMarginTop then begin FUnitMarginTop := Value; Changed; end; end; procedure TKPrintPageSetup.SetUnits(Value: TKPrintUnits); begin if FActive then Exit; if Value <> FUnits then begin BeforeUnitsChange; FUnits := Value; AfterUnitsChange; end; end; procedure TKPrintPageSetup.Update; begin UpdateSettings; end; procedure TKPrintPageSetup.UpdateSettings; var I, PixelsPerInchX, PixelsPerInchY: Integer; D: Double; DC: HDC; Info: TKPrintMeasureInfo; begin if UpdateUnlocked and not FActive and not FValidating then begin FValidating := True; try if Assigned(FOnUpdateSettings) then FOnUpdateSettings(Self); // limit copies and Scale FCopies := MinMax(FCopies, cCopiesMin, cCopiesMax); FScale := MinMax(FScale, cScaleMin, cScaleMax); // get metrics for the desktop DC := GetDC(0); try FDesktopPixelsPerInchX := GetDeviceCaps(DC, LOGPIXELSX); FDesktopPixelsPerInchY := GetDeviceCaps(DC, LOGPIXELSY); finally ReleaseDC(0, DC); end; // Printer.Refresh; // default printer metrics if no printer is installed FOrientation := poPortrait; FPrinterPageWidth := 2360; FPrinterPageHeight := 3400; FPrinterPixelsPerInchX := 300; FPrinterPixelsPerInchY := 300; // get printer data try if IsDefaultPrinter then begin I := Printer.Printers.IndexOf(FPrinterName); if I >= 0 then Printer.PrinterIndex := I; // set orientation in case somebody assigned it programmatically try Printer.Orientation := FOrientation; except FOrientation := Printer.Orientation; end; // get metrics for the printer if Printer.Printers.Count > 0 then begin FPrinterPageWidth := Printer.PageWidth; FPrinterPageHeight := Printer.PageHeight; {$IFDEF FPC} FPrinterPixelsPerInchX := Printer.XDPI; FPrinterPixelsPerInchY := Printer.YDPI; {$ELSE} FPrinterPixelsPerInchX := GetDeviceCaps(Printer.Handle, LOGPIXELSX); FPrinterPixelsPerInchY := GetDeviceCaps(Printer.Handle, LOGPIXELSY); {$ENDIF} end end; except // silent, keep default or successfully obtained data end; // decide how to outline extent if FPrintingMapped then begin PixelsPerInchX := FDesktopPixelsPerInchX; PixelsPerInchY := FDesktopPixelsPerInchY; end else begin PixelsPerInchX := FPrinterPixelsPerInchX; PixelsPerInchY := FPrinterPixelsPerInchY; end; FMappedPageHeight := MulDiv(FPrinterPageHeight, PixelsPerInchX, FPrinterPixelsPerInchX); FMappedPageWidth := MulDiv(FPrinterPageWidth, PixelsPerInchX, FPrinterPixelsPerInchX); // limit and convert margins D := FPrinterPageWidth * 0.4; // 40% of the page FPrinterMarginLeft := Round(MinMax(ValueToInches(FUnits, FUnitMarginLeft) * FPrinterPixelsPerInchX, 0, D)); FUnitMarginLeft := InchesToValue(FUnits, FPrinterMarginLeft / FPrinterPixelsPerInchX); FMappedMarginLeft := MulDiv(FPrinterMarginLeft, PixelsPerInchX, FPrinterPixelsPerInchX); FPrinterMarginLeftMirrored := FPrinterMarginLeft; FMappedMarginLeftMirrored := FMappedMarginLeft; FPrinterMarginRight := Round(MinMax(ValueToInches(FUnits, FUnitMarginRight) * FPrinterPixelsPerInchX, 0, D)); FUnitMarginRight := InchesToValue(FUnits, FPrinterMarginRight / FPrinterPixelsPerInchX); FMappedMarginRight := MulDiv(FPrinterMarginRight, PixelsPerInchX, FPrinterPixelsPerInchX); FPrinterMarginRightMirrored := FPrinterMarginRight; FMappedMarginRightMirrored := FMappedMarginRight; D := FPrinterPageHeight * 0.4; // 40% of the page FPrinterMarginTop := Round(MinMax(ValueToInches(FUnits, FUnitMarginTop) * FPrinterPixelsPerInchY, 0, D)); FUnitMarginTop := InchesToValue(FUnits, FPrinterMarginTop / FPrinterPixelsPerInchY); FMappedMarginTop := MulDiv(FPrinterMarginTop, PixelsPerInchX, FPrinterPixelsPerInchX); FPrinterMarginBottom := Round(MinMax(ValueToInches(FUnits, FUnitMarginBottom) * FPrinterPixelsPerInchY, 0, D)); FUnitMarginBottom := InchesToValue(FUnits, FPrinterMarginBottom / FPrinterPixelsPerInchY); FMappedMarginBottom := MulDiv(FPrinterMarginBottom, PixelsPerInchX, FPrinterPixelsPerInchX); // limit and convert header and footer space FPrinterHeaderSpace := Round(MinMax(ValueToInches(FUnits, Max(FUnitHeaderSpace, 0)) * FPrinterPixelsPerInchY, 0, D - FPrinterMarginTop)); FUnitHeaderSpace := InchesToValue(FUnits, FPrinterHeaderSpace / FPrinterPixelsPerInchY); FMappedHeaderSpace := MulDiv(FPrinterHeaderSpace, PixelsPerInchX, FPrinterPixelsPerInchX); FPrinterFooterSpace := Round(MinMax(ValueToInches(FUnits, Max(FUnitFooterSpace, 0)) * FPrinterPixelsPerInchY, 0, D - FPrinterMarginBottom)); FUnitFooterSpace := InchesToValue(FUnits, FPrinterFooterSpace / FPrinterPixelsPerInchY); FMappedFooterSpace := MulDiv(FPrinterFooterSpace, PixelsPerInchX, FPrinterPixelsPerInchX); // limit and convert extra space FPrinterExtraSpaceLeft := Round(ValueToInches(FUnits, Max(FUnitExtraSpaceLeft, 0)) * FPrinterPixelsPerInchX); FUnitExtraSpaceLeft := InchesToValue(FUnits, FPrinterExtraSpaceLeft / FPrinterPixelsPerInchX); FMappedExtraSpaceLeft := MulDiv(FPrinterExtraSpaceLeft, PixelsPerInchX, FPrinterPixelsPerInchX); FPrinterExtraSpaceRight := Round(ValueToInches(FUnits, Max(FUnitExtraSpaceRight, 0)) * FPrinterPixelsPerInchX); FUnitExtraSpaceRight := InchesToValue(FUnits, FPrinterExtraSpaceRight / FPrinterPixelsPerInchX); FMappedExtraSpaceRight := MulDiv(FPrinterExtraSpaceRight, PixelsPerInchX, FPrinterPixelsPerInchX); // paint area extent FPrinterPaintAreaHeight := FPrinterPageHeight - FPrinterMarginTop - FPrinterMarginBottom - FPrinterHeaderSpace - FPrinterFooterSpace; FUnitPaintAreaHeight := InchesToValue(FUnits, FPrinterPaintAreaHeight / FPrinterPixelsPerInchY); FMappedPaintAreaHeight := MulDiv(FPrinterPaintAreaHeight, PixelsPerInchY, FPrinterPixelsPerInchY); FPrinterPaintAreaWidth := FPrinterPageWidth - FPrinterMarginLeft - FPrinterMarginRight; FUnitPaintAreaWidth := InchesToValue(FUnits, FPrinterPaintAreaWidth / FPrinterPixelsPerInchX); FMappedPaintAreaWidth := MulDiv(FPrinterPaintAreaWidth, PixelsPerInchX, FPrinterPixelsPerInchX); // control paint area extent FPrinterControlPaintAreaWidth := FPrinterPaintAreaWidth; if poFitToPage in FOptions then Dec(FPrinterControlPaintAreaWidth, FPrinterExtraSpaceLeft + FPrinterExtraSpaceRight); FUnitControlPaintAreaWidth := InchesToValue(FUnits, FPrinterControlPaintAreaWidth / FPrinterPixelsPerInchX); FMappedControlPaintAreaWidth := MulDiv(FPrinterControlPaintAreaWidth, PixelsPerInchX, FPrinterPixelsPerInchX); // default horizontal scaling FCurrentScale := FScale / 100; // default page/copy info FCurrentCopy := 0; FCurrentPage := 0; // measured data if Assigned(FControl) then begin FillChar(Info, SizeOf(TKPrintMeasureInfo), 0); FControl.MeasurePages(Info); if Assigned(FOnPrintMeasure) then FOnPrintMeasure(Self, Info); FMappedOutlineWidth := Info.OutlineWidth; FMappedOutlineHeight := Info.OutlineHeight; FExtraLeftHorzPageCount := Info.ExtraLeftHorzPageCount; FExtraLeftVertPageCount := Info.ExtraLeftVertPageCount; FExtraLeftPageCount := FExtraLeftHorzPageCount * FExtraLeftVertPageCount; FExtraRightHorzPageCount := Info.ExtraRightHorzPageCount; FExtraRightVertPageCount := Info.ExtraRightVertPageCount; FExtraRightPageCount := FExtraRightHorzPageCount * FExtraRightVertPageCount; FControlHorzPageCount := Info.ControlHorzPageCount; FControlVertPageCount := Info.ControlVertPageCount; FControlPageCount := FControlHorzPageCount * FControlVertPageCount; FPageCount := FExtraLeftPageCount + FControlPageCount + FExtraRightPageCount; if FPageCount > 0 then begin // update horizontal scaling if (poFitToPage in FOptions) and (FMappedOutlineWidth > 0) then FCurrentScale := FMappedControlPaintAreaWidth / FMappedOutlineWidth; // limit start and end page case FRange of prAll, prSelectedOnly: begin FStartPage := 1; FEndPage := FPageCount; end; prRange: begin FEndPage := MinMax(FEndPage, 1, FPageCount); FStartPage := MinMax(FStartPage, 1, FEndPage); end; end; end; // notify all previews/ force their repainting FControl.NotifyPreviews; end else begin FMappedOutlineWidth := 0; FMappedOutlineHeight := 0; FExtraLeftHorzPageCount := 0; FExtraLeftVertPageCount := 0; FExtraRightHorzPageCount := 0; FExtraRightVertPageCount := 0; FControlHorzPageCount := 0; FControlVertPageCount := 0; FPageCount := 0; FEndPage := 0; FStartPage := 0; end; FIsValid := True; finally FValidating := False; end; end; end; procedure TKPrintPageSetup.Validate; begin if not FIsValid and not FValidating then UpdateSettings; end; function TKPrintPageSetup.VMap(Value: Integer): Integer; begin Result := MulDiv(Value, FPrinterPixelsPerInchY, FDesktopPixelsPerInchY); end; { TKPreviewColors } function TKPreviewColors.GetColorSpec(Index: TKColorIndex): TKColorSpec; begin case Index of ciPaper: begin Result.Def := cPaperDef; Result.Name := ''; end; ciBkGnd: begin Result.Def := cBkGndDef; Result.Name := ''; end; ciBorder: begin Result.Def := cBorderDef; Result.Name := ''; end; ciSelectedBorder: begin Result.Def := cSelectedBorderDef; Result.Name := ''; end; else Result := inherited GetColorSpec(Index); end; end; function TKPreviewColors.GetMaxIndex: Integer; begin Result := ciPreviewColorsMax; end; { TKPrintPreview } constructor TKPrintPreview.Create(AOwner: TComponent); begin inherited; FColors := TKPreviewColors.Create(Self); FControl := nil; FCurrentCanvas := Canvas; FMouseWheelAccumulator := 0; FPage := 1; FPageSize := CreateEmptyPoint; FPixelsPerInchX := cDPIDef; FPixelsPerInchY := cDPIDef; FScale := 100; FScaleMode := smPageWidth; FOnChanged := nil; LoadCustomCursor(crDragHandFree, 'KPREVIEW_CURSOR_HAND_FREE'); LoadCustomCursor(crDragHandGrip, 'KPREVIEW_CURSOR_HAND_GRIP'); Width := 300; Height := 200; end; destructor TKPrintPreview.Destroy; begin if Assigned(FControl) then FControl.RemovePreview(Self); inherited; FColors.Free; end; procedure TKPrintPreview.BeginScrollWindow; begin FPageOld := FPage; FScrollPosOld := FScrollPos; end; procedure TKPrintPreview.CreateParams(var Params: TCreateParams); begin inherited; with Params do Style := Style or WS_HSCROLL or WS_VSCROLL; end; function TKPrintPreview.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean; const cWheelDivisor = 120; var Delta, WheelClicks: Integer; begin Result := inherited DoMouseWheel(Shift, WheelDelta, MousePos); if not Result then begin if ssCtrl in Shift then begin if FScaleMode = smWholePage then Delta := 10 else Delta := ClientHeight; end else if FScaleMode = smWholePage then Delta := 1 else Delta := ClientHeight div 10; Inc(FMouseWheelAccumulator, WheelDelta); WheelClicks := FMouseWheelAccumulator div cWheelDivisor; FMouseWheelAccumulator := FMouseWheelAccumulator mod cWheelDivisor; BeginScrollWindow; ModifyScrollBar(SB_VERT, cScrollDelta, -WheelClicks * Delta); EndScrollWindow; Result := True; end; end; procedure TKPrintPreview.EndScrollWindow; begin if (FPage <> FPageOld) then Invalidate else if (FScrollPos.X <> FScrollPosOld.X) or (FScrollPos.Y <> FScrollPosOld.Y) then begin ScrollWindowEx(Handle, FScrollPosOld.X - FScrollPos.X, FScrollPosOld.Y - FScrollPos.Y, nil, nil, 0, nil, SW_INVALIDATE); end; end; procedure TKPrintPreview.FirstPage; begin Page := StartPage; end; function TKPrintPreview.GetCurrentScale: Integer; begin if Assigned(FControl) then Result := MulDiv(FPageSize.X, 100, MulDiv(FControl.PageSetup.PrinterPageWidth, 300, FControl.PageSetup.PrinterPixelsPerInchX)) else Result := FScale; end; function TKPrintPreview.GetEndPage: Integer; begin if Assigned(FControl) then begin Result := FControl.PageSetup.EndPage; if Result = 0 then begin FControl.PageSetup.UpdateSettings; Result := FControl.PageSetup.EndPage end; end else Result := 0; end; function TKPrintPreview.GetPageRect: TRect; begin with Result do begin Left := FPageOffset.X - FScrollPos.X; if FScaleMode = smWholePage then Top := FPageOffset.Y else Top := FPageOffset.Y - FScrollPos.Y; Right := Left + FPageSize.X; Bottom := Top + FPageSize.Y; end; end; function TKPrintPreview.GetStartPage: Integer; begin if Assigned(FControl) then begin Result := FControl.PageSetup.StartPage; if Result = 0 then begin FControl.PageSetup.UpdateSettings; Result := FControl.PageSetup.StartPage end; end else Result := 0; end; procedure TKPrintPreview.KeyDown(var Key: Word; Shift: TShiftState); var DeltaX, DeltaY, LineX, PageY: Integer; NoAlt, NoAltCtrl: Boolean; begin NoAlt := Shift * [ssAlt] = []; NoAltCtrl := Shift * [ssAlt, ssCtrl] = []; DeltaX := 0; DeltaY := 0; LineX := ClientWidth div 10; PageY := ClientHeight; case Key of VK_UP: if NoAltCtrl then begin if FScaleMode = smWholePage then PreviousPage else DeltaY := -PageY div 10; end; VK_DOWN: if NoAltCtrl then begin if FScaleMode = smWholePage then NextPage else DeltaY := PageY div 10; end; VK_PRIOR: if NoAltCtrl then begin if FScaleMode = smWholePage then PreviousPage else DeltaY := -PageY; end; VK_NEXT: if NoAltCtrl then begin if FScaleMode = smWholePage then NextPage else DeltaY := PageY; end; VK_LEFT: if NoAltCtrl then DeltaX := -LineX; VK_RIGHT: if NoAltCtrl then DeltaX := LineX; VK_HOME: if NoAlt then begin if ssCtrl in Shift then FirstPage else DeltaX := -FScrollPos.X; end; VK_END: if NoAlt then begin if ssCtrl in Shift then LastPage else DeltaX := FScrollExtent.X - FScrollPos.X; end; end; if (DeltaX <> 0) or (DeltaY <> 0) then begin BeginScrollWindow; if DeltaX <> 0 then ModifyScrollBar(SB_HORZ, cScrollDelta, DeltaX); if DeltaY <> 0 then ModifyScrollBar(SB_VERT, cScrollDelta, DeltaY); EndScrollWindow; end; end; procedure TKPrintPreview.LastPage; begin Page := EndPage; end; procedure TKPrintPreview.ModifyScrollBar(ScrollBar, ScrollCode, Delta: Integer); var I, AEndPage: Integer; Divisor: Cardinal; PPos, PExtent: PInteger; SI: TScrollInfo; begin Divisor := 10; if ScrollBar = SB_HORZ then begin PPos := @FScrollPos.X; PExtent := @FScrollExtent.X; end else begin if FScaleMode = smWholePage then begin PPos := @FPage; AEndPage := EndPage; PExtent := @AEndPage; Divisor := 1; end else begin PPos := @FScrollPos.Y; PExtent := @FScrollExtent.Y; end; end; if PExtent^ > 0 then begin SI.cbSize := SizeOf(TScrollInfo); SI.fMask := SIF_RANGE or SIF_PAGE or SIF_TRACKPOS; GetScrollInfo(Handle, ScrollBar, SI); {$IFDEF UNIX} SI.nTrackPos := Delta; {$ENDIF} I := PPos^; case ScrollCode of SB_TOP: I := SI.nMin; SB_BOTTOM: I := SI.nMax; // will be trimmed below SB_LINEUP: Dec(I, SI.nPage div Divisor); SB_LINEDOWN: Inc(I, SI.nPage div Divisor); SB_PAGEUP: Dec(I, SI.nPage); SB_PAGEDOWN: Inc(I, SI.nPage); SB_THUMBTRACK, SB_THUMBPOSITION: I := SI.nTrackPos; cScrollDelta: Inc(I, Delta); end; if FScaleMode = smWholePage then I := MinMax(I, 1, PExtent^) else I := MinMax(I, 0, PExtent^); PPos^ := I; SI.nPos := I; SI.fMask := SIF_POS; SetScrollInfo(Handle, ScrollBar, SI, True); end; end; procedure TKPrintPreview.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin inherited; if ssLeft in Shift then begin SafeSetFocus; if (FScaleMode <> smWholePage) and PtInRect(GetPageRect, Point(X, Y)) then begin FlagSet(cPF_Dragging); FX := X; FY := Y; SetMouseCursor(X, Y); end; end; end; procedure TKPrintPreview.MouseMove(Shift: TShiftState; X, Y: Integer); begin inherited; if Flag(cPF_Dragging) and MouseCapture then begin BeginScrollWindow; if (X > FX) and (FScrollPos.X > 0) or (X < FX) and (FScrollPos.X < FScrollExtent.X) then begin ModifyScrollBar(SB_HORZ, cScrollDelta, FX - X); FX := X; end; if (Y > FY) and (FScrollPos.Y > 0) or (Y < FY) and (FScrollPos.Y < FScrollExtent.Y) then begin ModifyScrollBar(SB_VERT, cScrollDelta, FY - Y); FY := Y; end; EndScrollWindow; end; end; procedure TKPrintPreview.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin inherited; FlagClear(cPF_Dragging); SetMouseCursor(X, Y); end; procedure TKPrintPreview.NextPage; begin Page := Page + 1; end; procedure TKPrintPreview.Notification(AComponent: TComponent; Operation: TOperation); begin inherited; if (Operation = opRemove) and (AComponent = FControl) then begin FControl := nil; UpdatePreview; end; end; procedure TKPrintPreview.PaintToCanvas(ACanvas: TCanvas); procedure DoPaint(IsBuffer: Boolean); var C: TColor; R, RPaper, RPage: TRect; RgnPaper: HRGN; begin ACanvas.Brush.Style := bsSolid; ACanvas.Pen.Mode := pmCopy; ACanvas.Pen.Style := psSolid; ACanvas.Pen.Width := 1; RPage := GetPageRect; RPaper := RPage; with RPaper do begin Inc(Right, cPreviewShadowSize); Inc(Bottom, cPreviewShadowSize); end; if not IsBuffer then RgnPaper := CreateRectRgnIndirect(RPaper) else RgnPaper := 0; try // paint background around paper, we don't want at least this to flicker if IsBuffer or (ExtSelectClipRgn(ACanvas.Handle, RgnPaper, RGN_DIFF) <> NULLREGION) then begin ACanvas.Brush.Color := FColors.BkGnd; ACanvas.FillRect(ClientRect); end; if not IsBuffer then SelectClipRgn(ACanvas.Handle, RgnPaper); finally if not IsBuffer then DeleteObject(rgnPaper); end; // paint paper outline if Focused then C := FColors.SelectedBorder else C := FColors.Border; ACanvas.Pen.Color := C; ACanvas.Brush.Color := FColors.Paper; ACanvas.Rectangle(RPage); ACanvas.Brush.Color := FColors.BkGnd; R := Rect(RPage.Left, RPage.Bottom, RPage.Left + cPreviewShadowSize, RPage.Bottom + cPreviewShadowSize); ACanvas.FillRect(R); R := Rect(RPage.Right, RPage.Top, RPage.Right + cPreviewShadowSize, RPage.Top + cPreviewShadowSize); ACanvas.FillRect(R); ACanvas.Brush.Color := C; R := Rect(RPage.Left + cPreviewShadowSize, RPage.Bottom, RPaper.Right, RPaper.Bottom); ACanvas.FillRect(R); R := Rect(RPage.Right, RPage.Top + cPreviewShadowSize, RPaper.Right, RPaper.Bottom); ACanvas.FillRect(R); // paint page outline InflateRect(RPage, -1, -1); FControl.PageSetup.PaintPageToPreview(Self); end; var SaveIndex: Integer; RClient: TRect; {$IFDEF MSWINDOWS} Org: TPoint; MemBitmap, OldBitmap: HBITMAP; DC: HDC; {$ENDIF} begin RClient := ClientRect; if Assigned(FControl) then begin SaveIndex := SaveDC(ACanvas.Handle); try {$IFDEF MSWINDOWS} if DoubleBuffered then begin // we must paint always the entire client because of canvas scaling MemBitmap := CreateCompatibleBitmap(ACanvas.Handle, RClient.Right - RClient.Left, RClient.Bottom - RClient.Top); try OldBitmap := SelectObject(ACanvas.Handle, MemBitmap); try SetWindowOrgEx(ACanvas.Handle, 0, 0, @Org); SelectClipRect(ACanvas.Handle, Rect(0, 0, RClient.Right - RClient.Left, RClient.Bottom - RClient.Top)); DoPaint(True); finally SelectObject(ACanvas.Handle, OldBitmap); SetWindowOrgEx(ACanvas.Handle, Org.X, Org.Y, nil); end; // copy MemBitmap to original canvas DC := CreateCompatibleDC(ACanvas.Handle); try OldBitmap := SelectObject(DC, MemBitmap); try CopyBitmap(ACanvas.Handle, RClient, DC, 0, 0); finally SelectObject(DC, OldBitmap); end; finally DeleteDC(DC); end; finally DeleteObject(MemBitmap); end; end else {$ENDIF} DoPaint(False); finally RestoreDC(ACanvas.Handle, SaveIndex); end; end else begin ACanvas.Brush.Color := FColors.BkGnd; ACanvas.FillRect(RClient); end; end; procedure TKPrintPreview.Paint; begin PaintToCanvas(Canvas); end; procedure TKPrintPreview.PaintTo(ACanvas: TCanvas); var OldOffset, OldScrollPos: TPoint; begin // will paint the page on given canvas FCurrentCanvas := ACanvas; OldOffset := FPageOffset; OldScrollPos := FScrollPos; try FPageOffset := Point(0, 0); // don't paint left and top space around paper FScrollPos := Point(0, 0); PaintToCanvas(ACanvas); finally FPageOffset := OldOffset; FScrollPos := OldScrollPos; FCurrentCanvas := Canvas; end; end; procedure TKPrintPreview.Changed; begin if Assigned(FOnChanged) then FOnChanged(Self); end; procedure TKPrintPreview.PreviousPage; begin Page := Page - 1; end; procedure TKPrintPreview.SafeSetFocus; var Form: TCustomForm; begin Form := GetParentForm(Self); if (Form <> nil) and Form.Visible and Form.Enabled and Visible and Enabled then Form.ActiveControl := Self; end; procedure TKPrintPreview.SetColors(const Value: TKPreviewColors); begin FColors.Assign(Value); end; procedure TKPrintPreview.SetControl(Value: TKCustomControl); begin if (Value <> FControl) and (Value <> Self) and not (Value is TKPrintPreview) then begin if Assigned(FControl) then FControl.RemovePreview(Self); FControl := Value; if Assigned(FControl) then FControl.AddPreview(Self); UpdatePreview; end; end; procedure TKPrintPreview.SetPage(Value: Integer); begin Value := MinMax(Value, StartPage, EndPage); if Value <> FPage then begin BeginScrollWindow; if FScaleMode = smWholePage then ModifyScrollBar(SB_VERT, cScrollDelta, Value - FPage) else FPage := Value; EndScrollWindow; Changed; end; end; procedure TKPrintPreview.SetPixelsPerInchX(Value: Integer); begin Value := MinMax(Value, cDPIMin, cDPIMax); if Value <> FPixelsPerInchX then begin FPixelsPerInchX := Value; UpdatePreview; end; end; procedure TKPrintPreview.SetPixelsPerInchY(Value: Integer); begin Value := MinMax(Value, cDPIMin, cDPIMax); if Value <> FPixelsPerInchY then begin FPixelsPerInchY := Value; UpdatePreview; end; end; procedure TKPrintPreview.SetScale(Value: Integer); begin Value := MinMax(Value, cScaleMin, cScaleMax); if Value <> FScale then begin FScale := Value; UpdatePreview; end; end; procedure TKPrintPreview.SetScaleMode(Value: TKPreviewScaleMode); begin if Value <> FScaleMode then begin FScaleMode := Value; UpdatePreview; end; end; function TKPrintPreview.SetMouseCursor(X, Y: Integer): Boolean; var ACursor: TCursor; begin if PtInRect(GetPageRect, Point(X, Y)) and (FScaleMode <> smWholePage) then begin if MouseCapture then ACursor := crDragHandGrip else ACursor := crDragHandFree; end else ACursor := crDefault; {$IFDEF FPC} FCursor := ACursor; SetTempCursor(ACursor); {$ELSE} Windows.SetCursor(Screen.Cursors[ACursor]); {$ENDIF} Result := True; end; procedure TKPrintPreview.UpdatePreview; begin Page := FPage; UpdateScrollRange; Changed; end; procedure TKPrintPreview.UpdateScrollRange; var I: Integer; PageWidth100Percent, PageHeight100Percent: Integer; SI: TScrollInfo; begin if HandleAllocated and not Flag(cPF_UpdateRange) then begin FlagSet(cPF_UpdateRange); try if Assigned(FControl) then begin PageWidth100Percent := MulDiv(FControl.PageSetup.PrinterPageWidth, FPixelsPerInchX, FControl.PageSetup.PrinterPixelsPerInchX); PageHeight100Percent := MulDiv(FControl.PageSetup.PrinterPageHeight, FPixelsPerInchY, FControl.PageSetup.PrinterPixelsPerInchY); case FScaleMode of smScale: begin FPageSize.X := MulDiv(PageWidth100Percent, FScale, 100); FPageSize.Y := MulDiv(PageHeight100Percent, FScale, 100); end; smPageWidth: begin FPageSize.X := Max(ClientWidth - 2 * cPreviewHorzBorder - cPreviewShadowSize, 40); FPageSize.Y := MulDiv(FPageSize.X, PageHeight100Percent, PageWidth100Percent); end; smWholePage: begin FPageSize.X := Max(ClientWidth - 2 * cPreviewHorzBorder - cPreviewShadowSize, 40); FPageSize.Y := Max(ClientHeight - 2 * cPreviewVertBorder - cPreviewShadowSize, 40); I := MulDiv(FPageSize.Y, PageWidth100Percent, PageHeight100Percent); if I < FPageSize.X then FPageSize.X := I else FPageSize.Y := MulDiv(FPageSize.X, PageHeight100Percent, PageWidth100Percent); end; end; FExtent.X := FPageSize.X + 2 * cPreviewHorzBorder + cPreviewShadowSize; FExtent.Y := FPageSize.Y + 2 * cPreviewVertBorder + cPreviewShadowSize; FPageOffset.X := cPreviewHorzBorder; if (FExtent.X < ClientWidth) then Inc(FPageOffset.X, (ClientWidth - FExtent.X) div 2); FPageOffset.Y := cPreviewVertBorder; if (FExtent.Y < ClientHeight) then Inc(FPageOffset.Y, (ClientHeight - FExtent.Y) div 2); // adjust horizontal scroll position I := FScrollPos.X + ClientWidth - FExtent.X - 1; if I > 0 then Dec(FScrollPos.X, I); FScrollPos.X := Max(FScrollPos.X, 0); // adjust vertical scroll position I := FScrollPos.Y + ClientHeight - FExtent.Y - 1; if I > 0 then Dec(FScrollPos.Y, I); FScrollPos.Y := Max(FScrollPos.Y, 0); // update scroll range FScrollExtent.X := 0; FScrollExtent.Y := 0; FillChar(SI, SizeOf(TScrollInfo), 0); SI.cbSize := SizeOf(TScrollInfo); SI.fMask := SIF_RANGE or SIF_PAGE or SIF_POS or SIF_DISABLENOSCROLL {$IFDEF UNIX}or SIF_UPDATEPOLICY{$ENDIF}; SI.nMin := 0; {$IFDEF UNIX} SI.ntrackPos := SB_POLICY_CONTINUOUS; {$ENDIF} case FScaleMode of smScale: begin ShowScrollbar(Handle, SB_HORZ, True); ShowScrollbar(Handle, SB_VERT, True); SI.nMax := FExtent.X{$IFDEF FPC}+ 1{$ENDIF}; SI.nPage := ClientWidth; SI.nPos := FScrollPos.X; FScrollExtent.X := SI.nMax - Integer(SI.nPage); SetScrollInfo(Handle, SB_HORZ, SI, True); SI.nMax := FExtent.Y{$IFDEF FPC}+ 1{$ENDIF}; SI.nPage := ClientHeight; SI.nPos := FScrollPos.Y; FScrollExtent.Y := SI.nMax - Integer(SI.nPage); SetScrollInfo(Handle, SB_VERT, SI, True); end; smPageWidth: begin ShowScrollbar(Handle, SB_HORZ, False); ShowScrollbar(Handle, SB_VERT, True); SI.nMax := FExtent.Y{$IFDEF FPC}+ 1{$ENDIF}; SI.nPage := ClientHeight; SI.nPos := FScrollPos.Y; FScrollExtent.Y := SI.nMax - Integer(SI.nPage); SetScrollInfo(Handle, SB_VERT, SI, True); end; smWholePage: begin // another mode for vertical scrollbar - page selection ShowScrollbar(Handle, SB_HORZ, False); ShowScrollbar(Handle, SB_VERT, True); SI.nMin := StartPage; SI.nMax := EndPage{$IFDEF FPC}+ 1{$ENDIF}; SI.nPage := 1; SI.nPos := FPage; SetScrollInfo(Handle, SB_VERT, SI, True); end; end; end else begin ShowScrollbar(Handle, SB_HORZ, False); ShowScrollbar(Handle, SB_VERT, False); end; Invalidate; finally FlagClear(cPF_UpdateRange); end; end; end; procedure TKPrintPreview.UpdateSize; begin inherited; UpdatePreview; end; procedure TKPrintPreview.WMEraseBkgnd(var Msg: TLMessage); begin Msg.Result := 1; end; procedure TKPrintPreview.WMGetDlgCode(var Msg: TLMNoParams); begin Msg.Result := DLGC_WANTARROWS; end; procedure TKPrintPreview.WMHScroll(var Msg: TLMHScroll); begin SafeSetFocus; BeginScrollWindow; ModifyScrollBar(SB_HORZ, Msg.ScrollCode, Msg.Pos); EndScrollWindow; end; procedure TKPrintPreview.WMKillFocus(var Msg: TLMKillFocus); begin inherited; Invalidate; end; procedure TKPrintPreview.WMSetFocus(var Msg: TLMSetFocus); begin inherited; Invalidate; end; procedure TKPrintPreview.WMVScroll(var Msg: TLMVScroll); begin SafeSetFocus; BeginScrollWindow; ModifyScrollBar(SB_VERT, Msg.ScrollCode, Msg.Pos); EndScrollWindow; end; {$IFDEF FPC} initialization {$i kcontrols.lrs} {$ELSE} {$R kcontrols.res} {$ENDIF} end. tomboy-ng_0.39-1/kcontrols/source/klog.pas0000644000175000017500000002074714346341266020422 0ustar dbannondbannon{ @abstract(This file is part of the KControls component suite for Delphi and Lazarus.) @author(Tomas Krysl) Copyright (c) 2020 Tomas Krysl

License:
This code is licensed under BSD 3-Clause Clear License, see file License.txt or https://spdx.org/licenses/BSD-3-Clause-Clear.html. } unit klog; // lowercase name because of Lazarus/Linux {$include kcontrols.inc} {$WEAKPACKAGEUNIT ON} interface uses StdCtrls, Classes, ComCtrls, ExtCtrls, KFunctions; type TKLogDirection = ( ldAddTop, ldAddBottom ); const cHoverTimeDef = 1000; cLogDirectionDef = ldAddTop; cLogMaskDef = [lgAll]; cStatusPanelDef = -1; // SimpleText property type TKLogMask = set of TKLogType; TKLogEvent = procedure(Sender: TObject; Code: TKLogType; const Text: string) of object; TKLogProc = procedure(Code: TKLogType; const Text: string); TKLogEventObject = class(TObject) private FCode: TKLogType; FText: string; public constructor Create; property Code: TKLogType read FCode write FCode; property Text: string read FText write FText; end; TKLogEventObjects = class(TKObjectList) private function GetItem(Index: Integer): TKLogEventObject; procedure SetItem(Index: Integer; const Value: TKLogEventObject); public property Items[Index: Integer]: TKLogEventObject read GetItem write SetItem; default; end; TKLog = class(TComponent) private FEvents: TKLogEventObjects; FHoverTime: Cardinal; FInternalStorage: Boolean; FListBox: TListBox; FLogDirection: TKLogDirection; FLogMask: TKLogMask; FLogText: string; FStatusBar: TStatusBar; FStatusCode: TKLogType; FStatusPanel: Integer; FStatusTimer: TTimer; FStatusText: string; FOnLog: TKLogEvent; procedure SetStatusText(const Value: string); procedure SetInternalStorage(const Value: Boolean); protected procedure ClearStatusBar; function LogTypeToText(Code: TKLogType): string; procedure SetHoverTime(Value: Cardinal); procedure StatusLogTimer(Sender: TObject); procedure Notification(AComponent: TComponent; Operation: TOperation); override; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure Clear; procedure Log(Code: TKLogType; const Text: string); procedure LogStr(const BracketText, Text: string; Code: TKLogType = lgNone); procedure StatusLog(Code: TKLogType; const Text: string); procedure StatusLogStr(const BracketText, Text: string); published property Events: TKLogEventObjects read FEvents; property HoverTime: Cardinal read FHoverTime write SetHoverTime default cHoverTimeDef; property InternalStorage: Boolean read FInternalStorage write SetInternalStorage; property ListBox: TListBox read FListBox write FListBox; property LogDirection: TKLogDirection read FLogDirection write FLogDirection default cLogDirectionDef; property LogMask: TKLogMask read FLogMask write FLogMask default cLogMaskDef; property LogText: string read FLogText; property StatusBar: TStatusBar read FStatusBar write FStatusBar; property StatusCode: TKLogType read FStatusCode; property StatusPanel: Integer read FStatusPanel write FStatusPanel default cStatusPanelDef; property StatusText: string read FStatusText write SetStatusText; property OnLog: TKLogEvent read FOnLog write FOnLog; end; implementation uses SysUtils, KRes; { TLogEventObject } constructor TKLogEventObject.Create; begin FCode := lgNone; FText := ''; end; { TKLogEventObjects } function TKLogEventObjects.GetItem(Index: Integer): TKLogEventObject; begin Result := TKLogEventObject(inherited GetItem(Index)); end; procedure TKLogEventObjects.SetItem(Index: Integer; const Value: TKLogEventObject); begin inherited SetItem(Index, Value); end; { TKLog } constructor TKLog.Create(AOwner: TComponent); begin inherited; FHoverTime := cHoverTimeDef; FInternalStorage := False; FListBox := nil; FEvents := TKLogEventObjects.Create; FLogDirection := cLogDirectionDef; FLogMask := cLogMaskDef; FLogText := ''; FStatusBar := nil; FStatusPanel := cStatusPanelDef; FStatusTimer := TTimer.Create(Self); FStatusTimer.OnTimer := StatusLogTimer; FStatusText := ''; FStatusCode := lgNone; FOnLog := nil; end; destructor TKLog.Destroy; begin FListBox := nil; FEvents.Free; FStatusBar := nil; FStatusTimer.Free; inherited; end; procedure TKLog.Clear; begin if FListBox <> nil then FListBox.Clear; FStatusText := ''; ClearStatusBar; end; procedure TKLog.ClearStatusBar; begin if FStatusBar <> nil then begin if FStatusPanel < 0 then FStatusBar.SimpleText := '' else if FStatusPanel < FStatusBar.Panels.Count then FStatusBar.Panels[FStatusPanel].Text := ''; end; end; function TKLog.LogTypeToText(Code: TKLogType): string; begin Result := ''; if [Code, lgAll] * FLogMask <> [] then case Code of lgError: Result := sLogError; lgWarning: Result := sLogWarning; lgNote: Result := sLogNote; lgHint: Result := sLogHint; lgInfo: Result := sLogInfo; lgInputError: Result := sLogInputError; lgIOError: Result := sLogIOError; end; end; procedure TKLog.Log(Code: TKLogType; const Text: string); var S: string; begin S := LogTypeToText(Code); if (S <> '') or (Code = lgNone) then LogStr(S, Text, Code); end; procedure TKLog.LogStr(const BracketText, Text: string; Code: TKLogType); var Event: TKLogEventObject; begin if BracketText <> '' then FLogText := Format('%s: [%s] %s', [FormatDateTime('dd.mm.yy hh:nn:ss', Now), BracketText, Text]) else FLogText:= Format('%s: %s', [FormatDateTime('dd.mm.yy hh:nn:ss', Now), Text]); if FListBox <> nil then begin if FLogDirection = ldAddTop then begin FListBox.Items.Insert(0, FLogText); if not FListBox.MultiSelect then FListBox.ItemIndex := 0; end else begin FListBox.Items.Add(FLogText); if not FListBox.MultiSelect then FListBox.ItemIndex := FListBox.Items.Count - 1; end end; if FInternalStorage then begin Event := TKLogEventObject.Create; Event.Code := Code; Event.Text := FLogText; if FLogDirection = ldAddTop then FEvents.Add(Event) else FEvents.Insert(0, Event) end; if Assigned(FOnLog) then FOnLog(Self, Code, FLogText); end; procedure TKLog.Notification(AComponent: TComponent; Operation: TOperation); begin inherited; if Operation = opRemove then if AComponent = FListBox then FListBox := nil else if AComponent = FStatusBar then FStatusBar := nil; end; procedure TKLog.SetHoverTime(Value: Cardinal); begin if Value <> FHoverTime then begin FHoverTime := Value; FStatusTimer.Interval := FHoverTime; end; end; procedure TKLog.SetInternalStorage(const Value: Boolean); begin if Value <> FInternalStorage then begin FInternalStorage := Value; FEvents.Clear; end; end; procedure TKLog.SetStatusText(const Value: string); begin if (Value <> FStatusText) and (Value <> '') then begin FStatusText := Value; if FStatusBar <> nil then begin if FStatusPanel < 0 then FStatusBar.SimpleText := FStatusText else if FStatusPanel < FStatusBar.Panels.Count then FStatusBar.Panels[FStatusPanel].Text := FStatusText; end; FStatusTimer.Enabled := False; FStatusTimer.Enabled := True; end; end; procedure TKLog.StatusLog(Code: TKLogType; const Text: string); var S: string; begin S := LogTypeToText(Code); if (S <> '') or (Code = lgNone) then begin FStatusCode := Code; StatusLogStr(S, Text); end; end; procedure TKLog.StatusLogStr(const BracketText, Text: string); begin if BracketText <> '' then FStatusText := Format('[%s] %s', [BracketText, Text]) else FStatusText := Text; if FStatusBar <> nil then begin if FStatusPanel < 0 then FStatusBar.SimpleText := FStatusText else if FStatusPanel < FStatusBar.Panels.Count then FStatusBar.Panels[FStatusPanel].Text := FStatusText; end; FStatusTimer.Enabled := False; FStatusTimer.Enabled := True; end; procedure TKLog.StatusLogTimer(Sender: TObject); begin FStatusTimer.Enabled := False; FStatusText := ''; FStatusCode := lgNone; ClearStatusBar; end; end. tomboy-ng_0.39-1/kcontrols/source/kprintsetup.dfm0000644000175000017500000002232014346341266022026 0ustar dbannondbannonobject KPrintSetupForm: TKPrintSetupForm Left = 808 Top = 247 ActiveControl = CBFitToPage BorderStyle = bsDialog Caption = 'Page setup' ClientHeight = 377 ClientWidth = 464 Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'Tahoma' Font.Style = [] OldCreateOrder = True Position = poScreenCenter OnCloseQuery = FormCloseQuery OnCreate = FormCreate OnDestroy = FormDestroy OnShow = FormShow DesignSize = ( 464 377) PixelsPerInch = 96 TextHeight = 13 object GBFileToPrint: TGroupBox Left = 8 Top = 8 Width = 449 Height = 45 Caption = 'Title of printed document:' TabOrder = 0 object EDTitle: TEdit Left = 8 Top = 16 Width = 432 Height = 21 TabOrder = 0 Text = 'EDTitle' end end object GBPrintOptions: TGroupBox Left = 8 Top = 109 Width = 249 Height = 119 Caption = 'Print options:' TabOrder = 1 object Label1: TLabel Left = 162 Top = 23 Width = 29 Height = 13 Caption = 'Scale:' Color = clBtnFace FocusControl = EDPrintScale ParentColor = False end object CBFitToPage: TCheckBox Left = 8 Top = 21 Width = 70 Height = 17 Caption = '&Fit to page' TabOrder = 0 OnClick = EDTopExit end object CBPageNumbers: TCheckBox Left = 8 Top = 40 Width = 86 Height = 17 Caption = 'Pa&ge numbers' TabOrder = 1 OnClick = CBPageNumbersClick end object CBUseColor: TCheckBox Left = 8 Top = 59 Width = 62 Height = 17 Caption = '&Use color' TabOrder = 2 OnClick = CBPageNumbersClick end object EDPrintScale: TEdit Left = 162 Top = 39 Width = 48 Height = 21 TabOrder = 3 OnExit = EDTopExit end object CBPaintSelection: TCheckBox Left = 8 Top = 78 Width = 87 Height = 17 Caption = 'Pa&int selection' TabOrder = 4 OnClick = CBPageNumbersClick end object CBPrintTitle: TCheckBox Left = 8 Top = 97 Width = 61 Height = 17 Caption = 'Print tit&le' TabOrder = 5 OnClick = CBPageNumbersClick end object CBLineNumbers: TCheckBox Left = 146 Top = 78 Width = 100 Height = 17 Caption = '&Line numbers' TabOrder = 6 OnClick = CBPageNumbersClick end object CBWrapLines: TCheckBox Left = 146 Top = 97 Width = 100 Height = 17 Caption = 'Wrap lines' TabOrder = 7 OnClick = CBPageNumbersClick end end object BUPrint: TButton Left = 89 Top = 345 Width = 74 Height = 25 Anchors = [akLeft, akBottom] Caption = '&Print' TabOrder = 4 OnClick = BUPrintClick end object BUCancel: TButton Left = 383 Top = 345 Width = 74 Height = 25 Anchors = [akLeft, akBottom] Cancel = True Caption = 'Cancel' ModalResult = 2 TabOrder = 5 end object GBMargins: TGroupBox Left = 264 Top = 109 Width = 193 Height = 228 Caption = 'Margins:' TabOrder = 3 object LBMarginUnits: TLabel Left = 8 Top = 23 Width = 62 Height = 13 Caption = 'Margin u&nits:' Color = clBtnFace FocusControl = CoBMarginUnits ParentColor = False end object LBLeft: TLabel Left = 14 Top = 103 Width = 23 Height = 13 Caption = 'Left:' Color = clBtnFace FocusControl = EDLeft ParentColor = False end object LBRight: TLabel Left = 114 Top = 103 Width = 29 Height = 13 Caption = 'Right:' Color = clBtnFace FocusControl = EDRight ParentColor = False end object LBTop: TLabel Left = 63 Top = 65 Width = 22 Height = 13 Caption = 'Top:' Color = clBtnFace FocusControl = EDTop ParentColor = False end object LBBottom: TLabel Left = 62 Top = 147 Width = 38 Height = 13 Caption = 'Bottom:' Color = clBtnFace FocusControl = EDBottom ParentColor = False end object LBUnitsLeft: TLabel Left = 64 Top = 122 Width = 7 Height = 13 Caption = 'A' Color = clBtnFace ParentColor = False end object LBUnitsTop: TLabel Left = 112 Top = 84 Width = 7 Height = 13 Caption = 'A' Color = clBtnFace ParentColor = False end object LBUnitsRight: TLabel Left = 164 Top = 122 Width = 7 Height = 13 Caption = 'A' Color = clBtnFace ParentColor = False end object LBUnitsBottom: TLabel Left = 112 Top = 166 Width = 7 Height = 13 Caption = 'A' Color = clBtnFace ParentColor = False end object CoBMarginUnits: TComboBox Left = 8 Top = 39 Width = 176 Height = 21 Style = csDropDownList TabOrder = 0 OnChange = CoBMarginUnitsChange Items.Strings = ( 'milimeters' 'centimeters' 'inches' 'hundredths of inches') end object CBMirrorMargins: TCheckBox Left = 8 Top = 198 Width = 86 Height = 17 Caption = '&Mirror margins' TabOrder = 5 OnClick = CBPageNumbersClick end object EDLeft: TEdit Left = 14 Top = 119 Width = 48 Height = 21 TabOrder = 1 OnExit = EDTopExit end object EDRight: TEdit Left = 114 Top = 119 Width = 48 Height = 21 TabOrder = 2 OnExit = EDTopExit end object EDTop: TEdit Left = 62 Top = 81 Width = 48 Height = 21 TabOrder = 3 OnExit = EDTopExit end object EDBottom: TEdit Left = 62 Top = 163 Width = 48 Height = 21 TabOrder = 4 OnExit = EDTopExit end end object GBPageSelection: TGroupBox Left = 8 Top = 232 Width = 249 Height = 105 Caption = 'Page selection:' TabOrder = 2 object LBRangeTo: TLabel Left = 163 Top = 51 Width = 14 Height = 13 Caption = 'to:' Color = clBtnFace ParentColor = False end object LBCopies: TLabel Left = 8 Top = 78 Width = 87 Height = 13 Caption = 'Number of &copies:' Color = clBtnFace FocusControl = EDCopies ParentColor = False end object RBAll: TRadioButton Left = 8 Top = 22 Width = 61 Height = 17 Caption = '&All pages' Checked = True TabOrder = 0 TabStop = True OnClick = RBAllClick end object RBRange: TRadioButton Left = 8 Top = 48 Width = 78 Height = 17 Caption = '&Range from:' TabOrder = 1 OnClick = RBAllClick end object RBSelectedOnly: TRadioButton Left = 128 Top = 22 Width = 82 Height = 17 Caption = 'Selected &only' TabOrder = 2 OnClick = RBAllClick end object EDRangeFrom: TEdit Left = 108 Top = 46 Width = 48 Height = 21 TabOrder = 3 OnExit = EDTopExit end object EDRangeTo: TEdit Left = 193 Top = 46 Width = 48 Height = 21 TabOrder = 4 OnExit = EDTopExit end object EDCopies: TEdit Left = 126 Top = 73 Width = 48 Height = 21 TabOrder = 5 end object CBCollate: TCheckBox Left = 179 Top = 75 Width = 51 Height = 17 Caption = 'Collate' TabOrder = 6 OnClick = CBPageNumbersClick end end object BUPreview: TButton Left = 8 Top = 345 Width = 75 Height = 25 Anchors = [akLeft, akBottom] Caption = 'Previe&w...' TabOrder = 6 OnClick = BUPreviewClick end object BUOk: TButton Left = 303 Top = 345 Width = 74 Height = 25 Anchors = [akLeft, akBottom] Caption = 'OK' Default = True ModalResult = 1 TabOrder = 7 end object GBPrinter: TGroupBox Left = 8 Top = 56 Width = 449 Height = 50 Caption = 'Printer settings' TabOrder = 8 object LBPrinterName: TLabel Left = 8 Top = 20 Width = 65 Height = 13 Caption = 'Printer name:' Color = clBtnFace FocusControl = EDCopies ParentColor = False end object CoBPrinterName: TComboBox Left = 112 Top = 17 Width = 206 Height = 21 TabOrder = 0 Text = 'CoBPrinterName' OnChange = EDTopExit end object BUConfigure: TButton Left = 328 Top = 15 Width = 113 Height = 25 Caption = 'Configure...' TabOrder = 1 OnClick = BUConfigureClick end end end tomboy-ng_0.39-1/kcontrols/resource_src/0000755000175000017500000000000014551457755020156 5ustar dbannondbannontomboy-ng_0.39-1/kcontrols/resource_src/kedits.rc0000644000175000017500000000003414346341266021753 0ustar dbannondbannonopendir BITMAP "opendir.bmp"tomboy-ng_0.39-1/kcontrols/resource_src/tkfilenameedit.bmp0000644000175000017500000000337014346341266023635 0ustar dbannondbannonBM6(  𠠠𠠠𠠠𠠠𠠠𠠠𠠠𠠠𠠠𠠠𠠠𠠠𠠠𠠠𠠠𠠠𠠠𠠠tomboy-ng_0.39-1/kcontrols/resource_src/kgrids_laz.txt0000644000175000017500000000052014346341266023034 0ustar dbannondbannon./kgrid_icons/kgrid_hci_hbegin.bmp ./kgrid_icons/kgrid_hci_hcenter.bmp ./kgrid_icons/kgrid_hci_hend.bmp ./kgrid_icons/kgrid_hci_vbegin.bmp ./kgrid_icons/kgrid_hci_vcenter.bmp ./kgrid_icons/kgrid_hci_vend.bmp ./kgrid_icons/kgrid_drag_arrow.bmp ./kgrid_icons/kgrid_sort_arrow.bmp kgrid_cursor_hresize.cur kgrid_cursor_vresize.curtomboy-ng_0.39-1/kcontrols/resource_src/kprintpreview_icons/0000755000175000017500000000000014346341266024251 5ustar dbannondbannontomboy-ng_0.39-1/kcontrols/resource_src/kprintpreview_icons/01_arrow-previous.png0000644000175000017500000000102714346341266030263 0ustar dbannondbannonPNG  IHDRw=tEXtSoftwareAdobe ImageReadyqe<IDATxJ@$7](-^֊bW…>k.*+^jQۤq&5bR;O2̙C_[pzr ;kdcsӺ43 #9*sB xx,6 ,p3ckH'9QTqGXjfμQ?P0'pE,Mgz7 ):H/$2|kBlx+ h ^~ŌFC D|&½yWU5{!ڏ^s]rX .ѥ L>P"?'۾x"HУEVn4jR:KwE19a=^DmjͶ>=5Z{QԖP,h+G#H&Ɛ?x ?W 0 PIENDB`tomboy-ng_0.39-1/kcontrols/resource_src/kprintpreview_icons/02_arrow-next.png0000644000175000017500000000101014346341266027356 0ustar dbannondbannonPNG  IHDRw=tEXtSoftwareAdobe ImageReadyqe<IDATxK`߳٤:tfREE=ԥC^"Wc}iopJJ x4l`<.!G7>}6[sAz/"'WgF2}a( 29xYޮQZ" I_Z[= ۽Q2d+bւ 6yP")[WRgf¬ QTi9@r '1($+ נ5V˹%(("{>`4M-֠*(*Vi4@-fyPc~qO?H 'IIENDB`tomboy-ng_0.39-1/kcontrols/resource_src/kprintpreview_icons/05_close.png0000644000175000017500000000116214346341266026370 0ustar dbannondbannonPNG  IHDRw=tEXtSoftwareAdobe ImageReadyqe<IDATxUJQ=,N-\+66V6AA6,, ~ "hg'X˙$u,/ 9sfLJ~`{ٹ.y]YVa~T2];33`BtJLB/.LŢL)^^gؓ5 9O#PI89wSbyG st$~>_r2m'г@>_FXm oU9@*y>>9P{;C*y{s1?Ã'|']yX $iPW#imeZP3c[؞Ah&YN:1&,HMkn< '"|gzAɇɩJ\_KCtg]5a'(Hvupon`O7]cccS;}q390L(GGxaqÛ\69ĩ?).Z$ nL"7w+7tI؂dPĩق }F1(1E";cX| v[="ޚ%qQ-["LqEVaf"+IĦ"&BD)+Rn|nbң2ޜT@`d0l[zZ ?KF\[fFf_nM{H? }_z=YQmv|c34 )[W%I Ȱ316rX7(ݝ ⺱SӅ|zfšyq_0sxpєqyv\7GSa؟8"Q>j1>s@7|8ՉŹ,߳e%9-$H*P*@#`l=p0VHiA>@ vjP @h'@8 .:n``a!2D UH 2!y@PAB&*: :]B=h~L2 p"΃ p\ u6<?g! DCJiA^&2L#PEGQި(j5jU:jGnFQ3Oh2Z mC#щlt݈nC_BF`0FcDa1k0Vy f 3bXl `{ǰCq[3yq<\ww7Zx;| ŗ]8~ M!8Ʉ*B !HT'\b8 q$C'bHBvay=+2Mv&G&Ec[ [bDDĐ I* Zc0&8(&iYH~Ho(%46h0װu wKDŽ7EGGDDōFG7FϮX{xULQ̝:+sV^]*uՙXXf8t\DѸ@f=s6'~_ ˍ̮`Oq8圉D]SINII\7n5ewrm\J`ᔅԈ4\Z\) /ד>aQ1n3|?~c&2S@L uYY5YoóOHrrsNy};_-cZuuk/\?kÑ)*0-(/x)bSWr±^$E[nEmnfmOk%%%JY׾1ꛅ ˬir]+wZiYYGgʿs{?T'U߮qiݧo۾C*זԾ?=xΫ^P֡ 2mjTl,ixwxHȑ&JG˚faԱc7sŨZr}wN>8(mP{nLGRHgT)S]]m?x3g]8wn| ƺc\x'ߥ+=/_u=wvWO]c\n}Ϫ'l:o\:xviMoܺ~{;˾;y/Ylx~XHQc?:b=rf}Icda)iDӤ)ϩV<|~W_}oοDΌ\«ï-_w>~f~#zGPQc'O6gAMA|Q cHRMz%u0`:oIDATxb?-@,;##mV&`'0[`L:?}S0 X3B4,n.V)1n cɈcR/^g3DF&`6@p}t?* Xy@glĽArA}k`KB _0|pPA?88,#J33ËEno ~~ P10~ h *h(.C`q&f&̯.20}}3 #,_1 gc?/b?g6H /eh +J$܂pfdi! t?ph dS1F&Dr p&8IB؍1R5of?0b`3Lr;}_\v"hbzoV<Ƀ} L @'m5F^~fPVQcfҍ:sff$@yY|72;rH9? ALT}.߿30 n6vV.y)9$SB2%,/D!0YA X@6c|pos&J" x9E/0!e'/o߾9 çO?>|w-:#L<?~ X@|0@^VL1pA!0(>}?b 2 rN 7f`j8ͺ?0(2Hj0<|h.'gƟOS0B0 Rp3p@׃ FIJsNw~W߿3:rAXBBTdC;0R&0.Xxev@,&LΔL#]=Uՠfabo>@ݛw bhi/Pm6I&1(_xȃ()0&_H9+tffؘ޿~qB]vh6+@|) (>p]"i "xk2[z;O ɜ;g2Ii aQb} pǺ19>-GJDc3q~e=+!:42ϳe{ t`0ay=-#=ZɅHg)1' Bq]MC;YGhՅGD(Bh~,+G 8\_<֑Pu B:`{nIZ$1yȦ3ӶHLxP@e{mOLuA~ȴ~g͒ +R9ΒOPc9iv0g'j+Q쫁zI[kNxv@9Tg-Rq#| rusH>dBxB Hp^dX vcycQ#"ɅŇz);l:IENDB`tomboy-ng_0.39-1/kcontrols/resource_src/tklinklabel.bmp0000644000175000017500000000337014346341266023144 0ustar dbannondbannonBM6(  tomboy-ng_0.39-1/kcontrols/resource_src/tkmemoframe.png0000644000175000017500000000241714346341266023166 0ustar dbannondbannonPNG  IHDRw=gAMA7tEXtSoftwareAdobe ImageReadyqe<IDATxڴV[hUv'{fݤMjH,T`VXAb (ࣈd_,y>+}*Xo1$[澛93;؛ 1{n9ǻ #4oFn{S|>B;a4V 8~/NAmt$\e2cPiH95t! ֟ڢa޿Ey%PQ`mZj'kò9!EBTg29Pke)Fsfh7+X.ˮ _dx^"x׹J"!TLA:.#bWy5.U920ժ%׆ 0)7& l\dɕmLST zNᡉzv Z#ZZ~!ׅNbiq DT2lQ~e'H%4֫rgt_Ho| "( Upj{{@>ܬ{6ע@ iktGTgS` d"{Shx?cyk33>:c"voh34q$͙Xq<c` I))V:TN ]Tf)J%#Dz伭-=O±}v p͞Fj=u(2G;&E"b{y/qVQЋo¶ҸEJΝFO:ѤjM\pXT}{ 9h@Fh|%sEL\GedPu ;V0͛Q)N!4QuEHIKLJ2$:aԞ6ԧWpZCOI+,_% xn N|ԃ}/RW x#qP<٘?~s+ظ@CH&9=xx{?*2TGǮkF+wuVp;)+9g~a6ô+yIw%1.I Ŝ;"07?XhTiJa BvާMF>lv6 ^)QEsss} uhE+Yf~{Gk`pzƼ)Mڼ11WG *Mj  5Z@RivK]>(T@.{Φj *IoSu5IENDB`tomboy-ng_0.39-1/kcontrols/resource_src/tkprintpreviewdialog.bmp0000644000175000017500000000062614346341266025126 0ustar dbannondbannonBMv(   B~i` ` i`iD &i`$C" iDD$i`D$ i4"i`D i`ii`iii`hiiUUUUUUUwwwwwwwwxqtomboy-ng_0.39-1/kcontrols/resource_src/tkprintsetupdialog.png0000644000175000017500000000313014346341266024604 0ustar dbannondbannonPNG  IHDRw=gAMA|Q cHRMz%u0`:oIDATxb?y`?`b^ bq(> ~@,ke1111###33;; //07'Dx$D?Fr?@, Ӓ4 d(f[Suᩞ#س+ w3_00&W;w@2/]Rl ?2XpUku9Յ/2I2caxEl_qZ4AZAxSG?2XgJ3\t BiqfA6.].3 >܊..6q9q giGnK2j2H}c7õ ̪ l U Y3}A@lAGG.V?||_f66V+] &1`N`P,-, NNǏ/b@ {?dPTP&f20߷?ͽp808h2÷o1n0>.~G@T /^fex9'03%2iK1|fg,  2x1 1{ ` 8w}@K^Le>1y_ ?͕ 8~t?` )) 0,,CXYYtnݾLϬ,la& QeuM/_9q~.*~VBd];. H0 \<3AhHjb/L Xl fh_3 7I Ig_0|AS[ҥkD ׮\0<տ0LFCCa֬ ή x-fXp9CFj2Z(0܂{ie5f'k߿#/T9@G6`pWk}=2k%؂rZ \ 9_ K&p\K_ c\ 1w~rx#@1l!/h7[ IENDB`tomboy-ng_0.39-1/kcontrols/resource_src/tkpercentprogressbar.png0000644000175000017500000000177414346341266025135 0ustar dbannondbannonPNG  IHDRw= pHYs  gAMA|Q cHRMz%u0`:o_FrIDATxKh\U;+MNR0MH(RJ1ME$ l *BU]qYD,-R$h%M -bhjl My$̝s o,n9rv>a bTnt{-v4j_\%GC;3r% p^ Tّ;;RzvnڡV4tgG poգAր2<@ <5⳥[u#R2>ۡ5 {"hsaf+t:aU!6:^-˒Mk2)IENDB`tomboy-ng_0.39-1/kcontrols/resource_src/tkpercentprogressbar.bmp0000644000175000017500000000337014346341266025121 0ustar dbannondbannonBM6(  𠠠𠠠𠠠𠠠𠠠𠠠𠠠𠠠𠠠𠠠𠠠𠠠tomboy-ng_0.39-1/kcontrols/resource_src/kedits_laz.txt0000644000175000017500000000001314346341266023031 0ustar dbannondbannonopendir.bmptomboy-ng_0.39-1/kcontrols/resource_src/tkbrowsefolderdialog.bmp0000644000175000017500000000337014346341266025064 0ustar dbannondbannonBM6(  tomboy-ng_0.39-1/kcontrols/resource_src/kmessagebox_warning.png0000644000175000017500000001031014346341266024703 0ustar dbannondbannonPNG  IHDR00WgAMA|Q cHRMz%u0`:oSIDATxb?P8=@L }b`gɌ~ 1fdz&T@ ~S@F?{v՟o_7K,=@`_z? O \bgDM SSy c` %]TQȬ(F-@~a/Oz=__3}cP`$&p_@$oN=8y3|P :: CwyӬ ΰ2dt| `$ $"1O/rI`A#O?@G3=*q3؏_2ĸe 0] o1{MK,}&\om'&~CQ^zq0#23i~eP1,uK`y 2|l2ë4/ A@ ZPX21.Ŭ3HXaѭMeOD4sL<g`8 ,lA!f9i_A ≮uoBr3|g0pAVK-;2)~Ơwzh?#},, Gq2ܸ &]O*RB]^jb&-Mԋ=-} &ïp: |bțpo?0qd 03v8$s`|ph+'oL oT,n|UkR@c~ñ8ya)`TC&_f`dͰ8;++#-Xc%!a3\>p hGO SX#j1c l3Q_^9`XKÿ3T13reȞͰn?'Tb`p4ɰXW|dF @~bbس;&=`b$i C\*@8* f`vWʷ=dxAA+- zqobz|,.;9r0!;7J9k 'r{u=^34ճ7jb2 пߘ߫} f0ixĠWb)_0g8Fa'xPg4$nm`x|AE+w.̂@1||I `A+_C=$39cAUW!jBP,||İk#fd06Ġk>#GH,@- `aV.;ssJ?RAiFhFeb)]>0ىqɏv 6! NftVYȭUbo|z=])_~.24d#'oO`K22 , π5UFFHp`k`W.,7&>{ It^ ~p `Ի`h/&F7#j3\֟gdh  %Q_~3|~ edbafWXNeWtN$3s8LLF3@1QSc8wg aAjO,?_  0, ?2H1| FF$>X|܊..6q9q giGnK2j2H}c7õ ̪ l U Y3}A@lAGG.ׯ_gXh0802,r#,ɼ yD"E rr` ܁72utS  3+3۟ 'q&anGqe@s3?Pw@, X;w\>L:f? L| @00YP%g`^a &l()0ۻ >>Ǐ w>exÏ+}wNp`c j fYYy.`ze˰3&1a NW@̌ < ҂@=l( |􁀠ãO?rl < rl E~ w=fط yv&f~ ^` _ 2HJ - A LL@8XA/F1p| /+/_Eů_@| ܸܕ[  3|| _  VLX~o@_s/°͘ ,.`p#5yn]pOo-ĄZ P A؎@ԅk " J@}FO۶2D@X^> ߿f8xx+ؕ\X MM` Gwseprr` {۴ @#@REIENDB`tomboy-ng_0.39-1/kcontrols/resource_src/tkfilenameedit.png0000644000175000017500000000176614346341266023652 0ustar dbannondbannonPNG  IHDRw= pHYs  gAMA|Q cHRMz%u0`:o_FlIDATx[hUgfvw6{eTۀ( V5-K} TP|!*B}+AiFm1%Ik2s|piiU|3gR1t ! W? Q]zuՂFg^uN9 F40T sSOw ۤG؃V;1 턁xn蹈g}؃n۫a`Tઇ`:MM>ZZB1O6yk߈ay74ߞn7tMM& NpD4GɆ2M->߸'[}7+5{5z~N1o@Y9ty:N'R`-Irq@ [ $;JH/j92hhu!9`ZcM\fW(ɐW*()p\mz[ܑɊmaC@4n !%Dz#ZE2)-kx7$=[+<٢|"~AdW\\\\\\\64.lpnSWU64.`b^UWS)>Vjk>>\64.lpnSWU64.qvt64.gE>\971mqoSWU64.qvt563=}s9k\:83nI~ZO}|}SWU64.[\XLSX Rx8og\m_J[^_\,;MW!: k!TLkh\U dqZ564,>?????????><TTTTTTTTTTTTTTTTڌKŠᷕŠŠŠŠŠŠŠŠŠŠᷕŠڌKՅC춋ȕnֿֿֿֿֿֿֿֿֿֿȕn춋ՅC~:xU̱¡¡¡¡¡¡¡¡̱Ux~:w1r|Hǩ뼘뼘뼘뼘뼘뼘뼘뼘ǩ|Hrw1q)yĐhӼ˯˯˯˯˯˯˯˯ӼĐhyq)l#l#d!k#k#k#k#k#k#k#k#k#k#d!l#l#ۇAƦ~~ƦۇAۇAƥ~~ƦۇAۇBŤ~~ƦۇAۈBʭ˯ۇAۈBf1ۇAۇAۈBۇAf1>>>>>>?????>>tomboy-ng_0.39-1/kcontrols/resource_src/kmemo_icons/26_format_font.ico0000644000175000017500000000217614346341266025777 0ustar dbannondbannonh(  h8ڏ]ې`׃PP+B#?"*M+qB~Q|MU191\/ _0DuڌXR,=E$H'ܖkۏ`?!T8]0t?|f7c7ߠwډZ>""c2ۓ^y؃Jj:h9zE㨁نVA#j6\ߝhڋR_1NY.*g7z؆SF% j5׀Bߟjf4f]/ a3yzDJ'q8"ޛcܖ^i5Ti5|l:y_0׃>Sl鼑纏緋q~B\/ ؇@@؋CڎIىC؄@؄As:b2 [.tomboy-ng_0.39-1/kcontrols/resource_src/kmemo_icons/11_edit-find.ico0000644000175000017500000000217614346341266025316 0ustar dbannondbannonh(  64.:8297186075/64.64.64.:8297186075/64.64.:82figSVT860:82figSVT860:93mpo750:93mpo750<94becNPM760<94becNPM76066/QVURfjhSVU66163-P66/QVURfjhSVU66163-P;;1}75/64.64.64.64.64.860;93y64.64.64.64.64.64.75/}850komQRN75/750uvrkomdgf64/64.lpnSWU64.`b^UWS64.kpmSWUkom64.64.lpnSWU64.qvt64.kpmSWUpsr64.971mqoSWU64.qvt64.wzxqsq75/:83n860?=6|}SWU64.[\XRSO64.:8275/851n72.8POK^_\64.75/{|xLKF55,:;8375/64.64.750t:83n86064.64.98164.|UYW64.64.|UYW64.<:464.64.860<:464.64.860tomboy-ng_0.39-1/kcontrols/resource_src/kmemo_icons/32_insert-image.ico0000644000175000017500000000217614346341266026042 0ustar dbannondbannonh(  tSrOêmEkCkCkCkCkCkCkCkCkCpJtSmHpJd:kCd9bBXXXXXXXXbBkCf:XuuuuuuuuXmEf:XuuuuuuuuXmEf<Vުsުsݩsݨsܧrܧrܧrܧr}UmEf>=<oH>==u!7q~?>>AǑˆ@?>pȒȒˆ@??TąɒÉA@@|#3Kppppp@OOOOOOOOOOOtomboy-ng_0.39-1/kcontrols/resource_src/kmemo_icons/17_format-indent-more.ico0000644000175000017500000000217614346341266027170 0ustar dbannondbannonh(  ???.KyCPKtKW_ ap1WWVVVVVVVVVVVVVVV$b_d yZ#f $bPcccccc*n%(x$u yg*n%ppppppppppppppp/z-iͨ_ȢVÜ:m/|1/z-R45yҰ@[454568ѯ;F68t68TTTTTTTTTTTTTTTTTTTTT686868.ccccccrrrrrrrrrrrrrrrrrrrrrRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRccccccttttttttttttttttttttttttttttttttt??tomboy-ng_0.39-1/kcontrols/resource_src/kmemo_icons/25_format-text-underline.ico0000644000175000017500000000217614346341266027715 0ustar dbannondbannonh(  OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOccccccwwwwwwwwwnnnbbb^^^\\\```eeekkk]]][[[dddwww[[[uuu```[[[[[[Qttt[[[[[[www[[[^^^[[[[[[[[[q[[[[[[ [[[[[[[[[```[[[[[[=ttt[[[[[[[[[[[[hhh[[[[[[```fff[[[[[[ooovvv[[[[[[}}}eee```nnnfffvvvjjj{{{lll}}}}}}Ãtomboy-ng_0.39-1/kcontrols/resource_src/kmemo_icons/09_edit-cut.ico0000644000175000017500000000217614346341266025200 0ustar dbannondbannonh(  J1 a1׶v?e4K2 gEjH ^/cOݫbb2wSVǗQئZl6Q5 h5ѠWA* j6u?M3 D֤Z讂Afn6جl7ĕQvV'vx@R8J~An2fʢtg^-Mӯp;I0 j2֥^pM>nKO`ܽͥgئ]fIdfC~Bܪ`ОTeغWW9 AfDi2~BҞh,g_ŁS^= YʹaTϳv7lPf cγf ;L{e$\ӹӸ^GtȮd`'Ѷ仗g~Cnռag"-L{>iˮ] `j%*{>aOo??Ogs{tomboy-ng_0.39-1/kcontrols/resource_src/kmemo_icons/05_document-save.ico0000644000175000017500000000217614346341266026230 0ustar dbannondbannonh(  YN6ZO7[P8[P8[P8[P8ZO8ZP8ZO7ZO7ZO7YN7YO7YN6YN6YN6 YN68`U>mquvx{~g]GYN6?YN69i_Ixo[YN6>YN6:kaKż¾yp]YN6>YN6:mcNǾxo\YN6=YN6;ofQƽ½xo[YN6zq]zd~julXYN69YN6?kaKg]GYN68YN6#^T=`V?`U>`U>`U>_U=_U=_T=_T=^T<^S<^S<]S;\Q9YN6tomboy-ng_0.39-1/kcontrols/resource_src/kmemo_icons/15_edit-undo.ico0000644000175000017500000000217614346341266025347 0ustar dbannondbannonh(  ǿTƳ+Ʃ ŕ9 GAK/ǩ%#RL82 ƮHDcPYIk3en dio.ZUƑƎ$~00LbZ@/V<ǾWe3IEAOi"hǢ1y?aƂXayF0?tomboy-ng_0.39-1/kcontrols/resource_src/kmemo_icons/22_format-text-bold.ico0000644000175000017500000000217614346341266026645 0ustar dbannondbannonh(  [[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[bbbrrr[[[[[[[[[[[[[[[#[[[sxxx[[[[[[[[[[[[___[[[[[[]]][[[hhh[[[[[[jjjjjj0hhh[[[ccc]]][[[mmmkkkaaa=wwwiiiWqqq wwwW|||ssstttttt߫Rtomboy-ng_0.39-1/kcontrols/resource_src/kmemo_icons/16_format-indent-less.ico0000644000175000017500000000217614346341266027173 0ustar dbannondbannonh(  `.``nntvnVVVVVVVVVVVVVVV}}!}ccccccR   ppppppppppppppp-'@%<%8#4P?Jhv_oVf$*uzTTTTTTTTTTTTTTTTTTTTTt gpcccccc.qqqrrrrrrrrrrrrrrrqqqRRRRRRRRRRRRRRRRRRRRRRRRRRRcccccctttttttttttttttttttttttttttx|tomboy-ng_0.39-1/kcontrols/resource_src/kmemo_icons/28_insert-link.ico0000644000175000017500000000217614346341266025722 0ustar dbannondbannonh(  j4ke0e1_3XMGhdbmkimkj`=a9okhmkigdbPKI???0i3hfdqqqxxxMMMq8PplgpWECBFFFQQQQQQFFFECBgggx>> ƄGƀBƈIƂEƈJڽػƃFƉKֻԵҳĂFƉKټ~EƉLֺⶄyBňKָش}ےdk>ąI}۔eh;}D`ȋMȌOȌOȌOȌOȍOɌONjOʼnKv;h<tomboy-ng_0.39-1/kcontrols/resource_src/kmemo_icons/33_insert-container.ico0000644000175000017500000000217614346341266026743 0ustar dbannondbannonh(  @~@~@~@~@~@~@~@~@~@~@~@~@~@~*BYq@~@~KL LLVm@~@~5Md|@~@~FLHLLLLL,D\s@~@~ #;S@~@~?LELFLKLLLLL2@~@~@~@~=L>L?LBLDLELJL@~@~@~@~@~@~@~@~@~@~@~@~@~@~@~@~@~@~tomboy-ng_0.39-1/kcontrols/resource_src/kmemo_icons/07_copy_format.ico0000644000175000017500000000217614346341266026002 0ustar dbannondbannonh(      Q`@k_pW#>2,#  (#+B1<52s!)U:- & ~3!&87#fwl--;.ͻ .'6=%t *(-&&4Q8Ԋ &$E604"(Kp{F xDazE3h^wȫϵӹ׿uͯѷ*^{G wB wB wBX|H{GyEzExʭOzFyDb{G xDa xCzF wBF xC wB0tomboy-ng_0.39-1/kcontrols/resource_src/kmemo_icons/00_document-new.ico0000644000175000017500000000217614346341266026056 0ustar dbannondbannonh(  9::::::59~ :~: ::5:::::::ߕ## f:ݕ6f:!!4d2: :!!)?)Z3:Ϗ66xxxz55g:::::::::u))[[**h?tomboy-ng_0.39-1/kcontrols/resource_src/kmemo_icons/14_edit-select-all.ico0000644000175000017500000000217614346341266026426 0ustar dbannondbannonh(  I⋐㊏K剎ĭĭĭì}}ªªë}}ԿӾԿԿԿԿԿԿԿԿ}}}}}}}ïԿӾҾҽҽѼм}}}}}~«ԿӾĬ}}}}?ŮĬëª˹xzN奫Dtomboy-ng_0.39-1/kcontrols/resource_src/kmemo_icons/20_format-justify-left.ico0000644000175000017500000000217614346341266027366 0ustar dbannondbannonh(  OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOccccccwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwOOOOOOOOOOOOOOOOOOOOOOOOOOOccccccwwwwwwwwwwwwwwwwwwwwwwwwwwwOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOccccccwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwtomboy-ng_0.39-1/kcontrols/resource_src/kmemo_icons/02_document-print.ico0000644000175000017500000000217614346341266026423 0ustar dbannondbannonh(  '('+΅̄˄˄˄˄˄˅̄"VVVWWWx\\\m```hXYYzBCBBCBCCCCCCVVV|qqqAAAlklnlnnlnnmnomoonoonoomoCBCqqqtss212JHKJHKHFIEDFDBEAAC@?A;:='&(uttqqqVUVzz}srukjmcbeYY\QQSFFI../ttt}||hiiQPQԑnnnnnn?𢡡񛚚CppphhhbbbqppbbbqppeeetttYYY]јɘəəəəɣcccbtomboy-ng_0.39-1/kcontrols/resource_src/kmemo_icons/30_format-text-subscript.ico0000644000175000017500000000217614346341266027742 0ustar dbannondbannonh(  jjoz!kjj sYVǡҳbsEEEEEEEEEEEEEEEEEEEEE(EEEerR=,{${$;{$EEEFFFㆆMMM^^^mF2IIIQS@@-PPPjjjPPPPPPVVViٿXTgOYYYXXXVVVVVV&^^^ސ]ؾ]]]]```]]]]]]i]]]ohdkkkkk dddpllldddjjjjjjv~~~rrrjjjqqq&qqqfqqqqqqwwwxxxqqqxxxxxxxxxxxxxxxxxx){{{~~~xxx~~~~~~~~~~~~ ̧⌌[ؒ钒ϒN ?tomboy-ng_0.39-1/kcontrols/resource_src/kmemo_icons/31_format-text-superscript.ico0000644000175000017500000000217614346341266030310 0ustar dbannondbannonh(  EEEEEEEEEEEEEEEEEEEEE(EEEeEEEEEEEEEeEEEFFFㆆMMM^^^IIIIIINNNPPPjjjPPPPPPVVVhhhPPPYYYXXXVVVVVV&^^^[[[VVV]]]```]]]]]]i]]]ccc]]]dddpllldddjjjjjjv~~~rrrh+f!fqqq&qqqfqqqqqqwwwn(oz!kjj xxxxxxxxxxxxxxxxxx){{{ȧVǡҳbs~~~~~~,{${$;{$߅ބHF2 ̧QS@@-[ؒ钒ϒNY=iٿXTgO]ؾ]kk|kkkk tomboy-ng_0.39-1/kcontrols/resource_src/kmemo_icons/04_format_paragraph.ico0000644000175000017500000000217614346341266026772 0ustar dbannondbannonh(  I⋐ ?xzN奫D?tomboy-ng_0.39-1/kcontrols/resource_src/kmemo_icons/10_edit-paste.ico0000644000175000017500000000217614346341266025511 0ustar dbannondbannonh(  sBuEuEuEuEuEuEuFtDS cJ c c c c cɏgʀT ct{xutک}΁V cSPNM֩}̃U cVSPP֩}˅U cYVSS׬̆V c\YWV׬ټ̇W c_]ZYح׻ѯ̇X ce`]\ٯټʃS ckf`_ٯӴˈW coh`_׭껈ΉYi= ctplkٯ׮׬׬̠p͟qgˈVֲg< cyDDCBBAS c cNuuK c c2 c c7u.n c c cS c* c c c c c ctomboy-ng_0.39-1/kcontrols/resource_src/kmemo_icons/18_format-justify-center.ico0000644000175000017500000000217614346341266027723 0ustar dbannondbannonh(  OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOccccccwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwOOOOOOOOOOOOOOOOOOOOOOOOOOOccccccwwwwwwwwwwwwwwwwwwwwwwwwwwwOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOccccccwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwtomboy-ng_0.39-1/kcontrols/resource_src/kmemo_icons/23_format-text-italic.ico0000644000175000017500000000217614346341266027173 0ustar dbannondbannonh(  [[[-[[[[[[[[[[[[O[[[ͼuuu[[[[[[}}}[[[[[[[[[[[[[[[)[[[ooo[[[.[[[J}}}[[[{[[[ ]]][[[[[[mmm[[[ ```O[[[rnnn[[[yyyddd[[[iii[[[[[[d{{{aaa[[[X\\\[[[^^^[[[ppp[[[f???????tomboy-ng_0.39-1/kcontrols/resource_src/kmemo_icons/03_document-preview.ico0000644000175000017500000000217614346341266026751 0ustar dbannondbannonh(  899:::958~ \\\Ȍư:L-޼ڠ֙v:|{{֐R7ΠoΙݙޖלĎk:@??b>ӫЛקڹiG:9N1aB>4[A99KKJ]ȋ؍ =::::9=tomboy-ng_0.39-1/kcontrols/resource_src/kmemo_icons/08_edit-copy.ico0000644000175000017500000000217614346341266025356 0ustar dbannondbannonh(  sBuEuEuEuEuEuEuFtDSyIʀTςS΁ṼR̃UyJyKuEuEuEuEʄR˅U|N云̆VςS仑ټ̇W̃R仒׻ѯ̇XʄR仒ټʃS˅S仓Ӵ}HˆT徖껈υUi= ˆUÝ濖仒仒ѠlОm̖_yB~g< ˆUټ͕eˆVӴ}HʅT껈υUi= yĞÜWˈV̈VˇWʃPyBng<??tomboy-ng_0.39-1/kcontrols/resource_src/kmemo_icons/06_document-save-as.ico0000644000175000017500000000217614346341266026632 0ustar dbannondbannonh(  YN6ZO7ZP8ZO8ZO8ZO7ZO7ZO7ZO7ZO7ZO7YN6YN6YN6YN6YN6 YN68^T<}t`xe~l|i{h}jltqruvcYBYN6?YN69e[D𴯡¹ŻpgRYN6>YN6:g]F¹ĺqhSYN6>YN6:h^HtPy\ŻȾsriTYN6=YN6;j`JﾺsQf۸wzyc~u_sjUYN6_T=u?jԆtR_T=_T=^T<^S<^S<]S;\Q9YN6YN6s>ۯ_۷toOYN6k[9lo_=oo`Aoi\@`tomboy-ng_0.39-1/kcontrols/resource_src/tklog.png0000644000175000017500000000217714346341266022002 0ustar dbannondbannonPNG  IHDRw= pHYs  gAMA|Q cHRMz%u0`:o_FIDATxڴ[H\Wse8$x#V"TK jJ>$ b>}ڇ>>Pm(/&UgB4L'tbF҉˘qnsfha6ނ<oAL@,sX&Q!"c&??F_/y8ŖQevl l cEgsO}hrp}OcսćV!s2* 3Ev&nᯰ P=x)pHBeuR'w"gv=<W= Vp?޿Lj16g.'o^` XB ̿D'P"9)E`ͨAlK.b q'1viB1ђkp~0r>aɰ-כQDBLf y5:Bsp6ϚUdD8ek]]}|K?L{_a^2H.4ƃmUTw4e-TR&rK r_o0UFƀYiUx"*(*3J.F˿iVm=ŀ5@R6G@`,6uQ̅ gЁ/8ZKs *hs¥@<'AӃd S/20'`xs&V4?Z6c ksk۷~ONѫH ^ｌ5g`XgZ/eޢ6[BΊ"ik~qUDEEN\5wjMC!4m UU ©jjgpƶv]]466mGUUSdnrn& G ǪrRwr%nnwDڒIiUUefJ Ym,;>AąIENDB`tomboy-ng_0.39-1/kcontrols/resource_src/opendir.bmp0000644000175000017500000000147014346341266022307 0ustar dbannondbannonBM86(rpnnnnnnno}))))))))))8X~))`7o))`|)W})h)`{rh7o)[)`quvuqkd[)X})KR)``a`]YRKK:u)`e)))))))))))~))u)֤)))))֤))֡xto)))֤}n{zyqtomboy-ng_0.39-1/kcontrols/resource_src/kmessagebox_laz.txt0000644000175000017500000000013514346341266024063 0ustar dbannondbannonkmessagebox_info.png kmessagebox_question.png kmessagebox_stop.png kmessagebox_warning.pngtomboy-ng_0.39-1/kcontrols/resource_src/kgriddemolaz_rsrc.txt0000644000175000017500000000003114346341266024405 0ustar dbannondbannon./kgrid_icons/_cube.bmp tomboy-ng_0.39-1/kcontrols/resource_src/tkdbgrid.bmp0000644000175000017500000000062614346341266022443 0ustar dbannondbannonBMv(   |B~`fffffff`bUfeRUf`fffffff`eUfeUUV`fffffff`eUfe%UfP`fffffffU0`bTFeUUV30`fdDffdF3 DDD%0`fdDfdDF30DDD3"""4DDDAR333$DDD33334DDA3%%"4DDU333"DDA33333TDR333"DA"R%Atomboy-ng_0.39-1/kcontrols/resource_src/tknumberedit.png0000644000175000017500000000210114346341266023342 0ustar dbannondbannonPNG  IHDRw= pHYs  gAMA|Q cHRMz%u0`:o_FIDATx[Le3vgvYT"J 5A_(!>Cc46&ibcBclbjHi "eeݹ[`?ə/9d6Wϭ^ @(>K@ f6/%Dv)mƌ]dpz @Ѐɝ@ҧӻ/.f Z_͞4ӓvPrHN x }S̢W3 d6޲"wit\8|n>gyPJܨ1!b\@cZopS@~^O[/rH* xvEPaRN~깃{y] WX܂ċ9_$y( ︈m"s4t~SWJN݂j ?u˧0s_KNj^<_ٶ|5s[6 <ҍn1V¯ ͌u9AO GN2 *|H '6phYAOm2>0ҥ9SKTeS6,+r/2GڈXtcPH[i9d`xm{esϗiVӛOR\0禙no,ͦ05 J cOaL%9MjZ:J}C1K^_:JX tȎ lz}DcI>}&eg^q\4h@5ךg_5EC9{Zf~WbY&@Lɽ6 L!kժƍ͌DL.1?}/1; 2Ƕ-D L!2`Zd IIjfNh(;6M$?R+顦:mi#t_?w_4qI6~IENDB`tomboy-ng_0.39-1/kcontrols/resource_src/tkmemo.png0000644000175000017500000000176014346341266022153 0ustar dbannondbannonPNG  IHDRw=gAMA7tEXtSoftwareAdobe ImageReadyqe<IDATxڴV[lKq[OYוZ6aDƒKL@=,1ADDƒXA$BmbY\mN9w괌b|]è_-pFp >C$| ^x^WXH('?U/wZ2r4-a x Vs Qk$Zk2B}];C <H(n Wj5ì`4cfx'fC1rf-J~rўoHNXfC+@" dcbqqfq>'fCPJb.vQƕQsLnpz0L!E)#;ZaeLfڳ `qZ4Z(IEQ%IL)}8<s# e]P\]x) "|5j+ M̋D8P;hRL䤋P=s jK"r/!;VpT0(m ~G%3VSDI]>c0 &rdk#iԟ1'vBϾJ͘\q+]h[K  x芾nϚAӖ!هuqMh;B]*g8ɗxbKBejgkTܐ!ǹmP6Ycj0H!^86J v-ǜpO#(X9S{OnA,h|Wd!IV-@~|8ΧݩCQ-7i%k;B=yJuEWjjʲlN(GJQ4(6y U#U7E"v6}4k;)q'B=Ka2U#;g" 4IENDB`tomboy-ng_0.39-1/kcontrols/resource_src/tkprintpreview.bmp0000644000175000017500000000062614346341266023746 0ustar dbannondbannonBMv(   @B~UUUUUUPUUUUU UUUUP1UUUU3!UUUU310UUUU#10UUUTA"1UUUTD1LUUUTDDDUUUTDUTDLUUUTDUDDUUUTDDDLUUUTDDDUUUTDD@UUUTDTDUUUUDDLUUUUTDUUUUUDL Ltomboy-ng_0.39-1/kcontrols/resource_src/tkgradientlabel.png0000644000175000017500000000205114346341266024005 0ustar dbannondbannonPNG  IHDRw= pHYs  gAMA|Q cHRMz%u0`:o_FIDATxԕ[heefvvvQA"Xm@E)>WA)}IEKA* EC*-PC-MZjCM&$fva&lvΙw9 )%6T@,r,9`+W,"5XdhS2tYZ~1^Z?O [q`i E @wi{\qZ2Nx:yж@(fЄˑ8Sk֔-o? xbB 8R` ]ݝu۳Gz0:-FN{WMۑ>0S6 [Bl[~G^@efiSQqOlŚYTF h:&8H?H .9cbh!?2Wڴ] ma<飢OeQĠcoX/^ޯqo[pu+d4JB`ڝEV a 5aRQ w(]xbEjɺ5' ;k5,'N16_8bEUU[_s&Pj~G%͵BB! RJLf̘A84MLDJYy&d2y<m{GK3hnnUU4440cƌܹ-۷ooJ3xW7!?~dܹyX7?{񔗣(~?ȱ7iteW^U(H)9<]]]W._{% '_]vTTT_d H4D|t׋OYc$쳔١!L]ߧbzR$ Ν;nڴi#ʏ]v\,Yɧ?'-HU^lQ^Ju2}} *x}!Du:;;9?z"qUv1sK.0 2(]K҆=k9ADi$;;Qgbs!B!>S:;;hjjx-<؈a <ɉ\YB\//!%spݻ,Z `Fef߿mRxW7TVV>|r <kOee41P9޳RZmn5ϴ@UU:ڭBy9PL&S___?z詉HK?VXdFóz5% j_II)`?~ĩ6}[hЄkn?tŻwSr cy!ldKX,=vڟlߏOHaʔ)'2@0;w3?|rLӤ`ӧ_3_4Mj =<.a:,hE(1ءCcr@CQg I&5'O>sɳ@v\[͛:y̙f a:\Pg_?3gR3 H$r.f=xߔ);at]oqOAk˖-4M>پxa+A]{0 rDV`УQ 7s&ӷo'JN f-//';((B L\&lh2::ZJtuu9QPEy6uR9uqu]ϓȪ*SmW['dHs\޲,t*׮D"aA(n;V:YoD&8~L-0'୩aOKIRd24DD"o~h4oz4L*eeeB[R 677,Xa|!-޴ L;R7pǻ % ڞu4QǃQZZʬjھMRgX@'0 TUE4B(B?OY)IttԄL&wNfN*"JxH~TK@Qh.*%%%TE1# "$YMZtX fryMJi^/@ ȶ^49S&`&#G}[:dz{ M̽2(4 MPU5o0Mx5ґ}VZZP.`0Xmz @O\9}to/4Bim?gvHy:?1ٳc^VqQ(\UEP4lyϤ!}U!R+#LUUfQ@pq xs~Pq.rR׹bw>"o9scq -bΞ=UsaPL#+W"u}Ȃ,~mb,lepʧOQR2 ǃiB)E׷bEZ[[;֍ 3JH))[z !Xg 2x A|&F7oDae-&L&I$ǏL]XWQ#uϴivtzuFS+Wlj2R]]|"|FMTNj/Z2(-e҆ η6mZAsF" #/ˏފ޻o~3i7nD Q.= ~{y%뮻h6+&zo︐_޻@Ue,-yaֻ} y'2RFw]zPn# wm7`vsT< sygť~l,FϷ7 DmS˝VSq Xn;eUʋ/B(D<ȑ#g}Ç.Qn ȧ~˿jkkCuKJ>_w >sỈ(O[['Nxg! /}kqϝ4iedyi͊#fXKf3ClۆRW>裃[lyq-jMD|뭷ZtirNyyEb?F Xmg$an:łO?m>S%,xj$߿:[p8Y 1Z[v5) k/ '"BQza:u} rp&ۿK,JKJJ4 Q_rHMNO # {//z!H$p8pt:B! yWcTW[H1\BoGw45.YzBpZZZSSSXxl*Pr=DEEŊɓ';;(ݨ Zkk,J[5s\x/C.c%s 2FƍmB #H[0at&app!GGyeǎ1R9̗Zt+W]lنP(tK !  RK:fttD"FOݻwѣGaR|Xĥu555&MT_RRr] vFbEQfTjҥKg[[[;;mM0ۤUUV}E|4ܖxE1 c_mH?eIENDB`tomboy-ng_0.39-1/kcontrols/resource_src/tklog.bmp0000644000175000017500000000337014346341266021770 0ustar dbannondbannonBM6(  baabaa@@@@@@@@@@@@@@@@@@Ĕ111baa@@@@@@@@@baabaabaabaa@@@@@?}}baaĀtomboy-ng_0.39-1/kcontrols/resource_src/tkgradientlabel.bmp0000644000175000017500000000337014346341266024004 0ustar dbannondbannonBM6(  (5,D:SJb[qjz  )5,C;SKbZqj{  (5,C:SJbZqjz  (5+C:SJbZpjz 6,6+D;RKbZ ys6,D:RJvo OGـ ̀ rlD:  [S ր 5,  (\Ssl~wb[  (6+D;SKb[ )5,C;SKbZpj )6+D;RJbZpjztomboy-ng_0.39-1/kcontrols/resource_src/tkbitbtn.png0000644000175000017500000000237714346341266022505 0ustar dbannondbannonPNG  IHDRw=gAMA7tEXtSoftwareAdobe ImageReadyqe<IDATxU[hefwdtn&bFH+j^@TR(UA|A`I|[M&i$&i7nMv{fܴMA(ycf||9~A"h^ RE+B* }rvrB? UB)!&űg8` i%6#,8X&3J +᷌I)i[!" ^X}\ %o,Oϔ4aM];/ 2 )MQ/,ӏ8!:˓kF>:RȉTכK2n%mصyJJ 7:;Ѫ׹=؞-;8 UAY#@W=IET%BbjܠH0 ,bR)!~3t';&01rAE>RMN]7 >'T_'-f"kxJa@E j0aX-xey܄%C)C | Js>C@n.)I"fp4ɜ/+EBOE,h8q(ޯ`Հ54a9ZV0⸲&Jlomy Eo$ 7v~u%ID$SGa}N.´dUrX>f7O!9:5CJw ̊CSu c$4MC67 jQ mbL$ -E&b~r,0~<1E-p(n1q_ C?'ۇPTO⁆)<ǦMNF[~@|S L +#/v-#qKd$Ctxꚁ5ÖwX^^Cs~d*0mz8 #'*IWI[&EShsYq[Z} ϋ*@5eAКFA=Tؙl|xڴj2P17@R%:^jć]=_wh4 yg&? nk 0Uk *IENDB`tomboy-ng_0.39-1/kcontrols/resource_src/arrow.bmp0000644000175000017500000000266214346341266022005 0ustar dbannondbannonBM6(|tomboy-ng_0.39-1/kcontrols/resource_src/tksplitter.png0000644000175000017500000000203614346341266023061 0ustar dbannondbannonPNG  IHDRw=gAMA7tEXtSoftwareAdobe ImageReadyqe<IDATxԕMlE;;c&qRBhRʁ.HP  J'([(j$qzycMWpbx{V<[T"H1". 'V?8.Q%\:l#zNkݜjݬ{? ~8]8W! Sp=dk"n3W{dfDvGa~!&oRK<㈒}קL=T?W*n'l?s,Xf>|gכ`h@m]}Ǖez.KG-464(`Xzg;F WBާL3eojnƷ3IDPe+yx "{<'2M BA'E\]`{.G,(*Z&{UiY#6Qw7x1Ee[֑;Ӆbukj Uqyp둫6w݆i ] s:)m7[ *qp$xjZbނs6N~x A7sҐV+$e%|M]:kKaG*A4UՔwsuo)JT-[xl7֧'BP0.b}< kQ)!U7JAp6'0pߝ06M٧ډƑ֨lzuRiyؖ:4ԍDWkY[bpd,T+t^#fslu!0&J%tN}..6.[o9K/ao ʒz?_Ǝmz'T|:՜_JUÍ>Ug_YCEm%.c^IENDB`tomboy-ng_0.39-1/kcontrols/resource_src/kpreview_cursor_hand_free.cur0000644000175000017500000000050614346341266026105 0ustar dbannondbannon 0( @?wg tomboy-ng_0.39-1/kcontrols/resource_src/kgrid_cursor_hresize.cur0000644000175000017500000000050614346341266025107 0ustar dbannondbannon 0( @@@@@2LRJyyRJ2L@@@@?????3113?????tomboy-ng_0.39-1/kcontrols/resource_src/tkprintpreview.png0000644000175000017500000000344414346341266023755 0ustar dbannondbannonPNG  IHDRw=gAMA|Q cHRMz%u0`:oIDATxb?###Pbk fFVVfF^ ā* _b7ݽ/<<,r ?_3| ~`8v^)(HHy_|ޱfqbD󁌽;v/@H3-_2ABM{Y~ps3t }`g@ 9 Y؀ra`f`fba8>VEK ,`ffa02pq1[_c b ff48 $,bo cfB{IIQaa.9'4nK3j-%õ * l "5* y!d@d>&4C#cY9yyWN00rBbc8A(,O"P}@vԪ~P ,X sNN߾1s2|tOws00 $( Z3(i)mt܄@aZlp0|AZT獏 >cdc``ibu0Dxi|?3@a(a :** I~2Ǖ T%Ġ,àT @ "F&g/_3|_L ~հ3&2a NWiA EAIQXk$3 w|`Wæ*>ӇA"Zaߟ3 c~O$BL ~w_1 Q3d82y_DA@؃cf>[`ꑿ |*f/Vn}} _DBN0 0<70>| % ów_}W:9q)qi3?wGš@<ׯd9>pC&3i ~ OcõEم9P…ۯ} ,>``x%îC'Tn.NF#̂vV < =f8}:%$ L8i0Ղ+  0rKJSϥk>|lk`o@U&.߼ws 1Zy5,HxLO^epYE.߶eS'OO@b\ (4[pMf1ekIENDB`tomboy-ng_0.39-1/kcontrols/resource_src/tkspeedbutton.png0000644000175000017500000000226514346341266023553 0ustar dbannondbannonPNG  IHDRw=gAMA7tEXtSoftwareAdobe ImageReadyqe<GIDATxU[hU\v'K6f6!ƒV> *"/SP- ⃈h$U$*1IlL&fvnL7 E<109~}W D BgEBpMƗCk 6[z<ؙ6X_?l@"!J(#$i2ngcs!цHE9i`* (Ip DUf_?Jd37B " 4-Ϛh(IK9[x*ԞԆ$B~>Ґ^%t(AkS /e!kZ&;fAďmufM^%xi^OafGɨTBץ.߹Q绱i0b~Zx|-1AHp9CQUNl"`:QMnSCds̿? ֛C\}Hklz ,qd]$X184 ᐈqHrzσ9Z,ead s(4f.!QplM َbX!SsR`;|x^2:)>HpD+)f` X$Q?,F%"ù=3܁f0EpNcӲ8ԏC^3?9: aF=¸3sg\9 V0mRVK2@zdSMJOW_̻GwfE5CYpJV{ ʰ` +.0 Xꝁ~5|,;2&BN1QX\ۍ+CE.cO[hؽhJrNtK'?-ŭW}-^)Ѹr}7'{ L9PΤ̹n".ŵ]$#S^"V*_ gX;\dm꜁lA}^v1u s3a{bfCke?+~L#WQkhw= ,斒㕃m3]E X`xz1l~ hY4ŋQ p LpKXY880p.6yncanQF^b> T@ h 3pa6 ~KO1I2)2(lu``e[@>Ű{Caa@K.L~C Kdϒ < b ̞ |q۟ f`8A  5R ~ ( _0*p`X@DU~pS^1w waX@DC;lëL ap *0rg; لMULeh }0`;\@߿b_HJ2d6cp|e, $ R 2s5A<<ǰ^&F0ϕ*1%3} /~3ccn-m/@CX f`Q ,"8..83 /Oc26ZY95$@ H'V-@1S8İ{.v/N@riFg {1e~o';}@L i@D  } @DE2O( (D B1^',Q~IENDB`tomboy-ng_0.39-1/kcontrols/resource_src/tkbrowsefolderdialog.png0000644000175000017500000000227514346341266025075 0ustar dbannondbannonPNG  IHDRw= pHYs  gAMA|Q cHRMz%u0`:o_F3IDATxڴ]U733nnJHg V{P7ID$E tEdek[f:?37wNjKsu8/}y7zH-SNS Mh]װm LH$D H9Mr/DQ0ϾɅMtkB@?pi&Z.s }C\4F w.2F,'yraco_~vITWk b]e #:Q/42k%;:4 CnEo!=%뻺H"rN9Ķմ5(e{U6Mou0n13S!Nlok;ϺЋ(//{hkH>$08x. 0n,fRбmX,BU>EӪ'nj% y.\H#"jQpde#{'f{`LUF~It@+ژmhе#{YG.p _u]8p4iLư,/ =*x:jEu`5_,[殗ejҟ.]BGG#ECԪ-P#,TR2 غc]U2Cr[CmvI@e(H0V*W5HE^ٿa̓$FSaۨ-0-ZhqV8ķIB믠G7L(_ra!OFteZ]JAU@7fIqS ճ<4Mcnn'ӣR|d*ϡdd c:K iB0?_ rE@9.),T5C (U_">Ţl)/PR&HR.(t(CJ @S.W WKm[avnS$7JVz\,wcN!RԝH?VXBIENDB`tomboy-ng_0.39-1/kcontrols/resource_src/kgrids.rc0000644000175000017500000000113214346341266021753 0ustar dbannondbannonkgrid_hci_hbegin RCDATA "./kgrid_icons/kgrid_hci_hbegin.bmp" kgrid_hci_hcenter RCDATA "./kgrid_icons/kgrid_hci_hcenter.bmp" kgrid_hci_hend RCDATA "./kgrid_icons/kgrid_hci_hend.bmp" kgrid_hci_vbegin RCDATA "./kgrid_icons/kgrid_hci_vbegin.bmp" kgrid_hci_vcenter RCDATA "./kgrid_icons/kgrid_hci_vcenter.bmp" kgrid_hci_vend RCDATA "./kgrid_icons/kgrid_hci_vend.bmp" kgrid_drag_arrow RCDATA "./kgrid_icons/kgrid_drag_arrow.bmp" kgrid_sort_arrow RCDATA "./kgrid_icons/kgrid_sort_arrow.bmp" kgrid_cursor_hresize CURSOR "kgrid_cursor_hresize.cur" kgrid_cursor_vresize CURSOR "kgrid_cursor_vresize.cur"tomboy-ng_0.39-1/kcontrols/resource_src/kmessagebox.rc0000644000175000017500000000031414346341266023001 0ustar dbannondbannonkmessagebox_stop RCDATA "kmessagebox_stop.png" kmessagebox_question RCDATA "kmessagebox_question.png" kmessagebox_warning RCDATA "kmessagebox_warning.png" kmessagebox_info RCDATA "kmessagebox_info.png"tomboy-ng_0.39-1/kcontrols/resource_src/tksplitter.bmp0000644000175000017500000000337014346341266023055 0ustar dbannondbannonBM6(  𠠠𠠠𠠠𠠠𠠠𠠠𠠠tomboy-ng_0.39-1/kcontrols/resource_src/kmessagebox_info.png0000644000175000017500000000612714346341266024204 0ustar dbannondbannonPNG  IHDR00W IDATh[ly%\DDi1+P_Dhbh)]wNF. 0\ڢڢ@U\E ؕqױԶd)%4uD=fŜgɥ;;Ýy{fvO9&h1>!A ".:WִkyQo2~/ y"ɜR`J)=8jWS*ikZRA]?87Oڿ(OL`ęgضeQ:6Khim,,LmJUV%JmUyk&]c X^byvutY5xv%Г d hmWW(ەߜѳѿ' gp[M7bQKb %-HQgeufm埋8u 836?pxoƍ{-l'(zN<&Zh:r2,=he6׮6ԆDcNzNZ{R]=n"Lm1v}1ӷ'vVZ(Pأ9{(WFS|ws<\ߠRs4ßfK/\~m//:FG߻^e+xI'w_-ɐo}TADˏhfel M׮߿VbHJZڿg[&UKQ?zpN /px%L,*xHM1 #0$Bdę?߷{ɽcw=]m@EL7hٚt~ !cR* A}#4:3&b@õ7&pr +!`M}YANhL~Ю'*B'<51>+o~ 1{XWDJ+]lR6>cX؞/׀|1٠x}tjH(ꓬq$}] 誵 43d S@`:4qIdnF* Ca} F2pMm7/jMFTi{F!]`a`Tמ77mśAfqr~r[S;B@27ݭFkhLK;x_.*z,$"a( 3S>~EԤ^vޕ p=W]0~W]Mr{230Lced,\e),K0-8hh8*mkoז9Ϝ[Y|~_t3ŋHo'e ۧޑI1~#Wا +ZUYuvŮݟioN/]:NkxYD,LYe̠H8x^fo୪?`(U?_#=IENDB`tomboy-ng_0.39-1/kcontrols/resource_src/tkpagecontrol.png0000644000175000017500000000204514346341266023530 0ustar dbannondbannonPNG  IHDRw=gAMA7tEXtSoftwareAdobe ImageReadyqe<IDATxڴU]lSe~9==vznְn#U::ⅈ%JT.@.c7^v MWݘhpiTY Zߞ{-۴&O>=LĿz/!5GÆ`an"A}o#-buNG&pZ:&+q8y(ۭt-XjB돽'˹Y0|Dw"G?>n/_Jvf !N!B^Z!P(W[s"3-z%LwUU }8g pbnd)JX(g+b xX2mG^.fy1v?+IG)a kG UUyQ {A\@,P' O003cafXt G X_NmaP,-,"Da?`P3ׯ e`¿o2{aL ܎ 5:XS@L[DKo1B +7C\獏 Nedc``z?ï۟81, ATQ1dbPb_pM?aýO2]ax?._ n|.D _Ҧ agM`xuþŇ20ȁ$d~ar=CFD@ ŰoICCYl < r$[p}}Kπ-fDf~f.Fv~kNkdeԌQ–_H0dn`92ó>|$Aؚ$/EycáC;p>&F0*ǰjUß?佸?agS֯ ~6@1"e)9^ΐѺAUO f@_b{$ Y"V<` ߿vð-1xx812DF19l˗~:bA\~0=v7n܅U~f^ @>x4æMfΜO>z5w\?}D 0wU0}EgVH>72ӧ01CD݅.]§ W,(j x{31N @CY Z@ `MIENDB`tomboy-ng_0.39-1/kcontrols/resource_src/tkgrid.bmp0000644000175000017500000000062614346341266022135 0ustar dbannondbannonBMv(   @B~"!"!"!!!!!"!!!!!""!"!!ADA03334D33DD02"34D"4DA03334D3DD02"34DDDA03334DDD02"34DDC03334D4D02"32D"DA03333434DDA03333333Atomboy-ng_0.39-1/kcontrols/resource_src/tkmemo.bmp0000644000175000017500000000337014346341266022144 0ustar dbannondbannonBM6(  tomboy-ng_0.39-1/kcontrols/resource_src/tkhexeditor.bmp0000644000175000017500000000062614346341266023203 0ustar dbannondbannonBMv(   @B~ETETDETEDC4CD3D4CDC4CD333DEC4CDDD3DEC4CD3D4CDDD34DC4CDC33333335C#"&b#""53336f336e"#"&f#"ff3336f36fe"#"&f#ff53336fffc5"#"&fff"53336ffc35"#"&f&f"53333f3fc5"#""&#&f53333333fe`tomboy-ng_0.39-1/kcontrols/resource_src/tkprintsetupdialog.bmp0000644000175000017500000000062614346341266024605 0ustar dbannondbannonBMv(   B~XXXXXXXXXXSS333330XXUUUUUSPeUUUUS0X0XUUTEUX0XSD5EXXDDD$DPDEXXXPDDDXDDDEXXXXDDDXXDD@XXXXTDTDXXDDEDwwwwwwwDH333333334C1tomboy-ng_0.39-1/kcontrols/resource_src/kdesign_laz.bat0000644000175000017500000000033014346341266023123 0ustar dbannondbannonlazres ..\packages\kcontrols\kcontrolsdesign.lrs @kcontrolsdesign_laz.txt lazres ..\packages\kgrid\kgriddesign.lrs @kgriddesign_laz.txt lazres ..\packages\khexeditor\khexeditordesign.lrs @khexeditordesign_laz.txt tomboy-ng_0.39-1/kcontrols/resource_src/tklinklabel.png0000644000175000017500000000176514346341266023160 0ustar dbannondbannonPNG  IHDRw= pHYs  gAMA|Q cHRMz%u0`:o_FkIDATxԕKh\U=y?36&6J!Zu!fji`%)$"ԍ .+"iAQsm!hIg!x~+p _NKOK`~20XW- %'$h<*`4,în3UyXd!ُRkUaa_PSs`/,ܻ5@u CZM}y{$.f4F1JT t+.xhZ/Z% Uer, 7\K#/9tj8sUSphpL7ӗnagJsrpKvI2O᥽f5}cd9HW'4;9ZBkçq*q2H`)x@֧7Z?3x괆e7_}%aV QvO3B>' Sb" +%v OmJX*;4{z̈NR"rP1#Vr2j֢dָ5ݪ;IENDB`tomboy-ng_0.39-1/kcontrols/resource_src/tkcolorbutton.png0000644000175000017500000000225414346341266023567 0ustar dbannondbannonPNG  IHDRw=gAMA7tEXtSoftwareAdobe ImageReadyqe<>IDATxU]hU=ΝI?l&)MiVP"⃔VlJQ(J">AcJ`Bk?!Ig7;;3wL661j7rؙ;~} SJǏ@#(!MTa0M!!**mʖTTC~~H'0!FTQfM;^y6ɇj.؉_DBEPZ^pxs<4}~+OYx(O>f?l&ӚRzJ5Jǩ?xr/ 81 V߰nU+p=bե\7}h4`*0 0h-(,Kʥs]S_QC؀߿WHuߦ#o#0/\/xn߮9 mv\( 3NmS+1`|߃h}@;628Lpt.YIA 7,,Ѭ-x;/w9|/n޸=l&'뜾hzA=k0.b@{ 4=}0I&CKs[sgV5`=n۹}:/ؼ5Qb]MqjdʘA8ZA!oZկgUO E#;7dssެO2l ֙(W]~N5RD@HT8 ̉_xj ..o@7Uf}]&_(A5Zg|Gy~e Dx?$vJp/)t۱-yoMyᶛVm=CۀlJƮ([so{. =4n{G~|drh B$#ѿXK'СD!}w\Eytc)pk^a<}FƗkn˺$?H2gݞHe" _xgq)= -۷qff. @ߒٷ(V\ה*_mvz}/YR #L@#$H/b+Gbw{A:f c+94YToQJPyL:2+,R9OȮ-F D5rʥF2 ` hR)틅`k/1,>:LfM^=ZϿ3͛'jA2!l Iz#?YdזTLjmL,il~4S6S3>THf<2R>Y|d#HafdGwV%)z`8=Q+ 7hw}M)<.l:לPs@RE{M0< ]2 lawsiUtR /zA"l=MJ_}ne(w3 0 D~t !wg)ռ+54Z,qs_K. .\!7RuáF +=`@FJVA!8x44lYkuH'?t R$ ٪k Rh !`RȤ_t.~SixmŦU^rULGϻd+E!HFoSh45l|M:`Zƪfh>{}.ug~^?ިN h1#-R!4)̴<"[Q44lB 2hgcxϦU&w|fxIxk7+з*Pk:bCBPR`:2P@>P,T^q._~iZC\"7@Az Z`^5оwTłC A;$m4[XOvH?|ل|t.@Cg@PpCךE G's1ٽ%Zl{&>3}GX PB:_"~|ߩ <>R(0]q\;h@+5L]p1)J+Rbs +r8`^)I:!7B 6jMTqL#jq)b3<[\Y @G蔒_NjMfDY~\u81;[bI;=UJ8ovG !gi e# 4W}SvT%)Xt$HHydJ)̤J)R9tIf.ZDqm: $RzG:JnZFC%ҩ} :Ҡ͈6=CRy&0PF \S;P =G&ѵB-B Q\_tY+ ]߾OVBkF~كrg3y.V/2ZK'8<]Uê<@6)4*^{y +%PF(pHrT.yScN?{CFjpMOV檭4M)A';]k]Tm85H@6UdJ*/tr#7Qxl xkϿ[I~Le29${~j3˅&ԥ$İT%nu~tW^:q;jMv] _~aƷ+?Όl}BQ8= Ne\1#\JaP24??ȡ7N?p Ǧc/y7ATMCK#XIa.c{Ȏ~?81/&Lbcء'&7F/ z@f}~kw sňodP%(p*>0%}i`NK t sKߎf{mfzp\(3MR@k7STڥ♉ެ-q(6U/`CИ$d8(IxZFo/w; =IENDB`tomboy-ng_0.39-1/kcontrols/resource_src/kpreview_cursor_hand_grip.cur0000644000175000017500000000050614346341266026125 0ustar dbannondbannon 0( @??`tomboy-ng_0.39-1/kcontrols/resource_src/tkhexeditor.png0000644000175000017500000000220114346341266023200 0ustar dbannondbannonPNG  IHDRw=gAMA|Q cHRMz%u0`:o IDATxb?y`?`b^ bq(> ~@,$ $X(*@yM6nn###VXYxx8xy8Yb"" r &Z 3~ 2s3|Ġǹ P|@lp}t7?2q1gcV>*b@A؈da=7w+'0f oMNN^GifA6 OoaPdk5IJ s ÷Gu\c0`. VO $%. g8p~>G D3yg>1p02\z` /7@ 28{wF003}/ G>13 3p;J0֘0s2D@B/8C|2\獏 Nedc``)duÅo,,LAYG >xΞ~{2}e`~. A X?D@>P3&I1İo fF!U`~;@PMUNȒο' ["q02P@} #`n. LEr(Fo _/zA?n& ?L,8{AEȠ, ;ќA ^ ,WEix>cA<j`| ,_ttT>>`bgecu kGIsN3}d,( LBtH߁qnG`KC@1 XT,o?Tu6@LD_`b09pmDB;"@Dl|rhA@X`‡yD @WVq d2@ dETIENDB`tomboy-ng_0.39-1/kcontrols/resource_src/tkpagecontrol.bmp0000644000175000017500000000337014346341266023524 0ustar dbannondbannonBM6(  𠠠𠠠𠠠𠠠𠠠𠠠𠠠𠠠𠠠𠠠𠠠𠠠𠠠𠠠tomboy-ng_0.39-1/debian/0000755000175000017500000000000014551457755014664 5ustar dbannondbannontomboy-ng_0.39-1/debian/copyright0000644000175000017500000001216414551457755016623 0ustar dbannondbannonFormat: https://www.debian.org/doc/packaging-manuals/copyright-format/1.0/ Upstream-Name: tomboy-ng Upstream-Contact: David Bannon Source: https://github.com/tomboy-notes/tomboy-ng Files: * Copyright: 2017-2022 David Bannon License: The-Clear-BSD-License Files: source/libnotify.pas Copyright: (C) 2011 Ido Kanner idokan at@at gmail dot.dot com License: GPL-2.0-or-later Files: kcontrols/* Copyright: 2022 Tomas Krysl License: The-Clear-BSD-License Files: source/hunspell.inc Copyright: 2002 Kevin Hendricks License: MPL1.1/GPL2.0/LGPL2.1 Files: source/jsontools.pas Copyright: 2019 Anthony Walter License: LGPL-3 License: The-Clear-BSD-License Redistribution and use in source and binary forms, with or without modification, are permitted (subject to the limitations in the disclaimer below) provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. NO EXPRESS OR IMPLIED LICENSES TO ANY PARTY'S PATENT RIGHTS ARE GRANTED BY THIS LICENSE. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. License: GPL-2.0-or-later This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. . This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. . You should have received a copy of the GNU General Public License along with this package; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA . On Debian systems, the full text of the GNU General Public License version 2 can be found in the file `/usr/share/common-licenses/GPL-2'. License: MPL1.1/GPL2.0/LGPL2.1 The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for the specific language governing rights and limitations under the License. The Original Code is Hunspell, based on MySpell. The Initial Developers of the Original Code are Kevin Hendricks (MySpell) and Németh László (Hunspell). Portions created by the Initial Developers are Copyright (C) 2002-2005 the Initial Developers. All Rights Reserved. Contributor(s): David Einstein, Davide Prina, Giuseppe Modugno, Gianluca Turconi, Simon Brouwer, Noll János, Bíró Árpád, Goldman Eleonóra, Sarlós Tamás, Bencsáth Boldizsár, Halácsy Péter, Dvornik László, Gefferth András, Nagy Viktor, Varga Dániel, Chris Halls, Rene Engelhard, Bram Moolenaar, Dafydd Jones, Harri Pitkänen Alternatively, the contents of this file may be used under the terms of either the GNU General Public License Version 2 or later (the "GPL"), or the GNU Lesser General Public License Version 2.1 or later (the "LGPL"), in which case the provisions of the GPL or the LGPL are applicable instead of those above. If you wish to allow use of your version of this file only under the terms of either the GPL or the LGPL, and not to allow others to use your version of this file under the terms of the MPL, indicate your decision by deleting the provisions above and replace them with the notice and other provisions required by the GPL or the LGPL. If you do not delete the provisions above, a recipient may use your version of this file under the terms of any one of the MPL, the GPL or the LGPL. License: LGPL-3 On Debian systems, the complete text of the GNU Lesser General Public License can be found in /usr/share/common-licenses/LGPL-3. tomboy-ng_0.39-1/COPYING0000644000175000017500000000134614551457644014476 0ustar dbannondbannonUnless noted, all tomboy-ng code in this repository is - Copyright David Bannon 2017 - 2022 Please see the file debian/copyright for license details. Note that the following addition license terms apply to the hunspell DLL supplied with Windows (but is not shipped with the other platform's specific distributions) : Licence file for associated libhunspell.dll This 64bit libhunspell.dll was compiled from the original source from https://github.com/hunspell/hunspell with Microsoft Visual Studio Community 2015. As such its covered by the hunspell licence and is free to use or distribute with your programme but this license file should remain with it. Many thanks to rvk from the Lazarus Forum for assistance with this.