|
Registriert seit: 2. Apr 2009 20 Beiträge |
#16
So hier mal den ganzen code hoffe der hilft euch weiter.
Delphi-Quellcode:
unit p_frm_start;
interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ZConnection,IniFiles, ZAbstractRODataset, ZAbstractDataset, ZAbstractTable, WinSock,IdBaseComponent, IdComponent, IdUDPBase, IdUDPServer, DB, ZDataset, ExtCtrls, RpRender, RpRenderCanvas, RpRenderPreview, RpDefine, RpRave, Grids, BaseGrid, AdvGrid, Buttons, AdvGlassButton, AdvGlowButton, StdCtrls, datelbl,shellapi, RpCon, RpConDS, RpBase, RpFiler, ComCtrls, IdDateTimeStamp, Menus, ToolWin, AdvMenus ; type Tfrm_start = class(TForm) DB_MASTER: TZConnection; ZQuery1: TZQuery; AdvStringGrid1: TAdvStringGrid; RvProject1: TRvProject; ScrollBox1: TScrollBox; RvRe_Preview: TRvRenderPreview; PNL_Button: TPanel; Splitter1: TSplitter; btn_AUSWERTEN: TAdvGlowButton; btn_DRUCKEN: TAdvGlowButton; btn_EXPORT: TAdvGlowButton; btn_EXIT: TAdvGlowButton; ZQuery1IV70ID: TIntegerField; ZQuery1IV70EAN: TStringField; ZQuery1IV70ARTN: TStringField; ZQuery1IV70ABEZ: TStringField; ZQuery1IV70STSA: TStringField; ZQuery1IV70TYP: TStringField; ZQuery1IV70SET: TStringField; ZQuery1IV70BME: TStringField; ZQuery1IV70ZME: TStringField; ZQuery1IV70PREIS: TFloatField; ZQuery1IV70MEST: TFloatField; ZQuery1IV70MEKT: TFloatField; ZQuery1IV70MEPAK: TFloatField; ZQuery1IV70MEM: TFloatField; ZQuery1IV70MEROL: TFloatField; ZQuery1IV70MEM2: TFloatField; ZQuery1IV70MELAG: TFloatField; ZQuery1IV70MESCK: TFloatField; ZQuery1IV70MEKG: TFloatField; ZQuery1IV70MER1: TFloatField; ZQuery1IV70MER2: TFloatField; ZQuery1IV70MER3: TFloatField; ZQuery1IV70WAG: TStringField; ZQuery1SI01STOR: TIntegerField; ZQuery1SI01ATNR: TStringField; ZQuery1SI01ME: TStringField; ZQuery1SI01BMENG: TFloatField; ZQuery1SI01BWERT: TFloatField; ZQuery1SI01IMENG: TFloatField; ZQuery1SI01IWERT: TFloatField; ZQuery1SI01DMENG: TFloatField; ZQuery1SI01DWERT: TFloatField; ZQuery1SI01DATU: TDateTimeField; SaveDialog1: TSaveDialog; RvDataSetConnection1: TRvDataSetConnection; RvNDRWriter1: TRvNDRWriter; btn_RAVE: TAdvGlowButton; btn_FIRST: TAdvGlowButton; btn_back: TAdvGlowButton; btn_NEXT: TAdvGlowButton; btn_LAST: TAdvGlowButton; btn_ZOOMIN: TAdvGlowButton; btn_ZOOMOUT: TAdvGlowButton; StatusBar1: TStatusBar; Panel1: TPanel; Timer1: TTimer; logo: TImage; AdvMainMenu1: TAdvMainMenu; mainprogramm: TMenuItem; mainclose: TMenuItem; bearbeiten1: TMenuItem; Auswerten1: TMenuItem; Export1: TMenuItem; Drucken1: TMenuItem; Report1: TMenuItem; Design1: TMenuItem; Label1: TLabel; procedure maincloseClick(Sender: TObject); procedure Design1Click(Sender: TObject); procedure Drucken1Click(Sender: TObject); procedure Export1Click(Sender: TObject); procedure Auswerten1Click(Sender: TObject); procedure Schlieen1Click(Sender: TObject); procedure SchliessenClick(Sender: TObject); procedure DB_MASTERAfterConnect(Sender: TObject); procedure Timer1Timer(Sender: TObject); procedure btn_ZOOMOUTClick(Sender: TObject); procedure btn_ZOOMINClick(Sender: TObject); procedure btn_LASTClick(Sender: TObject); procedure btn_NEXTClick(Sender: TObject); procedure btn_backClick(Sender: TObject); procedure btn_FIRSTClick(Sender: TObject); procedure btn_RAVEClick(Sender: TObject); procedure btn_DRUCKENClick(Sender: TObject); procedure btn_EXPORTClick(Sender: TObject); procedure btn_AUSWERTENClick(Sender: TObject); procedure btn_EXITClick(Sender: TObject); procedure FormActivate(Sender: TObject); procedure Lade_Daten; procedure init; procedure Start_MySQL; function getIPAdress: string; { Private-Deklarationen } public { Public-Deklarationen } INIFILE: TInifile; Path: string; G_STATUS: string; G_ARCHIV_PATH: string; G_param_liste: TStringList; G_STOR : string; G_IPAD : string; G_PORT : string; MASTER: string; MASTER_PORT : string; INIDAT: TIniFile; NDR : TFileStream; end; var frm_start: Tfrm_start; implementation uses p_frm_abf; {$R *.dfm} //----------------------------------------------------------------------------- procedure Tfrm_start.Start_MySQL; var QRY: TZQuery; s: string; sl : TStringList; begin try DB_MASTER.Disconnect; DB_MASTER.Protocol := 'mysql'; DB_MASTER.HostName := G_IPAD; DB_MASTER.Port := StrToInt(G_PORT); DB_MASTER.USER := 'user'; DB_MASTER.Password := 'xxx'; DB_MASTER.Database := 'wws'; try DB_MASTER.Connect; except MessageDlg('Fehler beim starten der Datenbank !', mtWarning, [mbOK], 0); end; except G_STATUS := 'OFFLINE'; end; end; //---------------------------------------------------------------------------- procedure Tfrm_start.init; var s: string; y: Integer; x: Integer; begin Path := ExtractFilePath(ParamStr(0)); // Eigenen Pfad ermitteln // Inidateiname Ermitteln s := IncludeTrailingBackslash(ExtractFilePath(ParamStr(0))) + ChangeFileExt(ExtractFileName(ParamStr(0)), '.INI'); INIFILE := TIniFile.Create(s); G_param_liste := TStringList.Create; y := ParamCount; if y > 0 then begin // alle Parameter einlesen for x := 1 to y do begin G_param_liste.Add(UpperCase(ParamStr(x))); end; if G_param_liste.Values['/IPAD'] > '' then begin G_IPAD := G_param_liste.Values['/IPAD']; end; if G_param_liste.Values['/PORT'] > '' then begin G_PORT := G_param_liste.Values['/PORT']; end; if G_param_liste.Values['/STOR'] > '' then begin G_STOR := G_param_liste.Values['/STOR']; end; RvNDRWriter1.Stream := TMemoryStream.Create; // Start_MySQL; end; end; //----------------------------------------------------------------------------- function Tfrm_start.getIPAdress: string; var wVersionRequested: WORD; wsaData: TWSAData; p2: pchar; p: PHostEnt; s: array[0..128] of char; begin {Start up WinSock} wVersionRequested := MAKEWORD(1, 1); WSAStartup(wVersionRequested, wsaData); try {Get the IpAddress} GetHostName(@s, 128); p := GetHostByName(@s); result := p^.h_Name; p2 := iNet_ntoa(PInAddr(p^.h_addr_list^)^); result := p2; finally WSACleanup; end; end; //----------------------------------------------------------------------------- procedure Tfrm_start.FormActivate(Sender: TObject); begin init; ExitCode := 1; end; //----------------------------------------------------------------------------- procedure Tfrm_start.btn_EXITClick(Sender: TObject); begin close; end; //----------------------------------------------------------------------------- procedure Tfrm_start.btn_AUSWERTENClick(Sender: TObject); begin frm_abf := Tfrm_abf.Create(self); Try frm_abf.ShowModal; Lade_Daten; Finally frm_abf.Free; end; end; //----------------------------------------------------------------------------- procedure Tfrm_start.Lade_Daten; var x: integer; Qry: TZQuery; begin x := 1; AdvStringGrid1.RowCount := 2; AdvStringGrid1.Clear; AdvStringGrid1.Cells[0, 0] :='Artikel NR'; AdvStringGrid1.Cells[1, 0] :='Menegeneinheit'; AdvStringGrid1.Cells[2, 0] :='Bestandsmenge'; AdvStringGrid1.Cells[3, 0] :='Bestandswet'; AdvStringGrid1.Cells[4, 0] :='Inventarmenge'; AdvStringGrid1.Cells[5, 0] :='Inventarwert'; AdvStringGrid1.Cells[6, 0] :='Div.Menge'; AdvStringGrid1.Cells[7, 0] :='Div.Wert'; AdvStringGrid1.Cells[8, 0] :='Artikelbezeichnung'; AdvStringGrid1.Cells[9, 0] :='Artikelpreis'; ZQuery1.Close; ZQuery1.Connection := DB_MASTER; ZQuery1.SQL.Clear; ZQuery1.SQL.Text := 'select * FROM wwsi0100,wwiv7000 where IV70ARTN=SI01ATNR and SI01DWERT > '+frm_abf.edt_money.Text; ZQuery1.open; while not ZQuery1.Eof do begin AdvStringGrid1.AddRow; AdvStringGrid1.Cells[0,x] := ZQuery1IV70ARTN.AsString; AdvStringGrid1.cells[1,x] := ZQuery1IV70BME.AsString; AdvStringGrid1.cells[2,x] := ZQuery1SI01BMENG.AsString; AdvStringGrid1.cells[3,x] := ZQuery1SI01BWERT.AsString; AdvStringGrid1.cells[4,x] := ZQuery1SI01IMENG.AsString; AdvStringGrid1.cells[5,x] := ZQuery1SI01IWERT.AsString; AdvStringGrid1.cells[6,x] := ZQuery1SI01DMENG.AsString; AdvStringGrid1.cells[7,x] := ZQuery1SI01DWERT.AsString; AdvStringGrid1.cells[8,x] := ZQuery1IV70ABEZ.AsString; AdvStringGrid1.cells[9,x] := ZQuery1IV70PREIS.AsString; ZQuery1.Next; Inc(x); end; AdvStringGrid1.RowCount := x; //RvNDRWriter1.Stream.Position := 0 ; RvNDRWriter1.FileName := 'hugo.ndr'; // RvProject1.Engine := nil; RvProject1.Close; RvProject1.Engine := RvNDRWriter1; //daten werden gezogen RvProject1.Open; ShowMessage('wird Geladen'); try RvProject1.Execute; // beim zweiten durchlauf springt er hier in except ShowMessage('ist geladen'); //RvProject1.Engine := nil; RvRe_Preview.Render(RvNDRWriter1.Stream); // daten werden in scrollbox // angezeigt except on E: Exception do begin ShowMessage(e.Message); end; end; end; //----------------------------------------------------------------------------- procedure Tfrm_start.btn_EXPORTClick(Sender: TObject); begin if SaveDialog1.Execute = true then begin AdvStringGrid1.SaveToXLS(SaveDialog1.FileName); // ShellExecute(handle, NULL, PAnsiChar(SaveDialog1.FileName), NULL, NULL, SW_SHOWNORMAL); end; end; //----------------------------------------------------------------------------- procedure Tfrm_start.btn_DRUCKENClick(Sender: TObject); begin If Assigned(NDR) = true then NDR := nil; RvProject1.Execute; end; //----------------------------------------------------------------------------- procedure Tfrm_start.btn_RAVEClick(Sender: TObject); begin RvProject1.Design; RvProject1.Save; end; //----------------------------------------------------------------------------- procedure Tfrm_start.btn_FIRSTClick(Sender: TObject); begin RvRe_Preview.PageInc := RvRe_Preview.CurrentPage - 1; RvRe_Preview.PrevPage; RvRe_Preview.PageInc := 1; ScrollBox1.Refresh; end; //----------------------------------------------------------------------------- procedure Tfrm_start.btn_backClick(Sender: TObject); begin if RvRe_Preview.CurrentPage > 1 then RvRe_Preview.PrevPage else ShowMessage('Erste Seite erreicht.'); ScrollBox1.Refresh; end; //----------------------------------------------------------------------------- procedure Tfrm_start.btn_NEXTClick(Sender: TObject); begin if RvRe_Preview.CurrentPage < RvRe_Preview.Pages then RvRe_Preview.NextPage else ShowMessage('Letzte Seite erreicht.'); end; //----------------------------------------------------------------------------- procedure Tfrm_start.btn_LASTClick(Sender: TObject); begin RvRe_Preview.PageInc := RvRe_Preview.Pages - RvRe_Preview.CurrentPage; RvRe_Preview.NextPage; RvRe_Preview.PageInc := 1; ScrollBox1.Refresh; end; //----------------------------------------------------------------------------- procedure Tfrm_start.btn_ZOOMINClick(Sender: TObject); begin RvRe_Preview.ZoomIn; ScrollBox1.Refresh; end; //----------------------------------------------------------------------------- procedure Tfrm_start.btn_ZOOMOUTClick(Sender: TObject); begin RvRe_Preview.ZoomOut; ScrollBox1.Refresh; end; //----------------------------------------------------------------------------- procedure Tfrm_start.Timer1Timer(Sender: TObject); begin StatusBar1.Panels[3].Text := TimeToStr(time)+' Uhr'; StatusBar1.panels[2].Text := dateToStr(date); end; //----------------------------------------------------------------------------- procedure Tfrm_start.DB_MASTERAfterConnect(Sender: TObject); begin StatusBar1.Panels[0].Text := DB_MASTER.HostName; StatusBar1.Panels[1].Text := TimeToStr(time)+' Uhr Daten aufgerufen !'; end; //----------------------------------------------------------------------------- procedure Tfrm_start.SchliessenClick(Sender: TObject); begin close; end; //----------------------------------------------------------------------------- procedure Tfrm_start.Schlieen1Click(Sender: TObject); begin close; end; //----------------------------------------------------------------------------- procedure Tfrm_start.Auswerten1Click(Sender: TObject); begin btn_AUSWERTENClick(sender); end; //----------------------------------------------------------------------------- procedure Tfrm_start.Export1Click(Sender: TObject); begin btn_EXPORTClick(sender); end; //----------------------------------------------------------------------------- procedure Tfrm_start.Drucken1Click(Sender: TObject); begin btn_DRUCKENClick(sender); end; //----------------------------------------------------------------------------- procedure Tfrm_start.Design1Click(Sender: TObject); begin btn_RAVEClick(sender); end; //----------------------------------------------------------------------------- procedure Tfrm_start.maincloseClick(Sender: TObject); begin btn_EXITClick(sender); end; //----------------------------------------------------------------------------- end. |
![]() |
Ansicht |
![]() |
![]() |
![]() |
ForumregelnEs ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.
BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus. Trackbacks are an
Pingbacks are an
Refbacks are aus
|
|
Nützliche Links |
Heutige Beiträge |
Sitemap |
Suchen |
Code-Library |
Wer ist online |
Alle Foren als gelesen markieren |
Gehe zu... |
LinkBack |
![]() |
![]() |