rm_insp.pas

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

        Line(Fw1 - 1, 0 + index * FRowHeight, 0, FRowHeight);
        Pen.Color := clBlack;
        Line(0, -1 + index * FRowHeight, Fw, 0);
        Line(0, -1 + index * FRowHeight, 0, FRowHeight + 1);
        Pen.Color := clBtnHighlight;
        Line(1, FRowHeight + -1 + index * FRowHeight, Fw - 1, 0);
        Line(Edit1.Left, 0 + index * FRowHeight, Edit1.Width, 0);
        Line(Fw1, 0 + index * FRowHeight, 0, FRowHeight);
        Line(Fw1 + 1, 0 + index * FRowHeight, 0, FRowHeight);
        TextRect(R, 5, 1 + index * FRowHeight, GetPropName(Index, False));
      end
      else
      begin
        Line(0, FRowHeight - 1 + index * FRowHeight, Fw, 0);
        Line(Fw1 - 1, 0 + index * FRowHeight, 0, FRowHeight);
        Pen.Color := clBtnHighlight;
        Line(Fw1, 0 + index * FRowHeight, 0, FRowHeight);
        TextRect(R, 5, 1 + index * FRowHeight, GetPropName(Index, False));
        if RMdtColor in GetItemType(index) then
        begin
          DrawColorProp;
        end
        else
        begin
          Font.Color := clNavy;
          TextOut(Fw1 + 2, 1 + index * FRowHeight, GetItemValue(index));
        end;
      end;
    end;
  end;
end;

procedure TRMInspForm.PaintBox1Paint(Sender: TObject);
var
  i: Integer;
  r: TRect;
begin
  if FBusyFlag then
    Exit;
  FLB1.Hide;
  r := PaintBox1.BoundsRect;
  Fb.Width := PaintBox1.Width;
  Fb.Height := PaintBox1.Height;
  Fb.Canvas.Brush.Color := clBtnFace;
  Fb.Canvas.FillRect(r);
  if not HideProperties then
  begin
    for i := 0 to Count - 1 do
    begin
      if i <> FItemIndex then
        DrawOneLine(i, False);
    end;
    if FItemIndex <> -1 then
      DrawOneLine(FItemIndex, True);
  end;
  PaintBox1.Canvas.Draw(0, 0, Fb);
end;

procedure TRMInspForm.FillPropAliases;
var
  i: Integer;
  s: string;
begin
  for i := rmRes + 5001 to 65535 do
  begin
    s := RMLoadStr(i);
    if s = '' then
      Break;
    if (Pos('=', s) = 0) or (Pos('=', s) = Length(s)) then
      Continue;
    FPropAliases[Copy(s, 1, Pos('=', s) - 1)] := Copy(s, Pos('=', s) + 1, 255);
  end;
end;

procedure TRMInspForm.OnResizeEvent(Sender: TObject);
begin
  cmbObjects.Width := ClientWidth;

  FPanel1.Height := Items.Count * FRowHeight;
  FPanel1.Width := Box.ClientWidth;

  Fw := PaintBox1.Width;
  SetItemIndex(FItemIndex);
end;

procedure TRMInspForm.OnVisibleChangedEvent(Sender: TObject);
begin
	if Visible then
  begin
	  if Edit1.Enabled and Edit1.Visible then
  	  Edit1.SetFocus;
  end
  else
  begin
	  CloseUp(FALSE);
  	FLB1.Hide;
	  if CurItem = nil then
  	  Exit;
	  if [RMdtHasEditor, RMdtColor, RMdtBoolean, RMdtEnum] * CurItem.DataType = [] then
  	begin
	    if Edit1.Modified then
  	    SetItemValue(Edit1.Text);
	  end;
  end;
end;

procedure TRMInspForm.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if HideProperties then
    Exit;
  if PaintBox1.Cursor = crHSplit then
    FDown := True
  else
  begin
    CloseUp(FALSE);
    ItemIndex := y div FRowHeight;
    Edit1.SetFocus;
    FTickCount := GetTickCount;
  end;
end;

procedure TRMInspForm.Edit1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if HideProperties then
    Exit;
  if Key = vk_Escape then
  begin
    Edit1.Perform(EM_UNDO, 0, 0);
    Edit1.Modified := False;
  end
  else if Key = vk_Up then
  begin
    if ItemIndex > 0 then
      ItemIndex := ItemIndex - 1;
    Key := 0;
  end
  else if Key = vk_Down then
  begin
    if ItemIndex < Count - 1 then
      ItemIndex := ItemIndex + 1;
    Key := 0;
  end
  else if Key = vk_F11 then
  	Visible := not Visible;
end;

procedure TRMInspForm.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
  if Key = #13 then
  begin
    if RMdtHasEditor in CurItem.DataType then
      EditBtnClick(nil)
    else
    begin
      if Edit1.Modified then
        SetItemValue(Edit1.Text);
      Edit1.Modified := False;
    end;
    Edit1.SelectAll;
    Key := #0;
  end;
end;

procedure TRMInspForm.EditBtnClick(Sender: TObject);
begin
  if HideProperties then
    Exit;
  CurItem.Editor(CurObject);
  Edit1.SelectAll;
end;

procedure TRMInspForm.Edit1DblClick(Sender: TObject);
var
  p: TProp;

  function IndexOf(arr: Variant; val: Variant): Integer;
  var
    i: Integer;
  begin
    Result := -1;
    for i := 0 to varArrayHighBound(arr, 1) do
    begin
      if arr[i] = val then
      begin
        Result := i;
        Break;
      end;
    end;
  end;

begin
  p := CurItem;
  if RMdtHasEditor in p.DataType then
    EditBtnClick(nil)
  else if RMdtColor in p.DataType then
  begin
    with TColorDialog.Create(nil) do
    begin
      Color := p.Value;
      if Execute then
      begin
        p.Value := Color;
        SetItemValue(p.Text);
        Edit1.Modified := False;
        Edit1.SelectAll;
      end;
      Free;
    end;
  end
  else if RMdtBoolean in p.DataType then
  begin
    p.Value := not p.Value;
    SetItemValue(p.Text);
    Edit1.Modified := False;
    Edit1.SelectAll;
  end
  else if RMdtEnum in p.DataType then
  begin
    if Assigned(p.Editor) then
    begin
      p.Enum.Clear;
      p.Editor(nil);
    end;

    if p.IsEnumNull then
    begin
      if p.Enum.Count > 0 then
      begin
        if p.Enum.IndexOf(p.Value) >= p.Enum.Count - 1 then
          p.Value := p.Enum[0]
        else
          p.Value := p.Enum[p.Enum.IndexOf(p.Value) + 1];
      end;
    end
    else if IndexOf(p.EnumValues, p.Value) > varArrayHighBound(p.EnumValues, 1) - 1 then
      p.Value := p.EnumValues[0]
    else
      p.Value := p.EnumValues[IndexOf(p.EnumValues, p.Value) + 1];
    SetItemValue(p.Text);
    Edit1.Modified := False;
    Edit1.SelectAll;
  end;
end;

procedure TRMInspForm.cmbObjectsDropDown(Sender: TObject);
var
  s: string;
begin
  if cmbObjects.ItemIndex <> -1 then
    s := cmbObjects.Items[cmbObjects.ItemIndex]
  else
    s := '';
  if Assigned(FOnGetObjects) then
    FOnGetObjects(cmbObjects.Items);
  cmbObjects.ItemIndex := cmbObjects.Items.IndexOf(s);
end;

procedure TRMInspForm.cmbObjectsClick(Sender: TObject);
begin
  CloseUp(False);
  if Assigned(FOnSelectionChanged) then
    FOnSelectionChanged(cmbObjects.Items[cmbObjects.ItemIndex]);
  Edit1.SetFocus;
end;

function TRMInspForm.GetClassName(ObjName: string): string;
begin
  if CurObject <> nil then
  begin
    try
      Result := CurObject.ClassName;
    except
      Result := '';
    end;
  end
  else
    Result := '';
end;

procedure TRMInspForm.cmbObjectsDrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
begin
  with cmbObjects.Canvas do
  begin
    FillRect(Rect);
    if cmbObjects.DroppedDown then
      TextOut(Rect.Left + 2, Rect.Top + 1, cmbObjects.Items[Index])
    else
      TextOut(Rect.Left + 2, Rect.Top + 1, cmbObjects.Items[Index] + ': ' +
        GetClassName(cmbObjects.Items[Index]));
  end;
