handles.pas

主要介绍超市管理系统的后台系统,后台程序是系统初始化和系统维护最常使用的一部分程序,主要任务是建产基本数据,进出货盘点和打印报表.后台程序主要负责的都是管理上的功能,当后台建立完整的数据后,前台才能顺

    dsSizeBottom:
      begin
        ARect.Left := Left;
        ARect.Top := Top;
        ARect.Right := Width;
        ARect.Bottom := YGridAdjust(Height + (YPos - FDragOffset.Y)) - 3;
      end;

    dsSizeLeft:
      begin
        ARect.Left := XGridAdjust(Left + (XPos - FDragOffset.X)) - 2;
        ARect.Top := Top;
        ARect.Right := Width - (ARect.Left - Left);
        ARect.Bottom := Height;
      end;

    dsSizeRight:
      begin
        ARect.Left := Left;
        ARect.Top := Top;
        ARect.Right := XGridAdjust(Width + (XPos - FDragOffset.X)) - 3;
        ARect.Bottom := Height;
      end;

  else
                                       { keep size, move to new position }
    ARect.Left := XGridAdjust(Left + (XPos - FDragOffset.X)) - 2;
    ARect.Top := YGridAdjust(Top + (YPos - FDragOffset.Y)) - 2;
    ARect.Right := Width;
    ARect.Bottom := Height;

  end;
                                       { impose a minimum size for sanity }
  if ARect.Right < 5 then
    ARect.Right := 5;
  if ARect.Bottom < 5 then
    ARect.Bottom := 5;

  Result := ARect;

end;

procedure TStretchHandle.Rubberband(XPos, YPos: integer; ShowBox: boolean);
var
  NewRect: TRect;
  PtA, PtB: TPoint;
  ScreenDC: HDC;
