rm_insp.pas

进销存·完整的·有数据库的·非常完整·只得参考

  	Parent := Box;
    SetBounds(60, 88, 14, 14);
  end;
  EditBtn := TSpeedButton.Create(Self);
  with EditBtn do
  begin
  	Parent := EditPanel;
    SetBounds(0, 0, 14, 14);
    OnClick := EditBtnClick;
    Glyph.LoadFromResourceName(hInstance, 'RM_INSPPANEL1');
  end;
  ComboPanel := TPanel.Create(Self);
  with ComboPanel do
  begin
  	Parent := Box;
    SetBounds(44, 104, 14, 14);
  end;
  ComboBtn := TSpeedButton.Create(Self);
  with ComboBtn do
  begin
  	Parent := ComboPanel;
    SetBounds(0, 0, 14, 14);
    OnClick := ComboBtnClick;
    Glyph.LoadFromResourceName(hInstance, 'RM_INSPPANEL2');
  end;

  Splitter1 := TSplitter.Create(Self);
  with Splitter1 do
  begin
  	Parent := Self;
    Align := alBottom;
    Cursor := crVSplit;
  end;

  Panel1 := TPanel.Create(Self);
  with Panel1 do
  begin
  	Parent := Self;
    Align := alBottom;
    Height := 54;
    BevelOuter := bvNone;
    BorderWidth := 2;
  end;
  Panel2 := TPanel.Create(Self);
  with Panel2 do
  begin
  	Parent := Panel1;
    SetBounds(2, 2, 172, 50);
    Align := alClient;
    BevelOuter := bvLowered;
    OnResize := Panel2Resize;
  end;
  Label1 := TLabel.Create(Self);
  with Label1 do
  begin
  	Parent := Panel2;
    SetBounds(6, 1, 155, 13);
    AutoSize := False;
  end;
  Label2 := TLabel.Create(Self);
  with Label2 do
  begin
  	Parent := Panel2;
    SetBounds(12, 17, 154, 28);
    AutoSize := False;
    Color := clBtnFace;
    WordWrap := True;
  end;


  Localize;
  FPropAliases := TRMVariables.Create;
  FillPropAliases;

  FPanel1 := TInspPanel.Create(Self);
  FPanel1.Parent := Box;
  FPanel1.BevelInner := bvNone;
  FPanel1.BevelOuter := bvNone;
  PaintBox1.Parent := FPanel1;

  ComboPanel.Parent := FPanel1;
  EditPanel.Parent := FPanel1;
  Edit1.Parent := FPanel1;
  Fw := PaintBox1.Width;
  Fb := TBitmap.Create;

  FItemIndex := -1;
  FItems := TStringList.Create;
  FRowHeight := -Font.Height + 5;
  Box.VertScrollBar.Increment := FRowHeight;
  Box.VertScrollBar.Tracking := True;

  FLB1 := TRMPopupListBox.Create(Self);
  with FLB1 do
  begin
  	Visible := False;
    Parent := Self;
    OnClick := LB1Click;
    IntegralHeight := True;
    ItemHeight := 11;
    FInspForm := Self;
    Style := lbOwnerDrawFixed;
    ItemHeight := 16;
  end;

{$IFDEF USE_TB2k}
	Parent := TWinControl(AOwner);
  Floating := True;
{$ENDIF}
	FullSize := False;
  CloseButtonWhenDocked := True;
  UseLastDock := False;

	SetBounds(438, 179, 184, 308);
  OnResize := OnResizeEvent;
  OnVisibleChanged := OnVisibleChangedEvent;

  FDefHeight := Height;
  OnResizeEvent(nil);
end;

destructor TRMInspForm.Destroy;
begin
  FPropAliases.Free;
  Fb.Free;
  FLB1.Free;
  ClearProperties;
  FItems.Free;

  Inherited Destroy;
end;

procedure TRMInspForm.Localize;
begin
  Font.Name := RMLoadStr(SRMDefaultFontName);
  Font.Size := StrToInt(RMLoadStr(SRMDefaultFontSize));
  Font.Charset := StrToInt(RMLoadStr(SCharset));

  RMSetStrProp(Self, 'Caption', rmRes + 059);
  Label2.Font.Color := clBlue;
end;

procedure TRMInspForm.CloseUp(Accept: Boolean);
var
  ListValue: Variant;
begin
  if FListVisible then
  begin
    if GetCapture <> 0 then
      SendMessage(GetCapture, WM_CANCELMODE, 0, 0);
    if FLB1.ItemIndex <> -1 then
      ListValue := FLB1.Items[FLB1.ItemIndex];
    SetWindowPos(FLB1.Handle, 0, 0, 0, 0, 0, SWP_NOZORDER or
      SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE or SWP_HIDEWINDOW);
    FListVisible := False;
  end;
