jvgreport.pas

East make Tray Icon in delphi

  inherited;
  if Assigned(OLEContainer) and Assigned(Value) then
    OLEContainer.Parent := Value;
end;

procedure TJvgReportItem.MouseEnter(Control: TControl);
begin
  {$IFDEF USEJVCL}
  inherited MouseEnter(Control);
  {$ENDIF USEJVCL}
  if csDesigning in ComponentState then
    Exit;
  //Cursor := crCross;
//  SetCursor( Screen.Cursors[crCross] );
end;

procedure TJvgReportItem.MouseLeave(Control: TControl);
begin
  if csDesigning in ComponentState then
    Exit;
  Cursor := crDefault;
  {$IFDEF USEJVCL}
  inherited MouseLeave(Control);
  {$ENDIF USEJVCL}
  //  SetCursor( Screen.Cursors[crDefault] );
end;

procedure TJvgReportItem.WMMouseMove(var Msg: TWMMouse);
var
  I, dX, dY, nLeft, nTop, nWidth, nHeight: Integer;
  pt: TPoint;
begin
  inherited;
  if Fixed = 0 then
    with Msg do
    begin
      pt.x := Pos.x;
      pt.y := Pos.y;
      if fSizing then
      begin
        dX := Pos.x - DownPos.x;
        dY := Pos.y - DownPos.y;
        Inc(Pos.x, 4);
        Inc(Pos.y, 4);
        nLeft := Left;
        nTop := Top;
        nWidth := Width;
        nHeight := Height;
        case SizeDirection of
          1:
            begin
              nLeft := Left + dX;
              nWidth := Width - dX;
              nTop := Top + dY;
              nHeight := Height - dY;
            end;
          2:
            begin
              nTop := Top + dY;
              nHeight := Height - dY;
            end;
          3:
            begin
              nWidth := Pos.x;
              nTop := Top + dY;
              nHeight := Height - dY;
            end;

          4:
            begin
              nLeft := Left + dX;
              nWidth := Width - dX;
              nHeight := Pos.y;
            end;

          5:
            begin
              nHeight := Pos.y;
            end;

          6:
            begin
              nWidth := Pos.x;
              nHeight := Pos.y;
            end;
          7:
            begin
              nLeft := Left + dX;
              nWidth := Width - dX;
            end;
          8:
            begin
              nWidth := Pos.x;
            end;
        end;
        Left := min(nLeft, nLeft + nWidth);
        Top := min(nTop, nTop + nHeight);
        Width := abs(nWidth);
        Height := abs(nHeight);
        if nWidth < 0 then
        begin
          case SizeDirection of
            1: SizeDirection := 3;
            3: SizeDirection := 1;
            4: SizeDirection := 6;
            6: SizeDirection := 4;
            8: SizeDirection := 7;
            7: SizeDirection := 8;
          end;
          DownPos.x := Pos.x;
        end;
        if nHeight < 0 then
        begin
          case SizeDirection of
            1: SizeDirection := 4;
            2: SizeDirection := 5;
            3: SizeDirection := 6;
            4: SizeDirection := 1;
            5: SizeDirection := 2;
            6: SizeDirection := 3;
          end;
          DownPos.y := Pos.y;
        end;
      end
      else
        for I := 1 to 8 do
          if PtInRect(R[I], pt) then
          begin
            Cursor := Cursors[I];
            SizeDirection := I;
            Exit;
          end;
    end;
  Cursor := crDefault;
  //  SetCursor( Screen.Cursors[crDefault] );
end;

procedure TJvgReportItem.WMLMouseDown(var Msg: TWMMouse);
begin
  DownPos.x := Msg.Pos.x;
  DownPos.y := Msg.Pos.y;
  //DownPos := ClientToScreen(DownPos);
  fSizing := Cursor <> crDefault;
  inherited;
end;

{procedure TJvgReportItem.WMRMouseDown(var Msg: TWMMouse);
begin
  DownPos.x := Msg.Pos.x;
  DownPos.y := Msg.Pos.y;
  if Assigned(PopupMenu)
    inherited;
end;}

procedure TJvgReportItem.WMLMouseUp(var Msg: TWMMouse);
begin
  fSizing := False;
  inherited;
end;

