1 | unit fODChild;
|
---|
2 |
|
---|
3 | interface
|
---|
4 |
|
---|
5 | uses
|
---|
6 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
|
---|
7 | ExtCtrls, StdCtrls, fAutoSZ, ORFn, VA508AccessibilityManager;
|
---|
8 |
|
---|
9 | type
|
---|
10 | TfrmODChild = class(TfrmAutoSz)
|
---|
11 | lblWarning: TLabel;
|
---|
12 | Panel1: TPanel;
|
---|
13 | lstODComplex: TListBox;
|
---|
14 | Panel2: TPanel;
|
---|
15 | btnOK: TButton;
|
---|
16 | btnCancel: TButton;
|
---|
17 | procedure FormCreate(Sender: TObject);
|
---|
18 | procedure lstODComplexDrawItem(Control: TWinControl; Index: Integer;
|
---|
19 | TheRect: TRect; State: TOwnerDrawState);
|
---|
20 | procedure lstODComplexMeasureItem(Control: TWinControl; Index: Integer;
|
---|
21 | var TheHeight: Integer);
|
---|
22 | procedure btnOKClick(Sender: TObject);
|
---|
23 | procedure btnCancelClick(Sender: TObject);
|
---|
24 | private
|
---|
25 | { Private declarations }
|
---|
26 | FCmdOK: boolean;
|
---|
27 | public
|
---|
28 | { Public declarations }
|
---|
29 | end;
|
---|
30 |
|
---|
31 | function ActionOnComplexOrder(AnList: TStringList; CaptionTxt: string = ''; ShowCancel: boolean = False): boolean;
|
---|
32 | implementation
|
---|
33 |
|
---|
34 | {$R *.DFM}
|
---|
35 | function ActionOnComplexOrder(AnList: TStringList; CaptionTxt: string; ShowCancel: boolean): boolean;
|
---|
36 | var
|
---|
37 | i: integer;
|
---|
38 | frmODChild: TfrmODChild;
|
---|
39 | begin
|
---|
40 | frmODChild := TfrmODChild.Create(nil);
|
---|
41 | try
|
---|
42 | try
|
---|
43 | ResizeFormToFont(TForm(frmODChild));
|
---|
44 | if Length(CaptionTxt)>0 then
|
---|
45 | frmODChild.lblWarning.Caption := CaptionTxt;
|
---|
46 |
|
---|
47 | for i := 0 to AnList.count - 1 do
|
---|
48 | frmODChild.lstODComplex.Items.Add(AnList[i]);
|
---|
49 |
|
---|
50 | if not ShowCancel then
|
---|
51 | begin
|
---|
52 | frmODChild.btnOK.Visible := False;
|
---|
53 | frmODChild.btnCancel.Caption := 'OK';
|
---|
54 | end;
|
---|
55 |
|
---|
56 | frmODChild.ShowModal;
|
---|
57 | if frmODChild.FCmdOK then Result := True else Result := False;
|
---|
58 | except
|
---|
59 | on e: Exception do
|
---|
60 | Result := False;
|
---|
61 | end;
|
---|
62 | finally
|
---|
63 | frmODChild.Release;
|
---|
64 | end;
|
---|
65 | end;
|
---|
66 |
|
---|
67 | procedure TfrmODChild.FormCreate(Sender: TObject);
|
---|
68 | begin
|
---|
69 | FCmdOK := False;
|
---|
70 | end;
|
---|
71 |
|
---|
72 | procedure TfrmODChild.lstODComplexDrawItem(Control: TWinControl;
|
---|
73 | Index: Integer; TheRect: TRect; State: TOwnerDrawState);
|
---|
74 | var
|
---|
75 | x: string;
|
---|
76 | ARect: TRect;
|
---|
77 | SaveColor: TColor;
|
---|
78 | begin
|
---|
79 | inherited;
|
---|
80 | with lstODComplex do
|
---|
81 | begin
|
---|
82 | ARect := TheRect;
|
---|
83 | ARect.Left := ARect.Left + 2;
|
---|
84 | Canvas.FillRect(ARect);
|
---|
85 | Canvas.Pen.Color := Get508CompliantColor(clSilver);
|
---|
86 | SaveColor := Canvas.Brush.Color;
|
---|
87 | Canvas.MoveTo(ARect.Left, ARect.Bottom - 1);
|
---|
88 | Canvas.LineTo(ARect.Right, ARect.Bottom - 1);
|
---|
89 | if Index < Items.Count then
|
---|
90 | begin
|
---|
91 | x := Piece(Items[index],'^',2);
|
---|
92 | DrawText(Canvas.Handle, PChar(x), Length(x), ARect, DT_LEFT or DT_NOPREFIX or DT_WORDBREAK);
|
---|
93 | Canvas.Brush.Color := SaveColor;
|
---|
94 | ARect.Right := ARect.Right + 4;
|
---|
95 | end;
|
---|
96 | end;
|
---|
97 | end;
|
---|
98 |
|
---|
99 | procedure TfrmODChild.lstODComplexMeasureItem(Control: TWinControl;
|
---|
100 | Index: Integer; var TheHeight: Integer);
|
---|
101 | var
|
---|
102 | x :string;
|
---|
103 | tempHeight: integer;
|
---|
104 | R: TRect;
|
---|
105 | begin
|
---|
106 | inherited;
|
---|
107 | tempHeight := 0;
|
---|
108 | TheHeight := MainFontHeight + 2;
|
---|
109 | with lstODComplex do if Index < Items.Count then
|
---|
110 | begin
|
---|
111 | R := ItemRect(Index);
|
---|
112 | R.Left := 0;
|
---|
113 | R.Right := R.Right - 4;
|
---|
114 | R.Top := 0;
|
---|
115 | R.Bottom := 0;
|
---|
116 | x := Piece(Items[index],'^',2);
|
---|
117 | TempHeight := WrappedTextHeightByFont(Canvas, Font, x, R);
|
---|
118 | TempHeight := HigherOf(TempHeight,TheHeight);
|
---|
119 | if TempHeight > 255 then TempHeight := 255;
|
---|
120 | if TempHeight < 13 then TempHeight := 13;
|
---|
121 | end;
|
---|
122 | TheHeight := TempHeight;
|
---|
123 | end;
|
---|
124 |
|
---|
125 | procedure TfrmODChild.btnOKClick(Sender: TObject);
|
---|
126 | begin
|
---|
127 | FCmdOK := True;
|
---|
128 | Close;
|
---|
129 | end;
|
---|
130 |
|
---|
131 | procedure TfrmODChild.btnCancelClick(Sender: TObject);
|
---|
132 | begin
|
---|
133 | FCmdOK := False;
|
---|
134 | Close;
|
---|
135 | end;
|
---|
136 |
|
---|
137 | end.
|
---|