end;

function TRMInspForm.GetItemType(i: Integer): TRMDataTypes;
var
  p: TProp;
begin
  Result := [];
  p := TProp(FItems.Objects[i]);
  if p = nil then
    Exit;
  Result := p.DataType;
end;

procedure TRMInspForm.OnEventDrawItemColor(Control: TWinControl; AIndex: Integer;
  ARect: TRect; State: TOwnerDrawState);
var
  bmp: TBitmap;
begin
  bmp := TBitmap.Create;
  bmp.Height := 16; bmp.Width := 16;
  bmp.Canvas.Brush.Color := RMColors[AIndex];
  bmp.Canvas.Pen.Color := clBlack;
  bmp.Canvas.Rectangle(0, 0, 15, 15);
  with TCustomListbox(Control) do
  begin
    Canvas.FillRect(ARect);
    Canvas.Draw(ARect.Left, ARect.Top, bmp);
    Canvas.TextOut(ARect.Left + 20, ARect.Top + 1, Items[AIndex]);
  end;
  bmp.Free;
end;

function TRMInspForm.GetPropValue(Index: Integer): Variant;
begin
  Result := TProp(FItems.Objects[Index]).Value;
end;

procedure TRMInspForm.SetPropValue(Index: Integer; Value: Variant);
begin
  TProp(FItems.Objects[Index]).Value := Value;
end;

procedure TRMInspForm.ClearProperties;
var
  i: Integer;
begin
  CloseUp(False);
  for i := 0 to FItems.Count - 1 do
    TProp(FItems.Objects[i]).Free;
  FItems.Clear;
end;

procedure TRMInspForm.AddProperty(PropName: string; PropValue: Variant;
  PropType: TRMDataTypes; PropEnum: TStringList; PropEnumValues: Variant;
  PropEditor: TNotifyEvent);
begin
  FItems.AddObject(PropName, TProp.Create(PropValue, PropType, PropEnum,
    PropEnumValues, PropEditor));
end;

function TRMInspForm.CurItem: TProp;
begin
  Result := nil;
  if (FItemIndex <> -1) and (Count > 0) then
    Result := TProp(FItems.Objects[FItemIndex]);
end;

procedure TRMInspForm.SetItems(Value: TStringList);
begin
  FItems.Assign(Value);
  FItemIndex := -1;
  PaintBox1.Repaint;
  ItemIndex := 0;
end;

procedure TRMInspForm.SetItemValue(Value: string);
var
  p: TProp;
  n: Integer;
begin
  if HideProperties then
    Exit;
  p := TProp(FItems.Objects[FItemIndex]);
  p.Text := Value;
  n := FItemIndex;
  try
    FBusyFlag1 := TRUE;
    if Assigned(FOnModify) then
      FOnModify(FItemIndex);
    if n >= FItems.Count then
      n := 0;
  finally
    FBusyFlag1 := FALSE;
    SetItemIndex(n);
  end;
end;

function TRMInspForm.GetItemValue(i: Integer): string;
var
  p: TProp;
  SaveFormat: string;
  SaveDateSeparator: char;
begin
  Result := '';
  if (i < 0) or (i >= FItems.Count) then
    Exit;
  p := TProp(FItems.Objects[i]);
  if p = nil then
    Exit;
  if rmdtDate in p.DataType then
  begin
    SaveFormat := SysUtils.ShortDateFormat;
    SaveDateSeparator := SysUtils.DateSeparator;
    SysUtils.ShortDateFormat := 'yyyy/mm/dd';
    SysUtils.DateSeparator := '/';
    Result := DateToStr(StrToFloat(p.Text));
    SysUtils.ShortDateFormat := SaveFormat;
    SysUtils.DateSeparator := SaveDateSeparator;
  end
  else
    Result := p.Text;
end;

procedure TRMInspForm.SetItemIndex(Value: Integer);
var
  ww, y: Integer;
  b1, b2: Boolean;
  liProp: TProp;
