home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 September / Chip_2002-09_cd1.bin / zkuste / delphi / kompon / d56 / JHEADER.ZIP / D6 / JCommon / JCommon.pas < prev    next >
Pascal/Delphi Source File  |  2002-06-02  |  9KB  |  319 lines
  1. {*******************************************************}
  2. {                                                       }
  3. {       jardas.com Visual Component Library             }
  4. {                                                       }
  5. {       Copyright (c) 2001-2002 jardas.com              }
  6. {                                                       }
  7. {       http://www.jardas.com                           }
  8. {                                                       }
  9. {*******************************************************}
  10.  
  11. unit JCommon;
  12.  
  13. interface
  14.  
  15. uses Windows, Graphics, Classes, Controls, Forms, StdCtrls, SysUtils;
  16.  
  17. type
  18.   TJStyle = (jsNormal, jsFlat);
  19.   TJTextStyle = (tsNormal, tsEllipsis, tsFilePath);
  20.   TJTextInfo = record
  21.     Alignment: TAlignment;
  22.     Enabled: Boolean;
  23.     Layout: TTextLayout;
  24.     Font: TFont;
  25.     ShowAccelChar: Boolean;
  26.     Style: TJTextStyle;
  27.     Text: String;
  28.     WordWrap: Boolean;
  29.   end;
  30.  
  31.  
  32. function InitTextInfo: TJTextInfo;
  33. procedure DoDrawFrame(ACanvas: TCanvas; ARect: TRect; AStyle: TJStyle; ADown: Boolean);
  34. function CalckTextRect(ACanvas: TCanvas; ARect: TRect; Info: TJTextInfo): TRect;
  35. procedure DoDrawText(ACanvas: TCanvas; ARect: TRect; Info: TJTextInfo);
  36. function GetCheckRect(ARect: TRect): TRect;
  37. procedure DrawCheckBox(Canvas: TCanvas; ARect: TRect; Checked: Boolean);
  38. procedure ShrinkRect(var ARect: TRect; n: Integer);
  39. function EmptyRect: TRect;
  40. function GetHTMLTextInfo(I: TJTextInfo): String;
  41. function GetHTMLColor(c: TColor): String;
  42. function GetCSVText(S: String): String;
  43.  
  44. implementation
  45.  
  46.  
  47. function InitTextInfo: TJTextInfo;
  48. begin
  49.   with Result do
  50.   begin
  51.     Alignment := taLeftJustify;
  52.     Enabled := True;
  53.     Layout := tlTop;
  54.     ShowAccelChar := False;
  55.     Style := tsNormal;
  56.     Text := '';
  57.     WordWrap := False;
  58.   end;
  59. end;
  60.  
  61. procedure DoDrawFrame(ACanvas: TCanvas; ARect: TRect; AStyle: TJStyle;
  62.   ADown: Boolean);
  63. var
  64.   Style: LongInt;
  65. begin
  66.   case AStyle of
  67.     jsNormal: begin
  68.       Style := 0;
  69.       if ADown then
  70.         Style := BF_FLAT;
  71.       DrawEdge(ACanvas.Handle, ARect, EDGE_RAISED, BF_TOPLEFT or Style);
  72.       DrawEdge(ACanvas.Handle, ARect, EDGE_RAISED, BF_BOTTOMRIGHT or Style);
  73.     end;
  74.     jsFlat: begin
  75.       if not ADown then
  76.       begin
  77.         DrawEdge(ACanvas.Handle, ARect, BDR_RAISEDINNER, BF_TOPLEFT);
  78.         DrawEdge(ACanvas.Handle, ARect, BDR_RAISEDINNER, BF_BOTTOMRIGHT);
  79.       end else
  80.         begin
  81.           DrawEdge(ACanvas.Handle, ARect, BDR_SUNKENINNER, BF_TOPLEFT);
  82.           DrawEdge(ACanvas.Handle, ARect, BDR_SUNKENINNER, BF_BOTTOMRIGHT);
  83.         end;
  84.     end;
  85.   end;
  86. end;
  87.  
  88. function CalckTextRect(ACanvas: TCanvas; ARect: TRect; Info: TJTextInfo): TRect;
  89. const
  90.   Alignments: array[TAlignment] of Word = (DT_LEFT, DT_RIGHT, DT_CENTER);
  91. var
  92.   Style: LongInt;
  93.   R: TRect;
  94. begin
  95.   if Info.Text <> '' then
  96.   begin
  97.     ACanvas.Font.Assign(Info.Font);
  98.     if Info.WordWrap then
  99.       Style := DT_WORDBREAK
  100.     else
  101.       Style := DT_SINGLELINE;
  102.     Style := Style or Alignments[Info.Alignment] or DT_EXPANDTABS or DT_NOCLIP;
  103.     if not Info.ShowAccelChar then
  104.       Style := Style or DT_NOPREFIX;
  105.     R := ARect;
  106.     DrawText(ACanvas.Handle, PChar(Info.Text), Length(Info.Text), R, Style or DT_CALCRECT);
  107.     Result := R;
  108.   end else
  109.     begin
  110.       Result := R;
  111.       Result.Right := Result.Left;
  112.     end;
  113. end;
  114.  
  115. procedure _DrawText(ACanvas: TCanvas; ARect: TRect; Info: TJTextInfo);
  116. const
  117.   Alignments: array[TAlignment] of Word = (DT_LEFT, DT_RIGHT, DT_CENTER);
  118. var
  119.   Style: LongInt;
  120.   R: TRect;
  121.   h: Integer;
  122. begin
  123.   if Info.WordWrap then
  124.     Style := DT_WORDBREAK
  125.   else
  126.     Style := DT_SINGLELINE;
  127.   Style := Style or Alignments[Info.Alignment] or DT_EXPANDTABS {or DT_NOCLIP};
  128.   case Info.Style of
  129.     tsEllipsis: Style := Style or DT_END_ELLIPSIS;
  130.     tsFilePath: begin
  131.       ARect.Right := ARect.Right - ACanvas.TextWidth('...');
  132.       Style := Style or DT_PATH_ELLIPSIS;
  133.     end;
  134.   end;
  135.   if not Info.ShowAccelChar then
  136.     Style := Style or DT_NOPREFIX;
  137.   R := ARect;
  138.   h := DrawText(ACanvas.Handle, PChar(Info.Text), Length(Info.Text), R, Style or DT_CALCRECT);
  139.   R := ARect;
  140.   case Info.Layout of
  141.     tlBottom: R.Top := R.Bottom - h - 1;
  142.     tlCenter: begin
  143.       R.Top := R.Top + (R.Bottom - R.Top - h) div 2;
  144.       R.Bottom := R.Top + h;
  145.     end;
  146.   end;
  147.   DrawText(ACanvas.Handle, PChar(Info.Text), Length(Info.Text), R, Style);
  148. end;
  149.  
  150. procedure DoDrawText(ACanvas: TCanvas; ARect: TRect; Info: TJTextInfo);
  151. var
  152.   f: TFont;
  153. begin
  154.   if not Info.Enabled then
  155.   begin
  156.     ACanvas.Font.Assign(Info.Font);
  157.     OffsetRect(ARect, 1, 1);
  158.     ACanvas.Font.Color := clBtnHighlight;
  159.     _DrawText(ACanvas, ARect, Info);
  160.     OffsetRect(ARect, -1, -1);
  161.     ACanvas.Font.Color := clBtnShadow;
  162.     _DrawText(ACanvas, ARect, Info);
  163.   end else
  164.     begin
  165.       f := ACanvas.Font;
  166.       ACanvas.Font := Info.Font;
  167.       _DrawText(ACanvas, ARect, Info);
  168.       ACanvas.Font := f;
  169.     end;
  170. end;
  171.  
  172. procedure ShrinkRect(var ARect: TRect; n: Integer);
  173. begin
  174.   ARect.Top := ARect.Top + n;
  175.   ARect.Left := ARect.Left + n;
  176.   ARect.Right := ARect.Right - n;
  177.   ARect.Bottom := ARect.Bottom - n;
  178. end;
  179.  
  180. function EmptyRect: TRect;
  181. begin
  182.   Result := Rect(0, 0, 0, 0);
  183. end;
  184.  
  185. function GetCheckRect(ARect: TRect): TRect;
  186. const
  187.   CKBOX_SIZE = 13;
  188. var
  189.   X, Y: Integer;
  190. begin
  191.   X := ((ARect.Right - ARect.Left) - CKBOX_SIZE) div 2;
  192.   Y := ((ARect.Bottom - ARect.Top) - CKBOX_SIZE) div 2;
  193.   Result := Rect(ARect.Left + X, ARect.Top + Y, ARect.Left + X + CKBOX_SIZE, ARect.Top + Y + CKBOX_SIZE);
  194. end;
  195.  
  196.  
  197. procedure DrawCheckBox(Canvas: TCanvas; ARect: TRect; Checked: Boolean);
  198. begin
  199.   with Canvas do
  200.   begin
  201.     ARect := GetCheckRect(ARect);
  202.     Brush.Style := bsSolid;
  203.     Brush.Color := clWindow;
  204.     Pen.Style := psSolid;
  205.     Pen.Color := clBtnShadow;
  206.     Rectangle(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);
  207.  
  208.     if Checked then
  209.     begin
  210.       Pen.Width := 1;
  211.       Pen.Color := clBlack;
  212.       InflateRect(ARect, -3, -3);
  213.       MoveTo(ARect.Left, ARect.Top + 2);
  214.       LineTo(ARect.Left + 3, ARect.Bottom - 2);
  215.       MoveTo(ARect.Left, ARect.Top + 3);
  216.       LineTo(ARect.Left + 3, ARect.Bottom - 1);
  217.       MoveTo(ARect.Left, ARect.Top + 4);
  218.       LineTo(ARect.Left + 3, ARect.Bottom);
  219.  
  220.       MoveTo(ARect.Left + 3, ARect.Top + 3);
  221.       LineTo(ARect.Right, ARect.Top - 1);
  222.       MoveTo(ARect.Left + 3, ARect.Top + 4);
  223.       LineTo(ARect.Right, ARect.Top);
  224.       MoveTo(ARect.Left + 3, ARect.Top + 5);
  225.       LineTo(ARect.Right, ARect.Top + 1);
  226.     end;
  227.   end;
  228. end;
  229.  
  230. function GetHTMLTextInfo(I: TJTextInfo): String;
  231. var
  232.   b, e, t: String;
  233.   a: Integer;
  234. begin
  235.   b := '<p';
  236.   e := '</p>';
  237.   case I.Alignment of
  238.     taCenter: b := b + ' align=center';
  239.     taLeftJustify: b := b + ' align=left';
  240.     taRightJustify: b := b + ' align=right';
  241.   end;
  242.   b := b + '><font';
  243.   e := '</font>' + e;
  244.   b := b + ' face="' + I.Font.Name + '"';
  245.   case I.Font.Size of
  246.     0..8: b := b + ' size=1';
  247.     9..10: b := b + ' size=2';
  248.     11..12: b := b + ' size=3';
  249.     13..14: b := b + ' size=4';
  250.     15..18: b := b + ' size=5';
  251.     19..24: b := b + ' size=6';
  252.   else
  253.     b := b + ' size=7';
  254.   end;
  255.   b := b + ' color=' + GetHTMLColor(I.Font.Color);
  256.   b := b + '>';
  257.   if fsBold in I.Font.Style then
  258.   begin
  259.     b := b + '<b>';
  260.     e := '</b>' + e;
  261.   end;
  262.   if fsItalic in I.Font.Style then
  263.   begin
  264.     b := b + '<i>';
  265.     e := '</i>' + e;
  266.   end;
  267.   if fsUnderline in I.Font.Style then
  268.   begin
  269.     b := b + '<u>';
  270.     e := '</u>' + e;
  271.   end;
  272.  
  273.   t := '';
  274.   for a := 1 to Length(I.Text) do
  275.   begin
  276.     if (I.Text[a] in ['<', '>', ' ']) then
  277.       t := t + '&#' + IntToStr(Ord(I.Text[a])) + ';'
  278.     else
  279.       t := t + I.Text[a];
  280.   end;
  281.   if t = '' then
  282.     t := ' ';
  283.   Result := b + t + e;
  284. end;
  285.  
  286. function GetHTMLColor(c: TColor): String;
  287. var
  288.   r, g, b: Word;
  289. begin
  290.   c := ColorToRGB(c);
  291.   r := c shl 24 shr 24;
  292.   g := c shl 16 shr 24;
  293.   b := c shl 8 shr 24;
  294.   Result := '#' + IntToHex(r, 2) + IntToHex(g, 2) + IntToHex(b, 2);
  295. end;
  296.  
  297. function GetCSVText(S: String): String;
  298. var
  299.   a: Integer;
  300.   c: String;
  301. begin
  302.   Result := '';
  303.   a := 1;
  304.   while a <= Length(S) do
  305.   begin
  306.     c := S[a];
  307.     if S[a] = '"' then
  308.       c := '""';
  309.     if Copy(S, a, a + 1) = #13#10 then
  310.     begin
  311.       c := '\n';
  312.       Inc(a);
  313.     end;
  314.     Result := Result + c;
  315.     Inc(a);
  316.   end;
  317. end;
  318. end.
  319.