1 (* coded by Ketmar // Invisible Vector <ketmar@ketmar.no-ip.org>
2 * Understanding is not required. Only obedience.
3 *
4 * This program is free software: you can redistribute it and/or modify
5 * it under the terms of the GNU General Public License as published by
6 * the Free Software Foundation, either version 3 of the License, or
7 * (at your option) any later version.
8 *
9 * This program is distributed in the hope that it will be useful,
10 * but WITHOUT ANY WARRANTY; without even the implied warranty of
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 * GNU General Public License for more details.
13 *
14 * You should have received a copy of the GNU General Public License
15 * along with this program. If not, see <http://www.gnu.org/licenses/>.
16 *)
17 {$INCLUDE ../../shared/a_modes.inc}
18 {.$DEFINE UI_STYLE_DEBUG_SEARCH}
21 interface
23 uses
29 type
33 public
36 public
52 public
65 private
74 private
76 // "text-color#inactive@label"
79 public
85 public
91 private
95 private
102 public
110 public
119 // will return "default" (or raise an exception if there is no "default")
123 implementation
126 // ////////////////////////////////////////////////////////////////////////// //
127 const
128 defaultStyleStr =
131 ' #active: { text-color: #fff; hot-color: #f00; frame-color: #fff; frame-text-color: #fff; frame-icon-color: #0f0; }'#10+
132 ' #inactive: { text-color: #aaa; hot-color: #a00; frame-color: #aaa; frame-text-color: #aaa; frame-icon-color: #0a0; }'#10+
133 ' #disabled: { text-color: #666; frame-color: #888; frame-text-color: #888; frame-icon-color: #080; }'#10+
135 ' @button: { back-color: #999; text-color: #000; hot-color: #600; #active: { back-color: #fff; hot-color: #c00; } #disabled: { back-color: #444; text-color: #333; hot-color: #333; } }'#10+
144 var
149 var
151 begin
155 try
157 finally
164 var
166 begin
168 begin
180 var
182 begin
184 try
186 finally
193 var
197 begin
199 par := TFileTextParser.Create(st, false, [par.TOption.SignedNumbers, par.TOption.DollarIsId, par.TOption.DashIsId, par.TOption.HtmlColors]);
201 try
203 begin
206 //writeln('new style: <', stl.mId, '>');
208 while (f < Length(styles)) do begin if (strEquCI1251(styles[f].mId, stl.mId)) then break; Inc(f); end;
210 begin
212 end
213 else
214 begin
221 finally
225 // we should have "default" style
233 // ////////////////////////////////////////////////////////////////////////// //
236 begin
244 constructor TStyleValue.Create (const v: AnsiString); begin vtype := TType.Str; sval := Pointer(v); end;
247 begin
256 begin
265 function TStyleValue.asRGBA: TGxRGBA; inline; begin if (vtype = TType.Color) then result := TGxRGBA.Create(r, g, b, a) else result := TGxRGBA.Create(0, 0, 0, 0); end;
266 function TStyleValue.asRGBADef (const def: TGxRGBA): TGxRGBA; inline; begin if (vtype = TType.Color) then result := TGxRGBA.Create(r, g, b, a) else result := def; end;
267 function TStyleValue.asInt (const def: Integer=0): Integer; inline; begin if (vtype = TType.Int) then result := ival else if (vtype = TType.Bool) then begin if (bval) then result := 1 else result := 0; end else result := def; end;
268 function TStyleValue.asBool (const def: Boolean=false): Boolean; inline; begin if (vtype = TType.Bool) then result := bval else if (vtype = TType.Int) then result := (ival <> 0) else result := def; end;
269 function TStyleValue.asStr (const def: AnsiString=''): AnsiString; inline; begin if (vtype = TType.Str) then result := AnsiString(sval) else result := def; end;
272 begin
277 TType.Color: if (a = 255) then result := formatstrf('rgb(%s,%s,%s)', [r, g, b]) else result := formatstrf('rgba(%s,%s,%s)', [r, g, b, a]);
283 // ////////////////////////////////////////////////////////////////////////// //
288 var
290 begin
297 // split
299 begin
300 // has ctl, and (possible) hash
302 begin
303 // has ctl and hash
305 begin
306 // @ctl#hash
312 end
313 else
314 begin
315 // #hash@ctl
322 end
323 else
324 begin
325 // has only ctl
330 end
332 begin
333 // has hash
337 end
338 else
339 begin
340 // only name
347 // ////////////////////////////////////////////////////////////////////////// //
349 begin
361 begin
374 begin
381 var
386 begin
390 // try control
393 begin
395 begin
396 // has ctl section?
400 // has hash?
402 begin
404 begin
408 // try name, go up with inheritance
410 begin
412 begin
415 // go up
417 begin
419 // for hash section: try parent section first
421 begin
422 {$IFDEF UI_STYLE_DEBUG_SEARCH}writeln('search for <#', hash, '@', ctl, '> at <#', sect.mHashName, '@', sect.mCtlName, '>: hash up');{$ENDIF}
425 {$IFDEF UI_STYLE_DEBUG_SEARCH}writeln(' hash up: trying <#', sect.mHashName, '@', sect.mCtlName, '>');{$ENDIF}
427 begin
430 // move another parent up
433 {$IFDEF UI_STYLE_DEBUG_SEARCH}writeln(' hash up: jumped up twice to <#', sect.mHashName, '@', sect.mCtlName, '>');{$ENDIF}
434 end
435 else
436 begin
437 // one parent up
438 {$IFDEF UI_STYLE_DEBUG_SEARCH}writeln('search for <#', hash, '@', ctl, '> at <#', sect.mHashName, '@', sect.mCtlName, '>: jump up');{$ENDIF}
442 // here, we should have non-hash section
444 // if we want hash, try to find it, otherwise do nothing
446 begin
447 {$IFDEF UI_STYLE_DEBUG_SEARCH}writeln(' search for <#', hash, '@', ctl, '> at <#', sect.mHashName, '@', sect.mCtlName, '>: hash down');{$ENDIF}
449 begin
451 {$IFDEF UI_STYLE_DEBUG_SEARCH}writeln(' found <#', sect.mHashName, '@', sect.mCtlName, '>');{$ENDIF}
454 end
455 else
456 begin
457 // inheritance
461 // parse inherit string
464 // find section
466 begin
467 // ctl
469 else if (strEquCI1251(ctl, '$up$')) then begin if (Length(sect.mHashName) <> 0) then sect := sect.mParent.mParent else sect := sect.mParent; end
473 begin
476 end
477 else
478 begin
479 // hash
481 // dummy loop, so i can use `break`
482 repeat
483 // get out of hash section
485 begin
486 {$IFDEF UI_STYLE_DEBUG_SEARCH}writeln('hash-jump-up: <#', sect.mHashName, '@', sect.mCtlName, '>');{$ENDIF}
489 // check for hash section in parent; use parent if there is no such hash section
490 {$IFDEF UI_STYLE_DEBUG_SEARCH}writeln(' checking parent: <#', sect.mHashName, '@', sect.mCtlName, '> for <#', hash, '>');{$ENDIF}
493 begin
495 begin
496 {$IFDEF UI_STYLE_DEBUG_SEARCH}writeln(' found in parent: <#', sect.mHashName, '@', sect.mCtlName, '> for <#', hash, '>');{$ENDIF}
500 end
501 else
502 begin
503 // we're in parent, try to find hash section
504 {$IFDEF UI_STYLE_DEBUG_SEARCH}writeln(' checking: <#', sect.mHashName, '@', sect.mCtlName, '> for <#', hash, '>');{$ENDIF}
506 begin
507 {$IFDEF UI_STYLE_DEBUG_SEARCH}writeln(' found: <#', sect.mHashName, '@', sect.mCtlName, '> for <#', hash, '>');{$ENDIF}
509 end
510 else
511 begin
512 // reuse current parent, but don't follow inheritance for it
521 // alas
526 // "text-color#inactive@label"
528 var
530 begin
533 //writeln('name:<', name, '>; hash:<', hash, '>; ctl:<', ctl, '>');
538 // ////////////////////////////////////////////////////////////////////////// //
540 begin
547 var
549 begin
553 par := TFileTextParser.Create(st, false, [par.TOption.SignedNumbers, par.TOption.DollarIsId, par.TOption.DashIsId, par.TOption.HtmlColors]);
554 try
556 finally
563 var
565 begin
567 try
569 finally
576 begin
583 begin
590 begin
595 begin
602 begin
610 var
616 begin
619 begin
622 begin
627 begin
636 begin
642 begin
647 begin
649 // ctl
651 begin
656 begin
657 // create new section
664 end
665 else
666 begin
674 continue;
676 // hash
678 begin
683 begin
684 // create new section
691 end
692 else
693 begin
701 continue;
703 // name
707 begin
708 // color
715 begin
717 end
718 else
719 begin
723 end
725 begin
726 // html color
728 //writeln('<', par.tokStr, '>; {', par.curChar, '}');
731 begin
732 // #rgb
736 end
737 else
738 begin
739 // #rrggbb
745 //writeln(' r=', v.r, '; g=', v.g, '; b=', v.b);
747 end
749 begin
752 end
754 begin
757 end
759 begin
760 // string value
763 end
765 begin
767 end
768 else
769 begin
770 // should be int
780 begin
781 // style name
783 begin
785 end
786 else
787 begin