procedure TJvgReportItem.FontChanged;
begin
  {$IFDEF USEJVCL}
  inherited FontChanged;
  {$ENDIF USEJVCL}
  FName := Font.Name;
  FFSize := Font.Size;
  FFColor := Font.Color;
  FFStyle := 0;
  if fsBold in Font.Style then
    FFStyle := FFStyle or 1;
  if fsItalic in Font.Style then
    FFStyle := FFStyle or (1 shl 1);
  if fsUnderline in Font.Style then
    FFStyle := FFStyle or (1 shl 2);
  Invalidate;
end;

procedure TJvgReportItem.WMSize(var Msg: TWMSize);
begin
  inherited;
  // if Assigned(OnResize) then OnResize(Self);
end;

{$IFNDEF USEJVCL}

procedure TJvgReportItem.CMMouseEnter(var Msg: TMessage);
begin
  inherited;
  MouseEnter(TControl(Msg.LParam));
end;

procedure TJvgReportItem.CMMouseLeave(var Msg: TMessage);
begin
  inherited;
  MouseLeave(TControl(Msg.LParam));
end;

procedure TJvgReportItem.CMFontChanged(var Msg: TMessage);
begin
  inherited;
  FontChanged;
end;

{$ENDIF !USEJVCL}

procedure TJvgReportItem.SetSelected(Value: Boolean);
begin
  FSelected := Value;
  Repaint;
end;

procedure TJvgReportItem.SetBkColor(Value: Integer);
begin
  FBkColor := Value;
  Color := BkColor;
  Repaint;
end;

procedure TJvgReportItem.SetBvColor(Value: Integer);
begin
  FBvColor := Value;
  Repaint;
end;

procedure TJvgReportItem.SetTransparent(Value: Integer);
begin
  FTransparent := Value;
  Repaint;
end;

procedure TJvgReportItem.SetAlignment(Value: Word);
begin
  FAlignment := Value;
  Invalidate;
end;

procedure TJvgReportItem.SetSideLeft(Value: Word);
begin
  FSideLeft := Value;
  Invalidate;
end;

procedure TJvgReportItem.SetSideTop(Value: Word);
begin
  FSideTop := Value;
  Invalidate;
end;

procedure TJvgReportItem.SetSideRight(Value: Word);
begin
  FSideRight := Value;
  Invalidate;
end;

procedure TJvgReportItem.SetSideBottom(Value: Word);
begin
  FSideBottom := Value;
  Invalidate;
end;

procedure TJvgReportItem.SetPenStyle(Value: Integer);
begin
  FPenStyle := Value;
  Invalidate;
end;

procedure TJvgReportItem.SetPenWidth(Value: Word);
begin
  FPenWidth := Value;
  Invalidate;
end;

procedure TJvgReportItem.SetText(const Value: string);
begin
  if FText <> Value then
  begin
    FText := Value;
    Invalidate;
  end;
end;

procedure TJvgReportItem.SetFName(const Value: string);
begin
  FFName := Value;
  Canvas.Font.Name := Value;
  Invalidate;
end;

procedure TJvgReportItem.SetFSize(Value: Integer);
begin
  FFSize := Value;
  Canvas.Font.Size := Value;
  Invalidate;
end;

procedure TJvgReportItem.SetFColor(Value: Integer);
begin
  FFColor := Value;
  Canvas.Font.Color := Value;
  Invalidate;
end;

procedure TJvgReportItem.SetFStyle(Value: Integer);
begin
  FFStyle := Value;
  with Canvas.Font do
  begin
    if (Value and 1) <> 0 then
      Style := Style + [fsBold]
    else
      Style := Style - [fsBold];
    if (Value and (1 shl 1)) <> 0 then
      Style := Style + [fsItalic]
    else
      Style := Style - [fsItalic];
    if (Value and (1 shl 2)) <> 0 then
      Style := Style + [fsUnderline]
    else
      Style := Style - [fsUnderline];
  end;
  Invalidate;
end;

