?? dbccbox.pas
字號:
begin
inherited KeyPress(Key);
if (Key in [#32..#255]) and (FDataLink.Field <> nil) and
not FDataLink.Field.IsValidChar(Key) then
begin
MessageBeep(0);
Key := #0;
end;
case Key of
^H, ^V, ^X, #32..#255:
FDataLink.Edit;
#27:
begin
FDataLink.Reset;
SelectAll;
end;
end;
end;
procedure TDBCodeComboBox.EditingChange(Sender: TObject);
begin
SetEditReadOnly;
end;
procedure TDBCodeComboBox.SetEditReadOnly;
begin
if (Style in [csDropDown, csSimple]) and HandleAllocated then
SendMessage(EditHandle, EM_SETREADONLY, Ord(not FDataLink.Editing), 0);
end;
procedure TDBCodeComboBox.WndProc(var Message: TMessage);
begin
if not (csDesigning in ComponentState) then
case Message.Msg of
WM_COMMAND:
if TWMCommand(Message).NotifyCode = CBN_SELCHANGE then
if not FDataLink.Edit then
begin
if Style <> csSimple then
PostMessage(Handle, CB_SHOWDROPDOWN, 0, 0);
Exit;
end;
CB_SHOWDROPDOWN:
if Message.WParam <> 0 then FDataLink.Edit else
if not FDataLink.Editing then DataChange(Self); {Restore text}
WM_CREATE,
WM_WINDOWPOSCHANGED,
CM_FONTCHANGED:
FPaintControl.DestroyHandle;
end;
inherited WndProc(Message);
end;
procedure TDBCodeComboBox.ComboWndProc(var Message: TMessage; ComboWnd: HWnd;
ComboProc: Pointer);
begin
if not (csDesigning in ComponentState) then
case Message.Msg of
WM_LBUTTONDOWN:
if (Style = csSimple) and (ComboWnd <> EditHandle) then
if not FDataLink.Edit then Exit;
end;
inherited ComboWndProc(Message, ComboWnd, ComboProc);
end;
procedure TDBCodeComboBox.CMEnter(var Message: TCMEnter);
begin
inherited;
if SysLocale.FarEast and FDataLink.CanModify then
SendMessage(EditHandle, EM_SETREADONLY, Ord(False), 0);
end;
procedure TDBCodeComboBox.CMExit(var Message: TCMExit);
begin
try
FDataLink.UpdateRecord;
except
SelectAll;
SetFocus;
raise;
end;
inherited;
end;
procedure TDBCodeComboBox.WMPaint(var Message: TWMPaint);
var
S: string;
R: TRect;
P: TPoint;
Child: HWND;
begin
if csPaintCopy in ControlState then
begin
if FDataLink.Field <> nil then S := FDataLink.Field.Text else S := '';
if Style = csDropDown then
begin
SendMessage(FPaintControl.Handle, WM_SETTEXT, 0, Longint(PChar(S)));
SendMessage(FPaintControl.Handle, WM_PAINT, Message.DC, 0);
Child := GetWindow(FPaintControl.Handle, GW_CHILD);
if Child <> 0 then
begin
Windows.GetClientRect(Child, R);
Windows.MapWindowPoints(Child, FPaintControl.Handle, R.TopLeft, 2);
GetWindowOrgEx(Message.DC, P);
SetWindowOrgEx(Message.DC, P.X - R.Left, P.Y - R.Top, nil);
IntersectClipRect(Message.DC, 0, 0, R.Right - R.Left, R.Bottom - R.Top);
SendMessage(Child, WM_PAINT, Message.DC, 0);
end;
end else
begin
SendMessage(FPaintControl.Handle, CB_RESETCONTENT, 0, 0);
if Items.IndexOf(S) <> -1 then
begin
SendMessage(FPaintControl.Handle, CB_ADDSTRING, 0, Longint(PChar(S)));
SendMessage(FPaintControl.Handle, CB_SETCURSEL, 0, 0);
end;
SendMessage(FPaintControl.Handle, WM_PAINT, Message.DC, 0);
end;
end else
inherited;
end;
procedure TDBCodeComboBox.SetItems(Value: TStrings);
begin
Items.Assign(Value);
DataChange(Self);
end;
procedure TDBCodeComboBox.SetStyle(Value: TComboboxStyle);
begin
if (Value = csSimple) and Assigned(FDatalink) and FDatalink.DatasourceFixed then
//DatabaseError(SNotReplicatable);
;
inherited SetStyle(Value);
end;
function TDBCodeComboBox.UseRightToLeftAlignment: Boolean;
begin
Result := DBUseRightToLeftAlignment(Self, Field);
end;
procedure TDBCodeComboBox.CMGetDatalink(var Message: TMessage);
begin
Message.Result := Integer(FDataLink);
end;
function TDBCodeComboBox.ExecuteAction(Action: TBasicAction): Boolean;
begin
Result := inherited ExecuteAction(Action) or (FDataLink <> nil) and
FDataLink.ExecuteAction(Action);
end;
function TDBCodeComboBox.UpdateAction(Action: TBasicAction): Boolean;
begin
Result := inherited UpdateAction(Action) or (FDataLink <> nil) and
FDataLink.UpdateAction(Action);
end;
procedure TDBCodeComboBox.SetDisplayDatasource(const Value: TDataSource);
begin
if (Value <> FDisplayDatasource) then
begin
FDisplayDatasource := Value;
end;
end;
procedure TDBCodeComboBox.SetCodeField(const Value: string);
begin
if (Value <> FCodeField) then
begin
FCodeField := Value;
end;
end;
procedure TDBCodeComboBox.SetDisplayField(const Value: string);
begin
if (Value <> FDisplayField) then
begin
FDisplayField := Value;
if (assigned(Field)) then
begin
if (Assigned(DisplayDatasource)) then
begin
SetupQueryProperties;
ConstructSQL;
FillComboBoxItems;
ItemIndex := 0;
end;
end
end;
end;
//=============================自定義函數開始=============================
procedure TDBCodeComboBox.SetupQueryProperties;
begin
if Assigned(Field) then
FQuery.DatabaseName := TDBDataSet(Field.DataSet).DatabaseName;
end;
procedure TDBCodeComboBox.ConstructSQL;
var
iPos : Integer;
FOldSQL : string;
FTableName : string;
begin
if (Assigned(FDisplayDatasource) and Assigned(FDisplayDatasource.DataSet) ) then
begin
FQuery.Active := False;
FSQL := 'select ' + FCodeField + ',' + FDisplayField + ' from ';
FTableName := '';
if (FDisplayDatasource.DataSet is TTable) then
begin
FSQL := FSQL + TTable(FDisplayDatasource.DataSet).TableName;
end
else
begin
FOldSQL := UpperCase(TQuery(FDisplayDatasource.DataSet).SQL.Text);
iPos := Pos('FROM', FOldSQL);
if (iPos > 0) then
begin
while (FOldSQL[iPos] <> ' ') do
Inc(iPos);
Inc(iPos);
while ( (FOldSQL[iPos] <> ' ') and (iPos < Length(FOLDSQL)) ) do
begin
FTableName := FTableName + FOldSQL[iPos];
Inc(iPos);
end;
FSQL := FSQL + FTableName;
end;
end;
FQuery.SQL.Clear;
FQuery.SQL.Add(FSQL);
FQuery.Active := True;
end;
end;
procedure TDBCodeComboBox.FillComboBoxItems;
begin
if (FQuery.Active) then
begin
Items.Clear;
While (not FQuery.EOF) do
begin
Items.Add(FQuery.Fields[1].Value);
FQuery.Next;
end;
end;
end;
function TDBCodeComboBox.GetDisplayValue(const sText : string) : string;
begin
try
if (not FQuery.Active) then
begin
try
SetupQueryProperties;
ConstructSQL;
FillComboBoxItems;
except
on Exception do;
end;
end;
Result := '';
if (FQuery.Active) then
if FQuery.Locate(FCodeField, sText, []) then
begin
Result := FQuery.FieldByName(FDisplayField).Value;
end;
except
On Exception do;
end;
end;
function TDBCodeComboBox.GetCodeValue(const sText : string) : string;
begin
try
if (not FQuery.Active) then
begin
SetupQueryProperties;
ConstructSQL;
FillComboBoxItems;
end;
Result := '';
if (FQuery.Active) then
if FQuery.Locate(FDisplayField, sText, []) then
begin
Result := FQuery.FieldByName(FCodeField).Value;
end;
except
On Exception do;
end;
end;
//自定義函數結束
end.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -