[456] | 1 | unit fODChild;
|
---|
| 2 |
|
---|
| 3 | interface
|
---|
| 4 |
|
---|
| 5 | uses
|
---|
| 6 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
|
---|
| 7 | ExtCtrls, StdCtrls, fAutoSZ, ORFn;
|
---|
| 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 := 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.
|
---|