begin
  FLB1.Visible := False;
  if FBusyFlag1 or (Value < 0) then
    Exit;
  if Value > Count - 1 then
    Value := Count - 1;
  Edit1.Visible := (Count > 0) and not HideProperties;
  if Count = 0 then
    Exit;
  if FItemIndex <> -1 then
  begin
    if Edit1.Modified then
      SetItemValue(Edit1.Text);
  end;
  FItemIndex := Value;

  liProp := CurItem;
  EditPanel.Visible := not HideProperties and (liProp <> nil) and Assigned(liProp.Editor)
    and not (rmdtEnum in liProp.DataType);
  ComboPanel.Visible := not HideProperties and (liProp <> nil) and
    ([RMdtBoolean, RMdtColor, RMdtEnum] * liProp.DataType <> []);
  b1 := (liProp <> nil) and (RMdtHasEditor in liProp.DataType);
  b2 := (liProp <> nil) and (RMdtString in liProp.DataType);
  Edit1.ReadOnly := b1 and not b2;
  ww := Fw - Fw1 - 2;
  y := FItemIndex * FRowHeight + 1;
  if EditPanel.Visible then
  begin
    EditPanel.SetBounds(Fw - 14, y, 14, FRowHeight - 2);
    Dec(ww, 15);
  end;
  Edit1.Text := GetItemValue(FItemIndex);
  if ComboPanel.Visible then
  begin
    ComboPanel.SetBounds(Fw - 14, y, 14, FRowHeight - 2);
    Dec(ww, 15);
  end;
  Edit1.SetBounds(Fw1 + 2, y, ww, FRowHeight - 2);
  Edit1.SelectAll;
  Edit1.Modified := False;

  if y + FRowHeight > Box.VertScrollBar.Position + Box.ClientHeight then
    Box.VertScrollBar.Position := y - Box.ClientHeight + FRowHeight;
  if y < Box.VertScrollBar.Position then
    Box.VertScrollBar.Position := y - 1;

  Label1.Caption := GetPropName(FItemIndex, False);
  Label2.Caption := GetPropName(FItemIndex, True);
  FLastProp := FItems[FItemIndex];
  PaintBox1Paint(nil);
end;

function TRMInspForm.GetCount: Integer;
begin
  Result := FItems.Count;
end;

procedure TRMInspForm.ItemsChanged;
var
  LastIndex: Integer;
begin
  FItemIndex := -1;
  FBusyFlag := True;
  FPanel1.Height := Items.Count * FRowHeight;
  FPanel1.Width := Box.ClientWidth;
  Fw := PaintBox1.Width;
  FBusyFlag := False;

  LastIndex := FItems.IndexOf(FLastProp);
  if LastIndex = -1 then
    LastIndex := 0;
  ItemIndex := LastIndex;
  if not HideProperties then
  begin
    if not ((cmbObjects.ItemIndex <> -1) and (cmbObjects.Items[cmbObjects.ItemIndex] = ObjectName)) then
    begin
      cmbObjectsDropDown(nil);
      cmbObjects.ItemIndex := cmbObjects.Items.IndexOf(ObjectName);
    end;
  end
  else
    cmbObjects.ItemIndex := -1;
end;

function TRMInspForm.GetPropName(Index: Integer; aCommon: Boolean): string;
var
  i: Integer;
begin
  i := FPropAliases.IndexOf(FItems[Index]);
  if (i >= 0) and (aCommon or RMLocale.LocalizedPropertyNames) then
  begin
    Result := FPropAliases.Value[i];
    i := Pos(';', Result);
    if i > 0 then
    begin
      if aCommon then
        Result := Copy(Result, i + 1, 999999)
      else
        Result := Copy(Result, 1, i - 1);
    end;
  end
  else
    Result := FItems[Index];

  if (Result = '') and (not aCommon) then
    Result := FItems[Index];
end;

procedure TRMInspForm.DrawOneLine(index: Integer; a: Boolean);
var
  R: TRect;

  procedure Line(x, y, dx, dy: Integer);
  begin
    Fb.Canvas.MoveTo(x, y);
    Fb.Canvas.LineTo(x + dx, y + dy);
  end;

  procedure DrawColorProp;
  var
    x, y: integer;
    SaveColor: TColor;
  begin
    x := Fw1 + 2; y := index * FRowHeight + 1;
    with Fb.Canvas do
    begin
      SaveColor := Brush.Color;
      if GetPropValue(index) = clNone then
        Brush.Color := clBtnFace
      else
        Brush.Color := GetPropValue(index);
      Rectangle(x, y, x + FRowHeight - 3, y + FRowHeight - 3);
      Brush.Color := SaveColor;
      Font.Color := clNavy;
      TextOut(x + FRowHeight, y, GetItemValue(index));
    end;
  end;

begin
  if Count > 0 then
  begin
    with Fb.Canvas do
    begin
      Brush.Color := clBtnFace;
      Pen.Color := clBtnShadow;
//      Font.Name := 'MS Sans Serif';
//      Font.Size := 8;
      Font.Assign(Self.Font);
      Font.Style := [];
      Font.Color := clBlack;
      R := Rect(5, index * FRowHeight + 1, Fw1 - 2 - 2, index * FRowHeight + FRowHeight - 1);
      if a then
      begin
        Pen.Color := clBtnShadow;
        Line(0, -2 + index * FRowHeight, Fw, 0);