procedure TJvgReportItem.SetContainOLE(Value: Boolean);
begin
  FContainOLE := Value;
  if FContainOLE and (not Assigned(OLEContainer)) then
  begin
    if not Assigned(Parent) then
      Exit;
    OLEContainer := TOLEContainer.Create(Parent.Parent);
    OLEContainer.AutoVerbMenu := False;
    OLEContainer.BorderStyle := bsNone;
    OLEContainer.Color := clWhite;
    OLEContainer.SizeMode := smScale;
    OLEContainer.Parent := Parent;
    if (OLEContainer.State = osEmpty) and (OLELinkToFile <> '') then
      SetOLELinkToFile(OLELinkToFile);
  end;
end;

procedure TJvgReportItem.SetOLELinkToFile(const Value: string);
begin
  FOLELinkToFile := Value;
  if Assigned(OLEContainer) then
  begin
    OLEContainer.CreateLinkToFile(Value, False);
    //OLEContainer.LoadFromFile( Value );
  end;
end;

procedure TJvgReportItem.SetFixed(Value: Word);
begin
  FFixed := Value;
  Repaint;
end;

procedure TJvgReportItem.SetOLESizeMode(Value: Word);
begin
  if FOLESizeMode = Value then
    Exit;
  FOLESizeMode := Value;
  if Assigned(OLEContainer) then
    OLEContainer.SizeMode := TSizeMode(Value);
end;

function TJvgReportItem.IsContainOLE: Boolean;
begin
  Result := FContainOLE;
end;

//=== { TJvgReport } =========================================================

constructor TJvgReport.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ParamNames := TStringList.Create;
  ParamValues := TStringList.Create;
  ParamMasks := TStringList.Create;
  FReportList := TStringList.Create;
  ParamTypes := TList.Create;
  ComponentList := TList.Create;
end;

destructor TJvgReport.Destroy;
begin
  FReportList.Free;
  ParamNames.Free;
  ParamValues.Free;
  ParamMasks.Free;
  ParamTypes.Free;
  ClearReport;
  ComponentList.Free;
  inherited Destroy;
end;

procedure TJvgReport.Loaded;
begin
  inherited Loaded;
  CreateReport(nil, False);
end;

procedure TJvgReport.Save;
var
  msS, msT: TMemoryStream;
begin
  ValidateWnds;
  msS := TMemoryStream.Create;
  msT := TMemoryStream.Create;
  try
    msS.WriteComponent(ParentWnd);
    msS.Position := 0;
    ObjectBinaryToText(msS, msT);
    msT.Position := 0;
    FReportList.LoadFromStream(msT);
  finally
    msS.Free;
    msT.Free;
  end;
end;

procedure TJvgReport.SaveToFile(const FileName: string);
var
  fs: TFileStream;
begin
  ValidateWnds;
  fs := TFileStream.Create(FileName, fmCreate or fmOpenWrite);
  try
    fs.WriteComponent(ParentWnd);
  finally
    fs.Free;
  end;
end;

procedure TJvgReport.LoadFromFile(const FileName: string);
var
  fs: TFileStream;
  ms: TMemoryStream;
begin
  fs := TFileStream.Create(FileName, fmOpenRead);
  ms := TMemoryStream.Create;
  try
    ObjectBinaryToText(fs, ms);
    ms.Position := 0;
    FReportList.LoadFromStream(ms);
  finally
    fs.Free;
    ms.Free;
  end;
end;

{procedure TJvgReport.Edit;
begin
  CreateReport(True);
end;}

procedure TJvgReport.PaintTo(Canvas: TCanvas);
var
  I: Integer;
begin
  OwnerWnd := nil;
  ParentWnd := nil;
  //  ParamNames.Clear;
  //  ParamMasks.Clear;
  //  ParamValues.Clear;
  //  ParamTypes.Clear;
  ComponentList.Clear;
  CreateReport(ParentWnd, False);
  for I := 0 to ComponentList.Count - 1 do
    TJvgReportItem(ComponentList[I]).PaintTo(Canvas);
end;

procedure TJvgReport.PreviewTo(Window: TWinControl);
begin
  OwnerWnd := Window;
  ParentWnd := OwnerWnd;
  ParamNames.Clear;
  ParamMasks.Clear;
  ParamValues.Clear;
  ParamTypes.Clear;
  ComponentList.Clear;
  CreateReport(ParentWnd, False);
  //  ProcessParams;
end;

procedure TJvgReport.Print;
var
  I: Integer;
  ScreenDC: HDC;
  HS, WS, HP, WP: Integer;
begin
  if Assigned(BeforePrint) then