begin
                                       { outline is drawn over all windows }
  ScreenDC := GetDC(0);
                                       { erase previous rectangle, if any, & adjust for handle's position }
  if (FDragRect.Left <> 0) or (FDragRect.Top <> 0) or (FDragRect.Right <> 0) or (FDragRect.Bottom <> 0) then
    begin
      PtA := Parent.ClientToScreen(Point(FDragRect.Left + 2, FDragRect.Top + 2));
      PtB := Parent.ClientToScreen(Point(FDragRect.Left + FDragRect.Right - 3, FDragRect.Top + FDragRect.Bottom - 3));
      DrawFocusRect(ScreenDC, Rect(PtA.X, PtA.Y, PtB.X, PtB.Y));
      FDragRect := Rect(0, 0, 0, 0);
    end;
                                       { draw new rectangle unless this is a final erase }
  if ShowBox then
    begin
      NewRect := GetModifiedRect(XPos, YPos);
      PtA := Parent.ClientToScreen(Point(NewRect.Left + 2, NewRect.Top + 2));
      PtB := Parent.ClientToScreen(Point(NewRect.Left + NewRect.Right - 3, NewRect.Top + NewRect.Bottom - 3));
      DrawFocusRect(ScreenDC, Rect(PtA.X, PtA.Y, PtB.X, PtB.Y));
      FDragRect := NewRect;
    end
  else
    begin
      Parent.Repaint;
      Repaint;
    end;

  ReleaseDC(0, ScreenDC);

end;

procedure TStretchHandle.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
var
  WasVisible: boolean;
  i: integer;
  AControl: TControl;
begin
                                       { hide & preserve fixed size in design mode }
  WasVisible := Visible;
  if csDesigning in ComponentState then
    begin
      Visible := False;
      inherited SetBounds(ALeft, ATop, 24, 24);
    end
  else                                 { move child also, if any (but only if not locked) }
    if not FLocked then
      begin
        for i := 0 to FChildList.Count - 1 do
          begin
            AControl := FChildList[i];
            AControl.SetBounds(AControl.Left - Left + ALeft,
                               AControl.Top - Top + ATop,
                               AControl.Width - Width + AWidth,
                               AControl.Height - Height + AHeight);
          end;
        inherited SetBounds(ALeft, ATop, AWidth, AHeight);
      end;
                                       { restore visibility }
  if Visible = False then
    Visible := WasVisible;

end;

procedure TStretchHandle.Paint;
var
   AControl: TControl;
   ARect, BoxRect: TRect;
   i: integer;
begin

  inherited Paint;
                                        { do it differently at design time... }
  if csDesigning in ComponentState then
    begin
      Canvas.Brush.Color := FPrimaryColor;
      BoxRect := Rect(0, 0, 5, 5);
      Canvas.FillRect(BoxRect);
      BoxRect := Rect(19, 0, 24, 5);
      Canvas.FillRect(BoxRect);
      BoxRect := Rect(19, 19, 24, 24);
      Canvas.FillRect(BoxRect);
      BoxRect := Rect(0, 19, 5, 24);
      Canvas.FillRect(BoxRect);
    end
  else
    begin
                                       { set color to primary if only one child, else secondary }
      if FChildList.Count = 1 then
        Canvas.Brush.Color := FPrimaryColor
      else
        Canvas.Brush.Color := FSecondaryColor;
                                       { draw resize handles for each child }
      for i := 0 to FChildList.Count - 1 do
        begin

          AControl := TControl(FChildList.Items[i]);
          ARect := Rect(AControl.Left - Left - 2,
                        AControl.Top - Top - 2,
                        AControl.Left - Left + AControl.Width + 2,
                        AControl.Top - Top + AControl.Height + 2);

          with Canvas do
            begin
                                       { draw corner boxes (assuming Canvas is minimum 5x5) }
              BoxRect := Rect(ARect.Left, ARect.Top, ARect.Left + 5, ARect.Top + 5);
              FillRect(BoxRect);
              BoxRect := Rect(ARect.Right - 5, ARect.Top, ARect.Right, ARect.Top + 5);
              FillRect(BoxRect);
              BoxRect := Rect(ARect.Right - 5, ARect.Bottom - 5, ARect.Right, ARect.Bottom);
              FillRect(BoxRect);
              BoxRect := Rect(ARect.Left, ARect.Bottom - 5, ARect.Left + 5, ARect.Bottom);
              FillRect(BoxRect);
                                       { only for single Children, draw center boxes }
              if FChildList.Count = 1 then
                begin
                  BoxRect := Rect(ARect.Left + trunc((ARect.Right - ARect.Left) / 2) - 2,
                                  ARect.Top,
                                  ARect.Left + trunc((ARect.Right - ARect.Left) / 2) + 3,
                                  ARect.Top + 5);
                  FillRect(BoxRect);
                  BoxRect := Rect(ARect.Left + trunc((ARect.Right - ARect.Left) / 2) - 2,
                                  ARect.Bottom - 5,
                                  ARect.Left + trunc((ARect.Right - ARect.Left) / 2) + 3,
                                  ARect.Bottom);
                  FillRect(BoxRect);
                  BoxRect := Rect(ARect.Left,
                                  ARect.Top + trunc((ARect.Bottom - ARect.Top) / 2) - 2,
                                  ARect.Left + 5,
                                  ARect.Top + trunc((ARect.Bottom - ARect.Top) / 2) + 3);
                  FillRect(BoxRect);
                  BoxRect := Rect(ARect.Right - 5,
                                  ARect.Top + trunc((ARect.Bottom - ARect.Top) / 2) - 2,
                                  ARect.Right,
                                  ARect.Top + trunc((ARect.Bottom - ARect.Top) / 2) + 3);
                  FillRect(BoxRect);
                end;

            end;

        end;

    end;

end;

procedure TStretchHandle.SetPrimaryColor(Color: TColor);
begin
                                       { set single select color, repaint immediately }
  FPrimaryColor := Color;
  Repaint;

end;

procedure TStretchHandle.SetSecondaryColor(Color: TColor);
begin
                                       { set multiple select color, repaint immediately }
  FSecondaryColor := Color;
  Repaint;

end;

procedure TStretchHandle.SetColors(Color1, Color2: TColor);
begin
                                       { set single/multiple select colors, repaint }
  FPrimaryColor := Color1;
  FSecondaryColor := Color2;
  Repaint;

end;

procedure TStretchHandle.SetGridState(Value: boolean);
begin
                                       { a value of 1 effectively disables a grid axis }
  if Value then
    begin
      FGridX := 8;
      FGridY := 8;
    end
  else
    begin
      FGridX := 1;
      FGridY := 1;
    end;

end;

function TStretchHandle.GetGridState: boolean;
begin

  if (FGridX > 1) or (FGridY > 1) then
    Result := True
  else
    Result := False;

end;

function TStretchHandle.GetChildCount: integer;
begin
  Result := FChildList.Count;
end;

function TStretchHandle.GetChildControl(idx: integer): TControl;
begin

  if (FChildList.Count > 0) and (idx >= 0) then
    Result := FChildList[idx]
  else
    Result := nil;

end;

function TStretchHandle.IsAttached: boolean;
begin

  if FChildList.Count > 0 then
    Result := True
  else
    Result := False;

end;

function TStretchHandle.PointOverChild(P: TPoint): boolean;
var
  i: integer;
  ARect: TRect;
  AControl: TControl;
begin
                                       { determine whether X, Y is over any child (for dragging) }
  Result := False;
  for i := 0 to FChildList.Count - 1 do
    begin
      AControl := TControl(FChildList[i]);
      ARect := Rect(AControl.Left - 2,
                    AControl.Top - 2,
                    AControl.Left + AControl.Width + 2,
                    AControl.Top + AControl.Height + 2);
                                       { P is relative to the Parent }
      if PtInRect(ARect, P) then
        begin
          Result := True;
          break;
        end;
    end;

end;

function TStretchHandle.XGridAdjust(X: integer): integer;
begin
  Result := (X DIV FGridX) * FGridX;
end;

function TStretchHandle.YGridAdjust(Y: integer): integer;
begin
  Result := (Y DIV FGridY) * FGridY;
end;

function MinInt(a, b: integer): integer;
begin
  if a < b then
    Result := a
  else
    Result := b;
end;

function MaxInt(a, b: integer): integer;
begin
  if a > b then
    Result := a
  else
    Result := b;
end;

end.