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