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
25 glgfx,
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; frame-color: #fff; frame-text-color: #fff; frame-icon-color: #0f0; }'#10+
132 ' #inactive: { text-color: #aaa; 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 ' @cb_listbox: { current-item-back-color: #080; text-color: #ff0; #inactive(#active) { current-item-back-color: #000; } }'#10+
137 ' @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+
143 var
148 var
150 begin
154 try
156 finally
163 var
165 begin
167 begin
179 var
181 begin
183 try
185 finally
192 var
196 begin
198 par := TFileTextParser.Create(st, false, [par.TOption.SignedNumbers, par.TOption.DollarIsId, par.TOption.DashIsId, par.TOption.HtmlColors]);
200 try
202 begin
205 //writeln('new style: <', stl.mId, '>');
207 while (f < Length(styles)) do begin if (strEquCI1251(styles[f].mId, stl.mId)) then break; Inc(f); end;
209 begin
211 end
212 else
213 begin
220 finally
224 // we should have "default" style
232 // ////////////////////////////////////////////////////////////////////////// //
235 begin
243 constructor TStyleValue.Create (const v: AnsiString); begin vtype := TType.Str; sval := Pointer(v); end;
246 begin
255 begin
264 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;
265 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;
266 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;
267 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;
268 function TStyleValue.asStr (const def: AnsiString=''): AnsiString; inline; begin if (vtype = TType.Str) then result := AnsiString(sval) else result := def; end;
271 begin
276 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]);
282 // ////////////////////////////////////////////////////////////////////////// //
287 var
289 begin
296 // split
298 begin
299 // has ctl, and (possible) hash
301 begin
302 // has ctl and hash
304 begin
305 // @ctl#hash
311 end
312 else
313 begin
314 // #hash@ctl
321 end
322 else
323 begin
324 // has only ctl
329 end
331 begin
332 // has hash
336 end
337 else
338 begin
339 // only name
346 // ////////////////////////////////////////////////////////////////////////// //
348 begin
360 begin
373 begin
380 var
385 begin
389 // try control
392 begin
394 begin
395 // has ctl section?
399 // has hash?
401 begin
403 begin
407 // try name, go up with inheritance
409 begin
411 begin
414 // go up
416 begin
418 // for hash section: try parent section first
420 begin
421 {$IFDEF UI_STYLE_DEBUG_SEARCH}writeln('search for <#', hash, '@', ctl, '> at <#', sect.mHashName, '@', sect.mCtlName, '>: hash up');{$ENDIF}
424 {$IFDEF UI_STYLE_DEBUG_SEARCH}writeln(' hash up: trying <#', sect.mHashName, '@', sect.mCtlName, '>');{$ENDIF}
426 begin
429 // move another parent up
432 {$IFDEF UI_STYLE_DEBUG_SEARCH}writeln(' hash up: jumped up twice to <#', sect.mHashName, '@', sect.mCtlName, '>');{$ENDIF}
433 end
434 else
435 begin
436 // one parent up
437 {$IFDEF UI_STYLE_DEBUG_SEARCH}writeln('search for <#', hash, '@', ctl, '> at <#', sect.mHashName, '@', sect.mCtlName, '>: jump up');{$ENDIF}
441 // here, we should have non-hash section
443 // if we want hash, try to find it, otherwise do nothing
445 begin
446 {$IFDEF UI_STYLE_DEBUG_SEARCH}writeln(' search for <#', hash, '@', ctl, '> at <#', sect.mHashName, '@', sect.mCtlName, '>: hash down');{$ENDIF}
448 begin
450 {$IFDEF UI_STYLE_DEBUG_SEARCH}writeln(' found <#', sect.mHashName, '@', sect.mCtlName, '>');{$ENDIF}
453 end
454 else
455 begin
456 // inheritance
460 // parse inherit string
463 // find section
465 begin
466 // ctl
468 else if (strEquCI1251(ctl, '$up$')) then begin if (Length(sect.mHashName) <> 0) then sect := sect.mParent.mParent else sect := sect.mParent; end
472 begin
475 end
476 else
477 begin
478 // hash
480 // dummy loop, so i can use `break`
481 repeat
482 // get out of hash section
484 begin
485 {$IFDEF UI_STYLE_DEBUG_SEARCH}writeln('hash-jump-up: <#', sect.mHashName, '@', sect.mCtlName, '>');{$ENDIF}
488 // check for hash section in parent; use parent if there is no such hash section
489 {$IFDEF UI_STYLE_DEBUG_SEARCH}writeln(' checking parent: <#', sect.mHashName, '@', sect.mCtlName, '> for <#', hash, '>');{$ENDIF}
492 begin
494 begin
495 {$IFDEF UI_STYLE_DEBUG_SEARCH}writeln(' found in parent: <#', sect.mHashName, '@', sect.mCtlName, '> for <#', hash, '>');{$ENDIF}
499 end
500 else
501 begin
502 // we're in parent, try to find hash section
503 {$IFDEF UI_STYLE_DEBUG_SEARCH}writeln(' checking: <#', sect.mHashName, '@', sect.mCtlName, '> for <#', hash, '>');{$ENDIF}
505 begin
506 {$IFDEF UI_STYLE_DEBUG_SEARCH}writeln(' found: <#', sect.mHashName, '@', sect.mCtlName, '> for <#', hash, '>');{$ENDIF}
508 end
509 else
510 begin
511 // reuse current parent, but don't follow inheritance for it
520 // alas
525 // "text-color#inactive@label"
527 var
529 begin
532 //writeln('name:<', name, '>; hash:<', hash, '>; ctl:<', ctl, '>');
537 // ////////////////////////////////////////////////////////////////////////// //
539 begin
546 var
548 begin
552 par := TFileTextParser.Create(st, false, [par.TOption.SignedNumbers, par.TOption.DollarIsId, par.TOption.DashIsId, par.TOption.HtmlColors]);
553 try
555 finally
562 var
564 begin
566 try
568 finally
575 begin
582 begin
589 begin
594 begin
601 begin
609 var
615 begin
618 begin
621 begin
626 begin
635 begin
641 begin
646 begin
648 // ctl
650 begin
655 begin
656 // create new section
663 end
664 else
665 begin
673 continue;
675 // hash
677 begin
682 begin
683 // create new section
690 end
691 else
692 begin
700 continue;
702 // name
706 begin
707 // color
714 begin
716 end
717 else
718 begin
722 end
724 begin
725 // html color
727 //writeln('<', par.tokStr, '>; {', par.curChar, '}');
730 begin
731 // #rgb
735 end
736 else
737 begin
738 // #rrggbb
744 //writeln(' r=', v.r, '; g=', v.g, '; b=', v.b);
746 end
748 begin
751 end
753 begin
756 end
758 begin
759 // string value
762 end
764 begin
766 end
767 else
768 begin
769 // should be int
779 begin
780 // style name
782 begin
784 end
785 else
786 begin