end;

procedure TRMInspForm.ComboBtnClick(Sender: TObject);
var
  i, wItems, nItems: Integer;
  p: TPoint;
begin
  if FListVisible then
  begin
    CloseUp(FALSE);
    Edit1.SetFocus;
    FListVisible := FALSE;
  end
  else
  begin
    FLB1.OnDrawItem := nil;
    FLB1.Style := lbStandard;
    with FLB1 do
    begin
      Items.Clear;
      Sorted := False;
      if RMdtBoolean in CurItem.DataType then
      begin
        Items.Add('False');
        Items.Add('True');
      end
      else if RMdtColor in CurItem.DataType then
      begin
        for i := 0 to 41 do
          Items.Add(RMColorNames[i]);
      end
      else if RMdtEnum in CurItem.DataType then
      begin
        if Assigned(CurItem.Editor) then
        begin
          CurItem.Enum.Clear;
          CurItem.Editor(nil);
        end;
        for i := 0 to CurItem.Enum.Count - 1 do
          Items.Add(CurItem.Enum[i]);
      end;

      if Items.Count > 0 then
      begin
        ItemIndex := Items.IndexOf(CurItem.Text);
        wItems := 0;
        for i := 0 to Items.Count - 1 do
        begin
          if Canvas.TextWidth(Items[i]) > wItems then
            wItems := Canvas.TextWidth(Items[i]);
        end;

        Inc(wItems, 12);
        nItems := Items.Count;
        if nItems > 12 then
        begin
          nItems := 12;
          Inc(wItems, 16);
        end;

        p := Edit1.ClientToScreen(Point(0, Edit1.Height));
        if wItems < Fw - Fw1 then
          SetBounds(Fw1 + 1, p.Y, Fw - Fw1 + 1, nItems * (ItemHeight + 1) + 2)
        else
          SetBounds(Fw - wItems + 2, p.Y, wItems, nItems * (ItemHeight + 1) + 2);

        if RMdtColor in CurItem.DataType then
        begin
          FLB1.Style := lbOwnerDrawFixed;
          //FLB1.ItemHeight := 16;
          FLB1.OnDrawItem := OnEventDrawItemColor;
        end;

        p := Self.ClientToScreen(Point(0, 0));
        Inc(p.X, Left);
        if p.X < 0 then
          p.X := 0;
        ItemIndex := Items.IndexOf(CurItem.Text);
        SetWindowPos(Handle, HWND_TOP, p.X, Top, 0, 0, SWP_NOSIZE or SWP_NOACTIVATE or SWP_SHOWWINDOW);
        FListVisible := TRUE;
      end;
    end;
  end;
end;

procedure TRMInspForm.LB1Click(Sender: TObject);
begin
  Edit1.Text := FLB1.Items[FLB1.ItemIndex];
  CloseUp(FALSE);
  FLB1.Hide;
  Edit1.SetFocus;
  SetItemValue(Edit1.Text);
end;

{$WARNINGS OFF}

procedure TRMInspForm.Edit1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if GetTickCount - FTickCount < GetDoubleClickTime then
    Edit1DblClick(nil);
end;
{$WARNINGS ON}

procedure TRMInspForm.PaintBox1MouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
  if not FDown then
  begin
    if (X > Fw1 - 2) and (X < Fw1 + 2) then
      PaintBox1.Cursor := crHSplit
    else
      PaintBox1.Cursor := crDefault;
  end
  else
  begin
    if x > 5 then
      SplitterPos{Fw1} := X;
    OnResizeEvent(nil);
  end;
end;

procedure TRMInspForm.PaintBox1MouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  FDown := False;
end;

procedure TRMInspForm.Panel2Resize(Sender: TObject);
begin
  Label1.Width := Panel2.ClientWidth - Label1.Left - 2;
  Label2.Width := Panel2.ClientWidth - Label2.Left - 2;
  Label2.Height := Panel2.ClientHeight - Label2.Top - 2;
end;

procedure TRMInspForm.SetSplitterPos(Value: Integer);
begin
	if (Value > 10) and (Value < Box.ClientWidth - 10) then
  	fw1 := Value
end;

end.