View Single Post
 
Old 12-01-2003, 08:04 AM
Flyguy's Avatar
Flyguy Flyguy is offline
Lost Soul

Super Moderator
* Guru *
 
Join Date: May 2001
Location: Vorlon
Posts: 19,164
Default Printing MSFlexgrid using SendMessage API

The original code can be found on ActiveVB.de
Code:
'Dieser Source stammt von [url]http://www.activevb.de[/url] 'und kann frei verwendet werden. Für eventuelle Schäden 'wird nicht gehaftet. 'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum. 'Ansonsten viel Spaß und Erfolg mit diesem Source! '------------- Anfang Projektdatei Projekt1.vbp ------------- ' Die Komponente 'Microsoft FlexGrid Control 6.0 (SP3) ' (MSFLXGRD.OCX)' wird benötigt. '--------- Anfang Formular "Form1" alias Form1.frm --------- 'Control CommandButton: Command1 'Control FlexGrid: MSFlexGrid1 Option Explicit Private Declare Function SendMessage Lib "user32" Alias _ "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As _ Long, ByVal wParam As Long, ByVal lParam As Long) _ As Long Const WM_USER = &H400 Const VP_FORMATRANGE = WM_USER + 125 Const VP_YESIDO = 456654 Private Type Rect Left As Long Top As Long Right As Long Bottom As Long End Type Private Type TFormatRange hdc As Long hdcTarget As Long rc As Rect rcPage As Rect End Type Private Sub Command1_Click() Call PrintGrid(MSFlexGrid1, 20, 25, 20, 20, _ "ActiveVB - FlexGrid drucken über " & _ "VP_FORMATRANGE", "") End Sub Private Sub Form_Load() Dim Zahl% ' Fill the flex with 'random' data With MSFlexGrid1 .ColWidth(0) = 1000 .ColWidth(1) = 2000 .ColWidth(2) = 2600 .ColAlignment(3) = 0 .ColWidth(3) = 500 .ColWidth(4) = 2800 .TextArray(0) = "Name" .TextArray(1) = "E-Mail" .TextArray(2) = "HomePage" .TextArray(3) = "Nr." .TextArray(4) = "Sonstiges" For Zahl = 1 To 9 .AddItem "Dirk Lietzow" & vbTab & "dirk@activeVB.de" & _ vbTab & "www.activeVB.de" & vbTab & Zahl & vbTab & _ "Alle für einen, einer für alle ..." Next Zahl ' 1. leere Zeile löschen .RemoveItem 1 ' Formatierungsbeispiele .Col = 2 .Row = 2 .CellFontName = "Arial" .CellFontSize = 11 .Col = 2 .Row = 3 .CellFontName = "Arial" .CellFontSize = 12 .Col = 2 .Row = 4 .CellFontName = "Arial" .CellFontSize = 14 .CellFontBold = True .RowHeight(.Row) = 500 .Col = 2 .Row = 6 .CellBackColor = &H8000000F .Col = 2 .Row = 8 .CellFontName = "Courier New" .CellFontSize = 12 .CellFontBold = True .CellForeColor = vbWhite .CellBackColor = &HC00000 .RowHeight(.Row) = 500 End With End Sub Sub PrintGrid(Grid As MSFlexGrid, ByVal LeftMargin As Single, _ ByVal TopMargin As Single, ByVal RightMargin As _ Single, ByVal BottomMargin As Single, Titel As _ String, Datum As String, Optional many As Integer) Dim tRange As TFormatRange Dim lReturn As Long Dim DName As String Dim DSchacht As Integer Dim gbeg As Long Dim CopyCW() As Long Dim GRef As Boolean Dim X% GRef = False If many > 0 Then ' Set the number of columns to be printed ' All columns > many get a colwidth = 0 If Grid.Cols > many Then gbeg = Grid.Cols - many ReDim CopyCW(gbeg) Grid.Redraw = False For X = many To Grid.Cols - 1 CopyCW(X - many) = Grid.ColWidth(X) Grid.ColWidth(X) = 0 Next X GRef = True End If End If 'With wParam <> 0 can be checked 'whether the control supports OPP, if it does then the value '456654 (VP_YESIDO) will be returned lReturn = SendMessage(Grid.hWnd, VP_FORMATRANGE, 1, 0) If lReturn = VP_YESIDO Then ' Fill the tRange structure Printer.ScaleMode = vbPixels With tRange .hdc = Printer.hdc ' Height and Width (in Pixel) .rcPage.Right = Printer.ScaleWidth .rcPage.Bottom = Printer.ScaleHeight ' Set the printing range in pixels .rc.Left = Printer.ScaleX(LeftMargin, vbMillimeters) .rc.Top = Printer.ScaleY(TopMargin, vbMillimeters) .rc.Right = .rcPage.Right - Printer.ScaleX(RightMargin, _ vbMillimeters) .rc.Bottom = .rcPage.Bottom - Printer.ScaleY(BottomMargin, _ vbMillimeters) End With ' Initialize printer Printer.Print vbNullString ' Print page (n) Do Printer.CurrentX = Printer.ScaleX(LeftMargin, vbMillimeters) Printer.CurrentY = Printer.ScaleY(10, vbMillimeters) If Titel <> "" Then Printer.Print Titel Printer.CurrentX = Printer.ScaleX(LeftMargin, vbMillimeters) Printer.CurrentY = Printer.ScaleY(16, vbMillimeters) If Datum <> "" Then Printer.Print Datum Else Printer.Print Format(Date, "DD.MM.YYYY") End If lReturn = SendMessage(Grid.hWnd, VP_FORMATRANGE, 0, _ VarPtr(tRange)) If lReturn < 0 Then Exit Do Else Printer.NewPage End If Loop Printer.EndDoc 'Reset lReturn = SendMessage(Grid.hWnd, VP_FORMATRANGE, 0, 0) End If If GRef Then ' Reset all columns to their original width For X = many To Grid.Cols - 1 Grid.ColWidth(X) = CopyCW(X - many) Next X Grid.Redraw = True End If End Sub '---------- Ende Formular "Form1" alias Form1.frm ---------- '-------------- Ende Projektdatei Projekt1.vbp --------------
Reply With Quote