?? suidbctrls.pas
字號:
m_VScrollBar.Position := info.nPos;
end;
m_SelfChanging := false;
end;
procedure TsuiDBLookupListBox.UpdateScrollBarsPos;
begin
if m_VScrollBar <> nil then
begin
m_VScrollBar.Left := Left + Width - m_VScrollBar.Width - 2;
m_VScrollBar.Top := Top + 1;
m_VScrollBar.Height := Height - 2;
end;
UpdateScrollBars();
end;
procedure TsuiDBLookupListBox.WMDELETEITEM(var Msg: TMessage);
begin
inherited;
UpdateScrollBars();
end;
procedure TsuiDBLookupListBox.WMEARSEBKGND(var Msg: TMessage);
begin
inherited;
DrawControlBorder(self, m_BorderColor, Color);
end;
procedure TsuiDBLookupListBox.WMHSCROLL(var Message: TWMHScroll);
begin
inherited;
UpdateScrollBars();
end;
procedure TsuiDBLookupListBox.WMKeyDown(var Message: TWMKeyDown);
begin
inherited;
UpdateScrollBars();
end;
procedure TsuiDBLookupListBox.WMLBUTTONDOWN(var Message: TMessage);
begin
inherited;
m_MouseDown := true;
UpdateScrollBars();
end;
procedure TsuiDBLookupListBox.WMLButtonUp(var Message: TMessage);
begin
inherited;
m_MouseDown := false;
end;
procedure TsuiDBLookupListBox.WMMOUSEMOVE(var Message: TMessage);
begin
inherited;
if m_MouseDown then UpdateScrollBars();
end;
procedure TsuiDBLookupListBox.WMMOUSEWHEEL(var Message: TMessage);
begin
inherited;
UpdateScrollBars();
end;
procedure TsuiDBLookupListBox.WMMOVE(var Msg: TMessage);
begin
inherited;
UpdateScrollBarsPos();
end;
procedure TsuiDBLookupListBox.WMPAINT(var Msg: TMessage);
begin
inherited;
DrawControlBorder(self, m_BorderColor, COlor);
end;
procedure TsuiDBLookupListBox.WMSIZE(var Msg: TMessage);
begin
inherited;
UpdateScrollBarsPos();
end;
procedure TsuiDBLookupListBox.WMVSCROLL(var Message: TWMVScroll);
begin
inherited;
UpdateScrollBars();
end;
{ TsuiDBCheckBox }
constructor TsuiDBCheckBox.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := ControlStyle + [csReplicatable];
State := cbUnchecked;
FValueCheck := 'True';
FValueUncheck := 'False';
FDataLink := TFieldDataLink.Create;
FDataLink.Control := Self;
FDataLink.OnDataChange := DataChange;
FDataLink.OnUpdateData := UpdateData;
FPaintControl := TPaintControl.Create(Self, 'BUTTON');
FPaintControl.Ctl3DButton := True;
end;
destructor TsuiDBCheckBox.Destroy;
begin
FPaintControl.Free;
FDataLink.Free;
FDataLink := nil;
inherited Destroy;
end;
procedure TsuiDBCheckBox.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (FDataLink <> nil) and
(AComponent = DataSource) then DataSource := nil;
end;
function TsuiDBCheckBox.UseRightToLeftAlignment: Boolean;
begin
Result := DBUseRightToLeftAlignment(Self, Field);
end;
function TsuiDBCheckBox.GetFieldState: TCheckBoxState;
var
Text: string;
begin
if FDatalink.Field <> nil then
if FDataLink.Field.IsNull then
Result := cbUnChecked
else if FDataLink.Field.DataType = ftBoolean then
if FDataLink.Field.AsBoolean then
Result := cbChecked
else
Result := cbUnchecked
else
begin
Result := cbUnChecked;
Text := FDataLink.Field.Text;
if ValueMatch(FValueCheck, Text) then Result := cbChecked else
if ValueMatch(FValueUncheck, Text) then Result := cbUnchecked;
end
else
Result := cbUnchecked;
end;
procedure TsuiDBCheckBox.DataChange(Sender: TObject);
var
AState : TCheckBoxState;
begin
State := AState;
end;
procedure TsuiDBCheckBox.UpdateData(Sender: TObject);
var
Pos: Integer;
S: string;
begin
if State = cbGrayed then
FDataLink.Field.Clear
else
if FDataLink.Field.DataType = ftBoolean then
FDataLink.Field.AsBoolean := Checked
else
begin
if Checked then S := FValueCheck else S := FValueUncheck;
Pos := 1;
FDataLink.Field.Text := ExtractFieldName(S, Pos);
end;
end;
function TsuiDBCheckBox.ValueMatch(const ValueList, Value: string): Boolean;
var
Pos: Integer;
begin
Result := False;
Pos := 1;
while Pos <= Length(ValueList) do
if AnsiCompareText(ExtractFieldName(ValueList, Pos), Value) = 0 then
begin
Result := True;
Break;
end;
end;
procedure TsuiDBCheckBox.Toggle;
begin
if FDataLink.Edit then
begin
inherited Toggle;
FDataLink.Modified;
end;
end;
function TsuiDBCheckBox.GetDataSource: TDataSource;
begin
Result := FDataLink.DataSource;
end;
procedure TsuiDBCheckBox.SetDataSource(Value: TDataSource);
begin
if not (FDataLink.DataSourceFixed and (csLoading in ComponentState)) then
FDataLink.DataSource := Value;
if Value <> nil then Value.FreeNotification(Self);
end;
function TsuiDBCheckBox.GetDataField: string;
begin
Result := FDataLink.FieldName;
end;
procedure TsuiDBCheckBox.SetDataField(const Value: string);
begin
FDataLink.FieldName := Value;
end;
function TsuiDBCheckBox.GetReadOnly: Boolean;
begin
Result := FDataLink.ReadOnly;
end;
procedure TsuiDBCheckBox.SetReadOnly(Value: Boolean);
begin
FDataLink.ReadOnly := Value;
end;
function TsuiDBCheckBox.GetField: TField;
begin
Result := FDataLink.Field;
end;
procedure TsuiDBCheckBox.KeyPress(var Key: Char);
begin
inherited KeyPress(Key);
case Key of
#8, ' ':
FDataLink.Edit;
#27:
FDataLink.Reset;
end;
end;
procedure TsuiDBCheckBox.SetValueCheck(const Value: string);
begin
FValueCheck := Value;
DataChange(Self);
end;
procedure TsuiDBCheckBox.SetValueUncheck(const Value: string);
begin
FValueUncheck := Value;
DataChange(Self);
end;
procedure TsuiDBCheckBox.WndProc(var Message: TMessage);
begin
with Message do
if (Msg = WM_CREATE) or (Msg = WM_WINDOWPOSCHANGED) or
(Msg = CM_TEXTCHANGED) or (Msg = CM_FONTCHANGED) then
FPaintControl.DestroyHandle;
inherited;
end;
procedure TsuiDBCheckBox.WMPaint(var Message: TWMPaint);
begin
if not (csPaintCopy in ControlState) then inherited else
begin
SendMessage(FPaintControl.Handle, BM_SETCHECK, Ord(GetFieldState), 0);
SendMessage(FPaintControl.Handle, WM_PAINT, Message.DC, 0);
end;
end;
procedure TsuiDBCheckBox.CMExit(var Message: TCMExit);
begin
try
FDataLink.UpdateRecord;
except
SetFocus;
raise;
end;
inherited;
end;
procedure TsuiDBCheckBox.CMGetDataLink(var Message: TMessage);
begin
Message.Result := Integer(FDataLink);
end;
function TsuiDBCheckBox.ExecuteAction(Action: TBasicAction): Boolean;
begin
Result := inherited ExecuteAction(Action) or (FDataLink <> nil) and
FDataLink.ExecuteAction(Action);
end;
function TsuiDBCheckBox.UpdateAction(Action: TBasicAction): Boolean;
begin
Result := inherited UpdateAction(Action) or (FDataLink <> nil) and
FDataLink.UpdateAction(Action);
end;
{ TsuiDBRadioGroup }
constructor TsuiDBRadioGroup.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FDataLink := TFieldDataLink.Create;
FDataLink.Control := Self;
FDataLink.OnDataChange := DataChange;
FDataLink.OnUpdateData := UpdateData;
FValues := TStringList.Create;
end;
destructor TsuiDBRadioGroup.Destroy;
begin
FDataLink.Free;
FDataLink := nil;
FValues.Free;
inherited Destroy;
end;
procedure TsuiDBRadioGroup.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (FDataLink <> nil) and
(AComponent = DataSource) then DataSource := nil;
end;
function TsuiDBRadioGroup.UseRightToLeftAlignment: Boolean;
begin
Result := inherited UseRightToLeftAlignment;
end;
procedure TsuiDBRadioGroup.DataChange(Sender: TObject);
begin
if FDataLink.Field <> nil then
Value := FDataLink.Field.Text else
Value := '';
end;
procedure TsuiDBRadioGroup.UpdateData(Sender: TObject);
begin
if FDataLink.Field <> nil then FDataLink.Field.Text := Value;
end;
function TsuiDBRadioGroup.GetDataSource: TDataSource;
begin
Result := FDataLink.DataSource;
end;
procedure TsuiDBRadioGroup.SetDataSource(Value: TDataSource);
begin
FDataLink.DataSource := Value;
if Value <> nil then Value.FreeNotification(Self);
end;
function TsuiDBRadioGroup.GetDataField: string;
begin
Result := FDataLink.FieldName;
end;
procedure TsuiDBRadioGroup.SetDataField(const Value: string);
begin
FDataLink.FieldName := Value;
end;
function TsuiDBRadioGroup.GetReadOnly: Boolean;
begin
Result := FDataLink.ReadOnly;
end;
procedure TsuiDBRadioGroup.SetReadOnly(Value: Boolean);
begin
FDataLink.ReadOnly := Value;
end;
function TsuiDBRadioGroup.GetField: TField;
Result := FDataLink.Field;
end;
function TsuiDBRadioGroup.GetButtonValue(Index: Integer): string;
begin
if (Index < FValues.Count) and (FValues[Index] <> '') then
Result := FValues[Index]
else if Index < Items.Count then
Result := Items[Index]
else
Result := '';
end;
procedure TsuiDBRadioGroup.SetValue(const Value: string);
var
I, Index: Integer;
begin
if FValue <> Value then
begin
FInSetValue := True;
try
Index := -1;
for I := 0 to Items.Count - 1 do
if Value = GetButtonValue(I) then
begin
Index := I;
Break;
end;
ItemIndex := Index;
finally
FInSetValue := False;
end;
FValue := Value;
Change;
end;
end;
procedure TsuiDBRadioGroup.CMExit(var Message: TCMExit);
begin
try
FDataLink.UpdateRecord;
except
if ItemIndex >= 0 then
TRadioButton(Controls[ItemIndex]).SetFocus else
TRadioButton(Controls[0]).SetFocus;
raise;
end;
inherited;
end;
procedure TsuiDBRadioGroup.CMGetDataLink(var Message: TMessage);
begin
Message.Result := Integer(FDataLink);
end;
procedure TsuiDBRadioGroup.NewClick;
begin
if not FInSetValue then
begin
if ItemIndex >= 0 then Value := GetButtonValue
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -