Einzelnen Beitrag anzeigen

Natcree

Registriert seit: 5. Mär 2013
502 Beiträge
 
Delphi 7 Enterprise
 
#7

AW: Brauch mal Hilfe bei Tobjectlist

  Alt 10. Mär 2013, 01:28
Delphi-Quellcode:
interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, ElPanel, ElClock, LMDBaseControl,
  LMDBaseGraphicControl, LMDGraphicControl, LMDLEDCustomLabel, LMDLEDLabel,
  LMDControl, LMDCustomControl, LMDCustomPanel, LMDCustomBevelPanel,
  LMDBaseEdit, LMDCustomEdit, LMDCustomMaskEdit, LMDCalculatorEdit,
  ElPgCtl, ElXPThemedControl, LMDCalendarEdit, ComCtrls,
  LMDCustomShapeButton, LMDShapeButton, LMDBaseGraphicButton,
  LMDCustomMMButton, LMDMMButton, StdCtrls, LMDCustomButton, LMDButton,
  ElComponent, ElCalc, ElEdits, ElBtnEdit, ElCalculatorEdit,
  LMDCustomExtCombo, LMDCalculatorComboBox,
  LMDDBCalculatorComboBox, DBCtrls, Mask, Buttons, Grids,comobj,
  ElTreeInplaceEditors, ElTree, ElTreeGrids,uSharedClass;

type
  TForm7 = class(TForm)
    ElPageControl1: TElPageControl;
    ElTabSheet1: TElTabSheet;
    ElTabSheet2: TElTabSheet;
    LMDShapeButton1: TLMDShapeButton;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    LMDShapeButton2: TLMDShapeButton;
    Button1: TButton;
    Button2: TButton;
    Label6: TLabel;
    Label7: TLabel;
    LMDShapeButton3: TLMDShapeButton;
    Label8: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    LMDShapeButton4: TLMDShapeButton;
    SpeedButton1: TSpeedButton;
    DateTimePicker1: TDateTimePicker;
    SpeedButton2: TSpeedButton;
    DateTimePicker2: TDateTimePicker;
    Edit1: TEdit;
    Edit2: TEdit;
    Memo1: TMemo;
    Edit3: TEdit;
    Edit4: TEdit;
    Edit5: TEdit;
    Edit6: TEdit;
    Memo2: TMemo;
    Edit7: TEdit;
    Edit8: TEdit;
    Button3: TButton;
    Label11: TLabel;
    StringGrid1: TStringGrid;
    Edit9: TEdit;

    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure DateTimePicker1Change(Sender: TObject);
    procedure DateTimePicker2Change(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure LMDDBCalculatorComboBox2Change(Sender: TObject);
    procedure LMDDBCalculatorComboBox1Change(Sender: TObject);
    procedure LMDShapeButton1Click(Sender: TObject);
    procedure LMDShapeButton3Click(Sender: TObject);
    procedure LMDShapeButton4Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure LMDShapeButton2Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure ElPageControl1Change(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormDestroy(Sender: TObject);
    procedure Button3Click(Sender: TObject);

  private
    { Private declarations }
     FIrgendwas: TIrgendwas;
     FIrgendwas1: TIrgendwas1;
  public
    { Public declarations }

     property Irgendwas: TIrgendwas read FIrgendwas;
     property Irgendwas1: TIrgendwas1 read FIrgendwas1;
  end;
var
  Form7: TForm7;

implementation

uses Unit1, Unit8;

{$R *.dfm}


procedure TForm7.FormCreate(Sender: TObject);
begin
elpagecontrol1.ActivePageIndex:=0;
datetimepicker1.DateTime := now;
edit1.Text:='';
edit4.Text:='';
edit3.Text:='';
edit2.Text:='';
memo1.Text:='';

End;

function Xls_To_StringGrid(AGrid: TeltreeStringGrid; AXLSFile: string): Boolean;
const
xlCellTypeLastCell = $0000000B;
var
XLApp, Sheet: OLEVariant;
RangeMatrix: Variant;
x, y, k, r: Integer;
begin
Result := False;
XLApp := CreateOleObject('Excel.Application');
try
XLApp.Visible := False;
XLApp.Workbooks.Open(AXLSFile);
Sheet := XLApp.Workbooks[ExtractFileName(AXLSFile)].WorkSheets[1];
Sheet.Cells.SpecialCells(xlCellTypeLastCell, EmptyParam).Activate;
x := XLApp.ActiveCell.Row;
y := XLApp.ActiveCell.Column;
AGrid.RowCount := x;
AGrid.ColCount := y;
RangeMatrix := XLApp.Range['A1', XLApp.Cells.Item[X, Y]].Value;
k := 1;
repeat
for r := 1 to y do
AGrid.Cells[(r ), (k )] := RangeMatrix[K, R];
Inc(k, 1);
AGrid.RowCount := k + 1;
until k > x;
RangeMatrix := Unassigned;
finally
if not VarIsEmpty(XLApp) then
begin
XLApp.Quit;
XLAPP := Unassigned;
Sheet := Unassigned;
Result := True;
end;
end;
end;
function RefToCell(ARow, ACol: Integer): string;
begin
Result := Chr(Ord('A') + ACol - 1) + IntToStr(ARow);
end;
function SaveAsExcelFile1(AGrid: TStringGrid; ASheetName, AFileName: string): Boolean;
const
xlWBATWorksheet = -4167;
var
XLApp, Sheet, Data: OLEVariant;
i, j: Integer;
begin
// Prepare Data
Data := VarArrayCreate([1, AGrid.RowCount, 1, AGrid.ColCount], varVariant);
for i := 0 to AGrid.ColCount - 1 do
for j := 0 to AGrid.RowCount - 1 do
Data[j + 1, i + 1] := AGrid.Cells[i, j];
// Create Excel-OLE Object
Result := False;
XLApp := CreateOleObject('Excel.Application');
try
// Hide Excel
XLApp.Visible := False;
// Add new Workbook
XLApp.Workbooks.Add(xlWBatWorkSheet);
Sheet := XLApp.Workbooks[1].WorkSheets[1];
Sheet.Name := ASheetName;
// Fill up the sheet
Sheet.Range[RefToCell(1, 1), RefToCell(AGrid.RowCount,
AGrid.ColCount)].Value := Data;
// Save Excel Worksheet
try
XLApp.Workbooks[1].SaveAs(AFileName);
Result := True;
except
// Error ?
end;
finally
// Quit Excel
if not VarIsEmpty(XLApp) then
begin
XLApp.DisplayAlerts := False;
XLApp.Quit;
XLAPP := Unassigned;
Sheet := Unassigned;
end;
end;
end;
function SaveAsExcelFile(AGrid: Teltreestringgrid; ASheetName, AFileName: string): Boolean;
const
xlWBATWorksheet = -4167;
var
 Col: Integer;
GridPrevFile: string;
XLApp, Sheet, Data: OLEVariant;
i, j: Integer;
begin
// Prepare Data
Data := VarArrayCreate([1, AGrid.RowCount, 1, AGrid.ColCount], varVariant);
for i := 0 to AGrid.ColCount - 1 do
for j := 0 to AGrid.RowCount - 1 do
Data[j + 1, i + 1] := AGrid.Cells[i, j];
// Create Excel-OLE Object
Result := False;
XLApp := CreateOleObject('Excel.Application');
try
// Hide Excel
XLApp.Visible := False;
// Add new Workbook
XLApp.Workbooks.Add(xlWBatWorkSheet);
Sheet := XLApp.Workbooks[1].WorkSheets[1];
Sheet.Name := ASheetName;
// Fill up the sheet
Sheet.Range[RefToCell(1, 1), RefToCell(AGrid.RowCount,
AGrid.ColCount)].Value := Data;
// Save Excel Worksheet
try
XLApp.Workbooks[1].SaveAs(AFileName);
Result := True;
except
// Error ?
end;
finally
// Quit Excel
if not VarIsEmpty(XLApp) then
begin
XLApp.DisplayAlerts := False;
XLApp.Quit;
XLAPP := Unassigned;
Sheet := Unassigned;
end;
end;
end;

procedure TForm7.Button1Click(Sender: TObject);
begin
close;
end;

procedure TForm7.SpeedButton1Click(Sender: TObject);
begin
datetimepicker1.Visible:=true;
DateTimePicker1.Perform(WM_KEYDOWN, VK_F4, 0);
end;

procedure TForm7.DateTimePicker1Change(Sender: TObject);
begin
datetimepicker1.Visible:=false;
edit5.Text:=datetostr(datetimepicker1.Date);
end;

procedure TForm7.DateTimePicker2Change(Sender: TObject);
begin
datetimepicker2.Visible:=false;
edit1.Visible:=true;
edit1.Text:=datetostr(datetimepicker2.Date);
end;

procedure TForm7.SpeedButton2Click(Sender: TObject);
begin
edit1.Visible:=false;
datetimepicker2.Visible:=true;
DateTimePicker2.Perform(WM_KEYDOWN, VK_F4, 0);
end;

procedure TForm7.LMDDBCalculatorComboBox2Change(Sender: TObject);
begin
edit3.Text:='';
end;

procedure TForm7.LMDDBCalculatorComboBox1Change(Sender: TObject);
begin
edit3.text:='';
end;

function Xls_To_StringGrid1(AGrid: TStringGrid; AXLSFile: string): Boolean;
const
xlCellTypeLastCell = $0000000B;
var
XLApp, Sheet: OLEVariant;
RangeMatrix: Variant;
x, y, k, r: Integer;
begin
Result := False;
XLApp := CreateOleObject('Excel.Application');
try
XLApp.Visible := False;
XLApp.Workbooks.Open(AXLSFile);
Sheet := XLApp.Workbooks[ExtractFileName(AXLSFile)].WorkSheets[1];
Sheet.Cells.SpecialCells(xlCellTypeLastCell, EmptyParam).Activate;
x := XLApp.ActiveCell.Row;
y := XLApp.ActiveCell.Column;
AGrid.RowCount := x;
AGrid.ColCount := y;
RangeMatrix := XLApp.Range['A1', XLApp.Cells.Item[X, Y]].Value;
k := 1;
repeat
for r := 1 to y do
AGrid.Cells[(r-1 ), (k-1 )] := RangeMatrix[K, R];
Inc(k, 1);
AGrid.RowCount := k + 1;
until k > x;
RangeMatrix := Unassigned;
finally
if not VarIsEmpty(XLApp) then
begin
XLApp.Quit;
XLAPP := Unassigned;
Sheet := Unassigned;
Result := True;
end;
end;
end;
procedure TForm7.LMDShapeButton1Click(Sender: TObject);
begin
form8.Label2.Caption:='';
form8.show;
end;

procedure TForm7.LMDShapeButton3Click(Sender: TObject);
begin
form8.Label2.Caption:='a';
form8.show;
end;

procedure TForm7.LMDShapeButton4Click(Sender: TObject);
var
    i,p : integer;
begin
  repeat
 form1.eltreeStringGrid1.Cols[1]; // die 2. Spalte

     p := form1.eltreeStringGrid1.Cols[1].IndexOf('1'); // suche nach "rot"
     if p >= 0 then
     edit8.Text:=inttostr(p+1); // ersetzen
   until p < 0;
 end;



procedure TForm7.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if ModalResult <> mrOK then
    FreeAndNil(FIrgendwas);
    if ModalResult <> mrOK then
    FreeAndNil(FIrgendwas1);
end;

procedure TForm7.LMDShapeButton2Click(Sender: TObject);
var
i,k : integer;
begin
for i:=0 to form1.eltreestringgrid1.rowcount-1 do begin //reihenbis zur letzten durchsuchen
if form1.eltreeStringGrid1.Cells[1,i]=''//wenn spalte 2 leer ist dann
then edit4.text:='1'// edit4.text ist gleich die zahl 1
else //sonst
k:=strtoint(form1.eltreeStringGrid1.Cells[1,i]); // k ist die gefundene Zahl in der zelle
edit4.text:=inttostr(k+1); // edit4.text ist dann die gefundene Zahl + 1
end;
end;

procedure TForm7.FormShow(Sender: TObject);
begin
edit9.Text:=form1.ElTreeStringGrid1.Cells[4,form1.ElTreeStringGrid1.Row-1];
FIrgendwas := TIrgendwas.Create;
if label11.caption='then elpagecontrol1.ActivePageIndex:=0;
if elpagecontrol1.ActivePageIndex=1 then button2.Visible:=false;
if elpagecontrol1.ActivePageIndex=1 then button3.Visible:=true;
if elpagecontrol1.ActivePageIndex=0 then button3.Visible:=false;
if elpagecontrol1.ActivePageIndex=0 then button2.Visible:=true;

end;

procedure TForm7.ElPageControl1Change(Sender: TObject);
begin
if elpagecontrol1.ActivePageIndex=1 then button2.Visible:=false;
if elpagecontrol1.ActivePageIndex=1 then button3.Visible:=true;
if elpagecontrol1.ActivePageIndex=0 then button3.Visible:=false;
if elpagecontrol1.ActivePageIndex=0 then button2.Visible:=true;
end;

procedure TForm7.Button2Click(Sender: TObject);
begin

  form1.eltreestringgrid1.cells[0,form1.ElTreeStringGrid1.Row]:=edit1.text;
  try
    FIrgendwas.ErsteZahlAsString := edit3.Text;
      try
        FIrgendwas.ZweiteZahlAsString := edit9.text;
        ModalResult := mrOK;
    except
      on E: Exception do
        begin
          MessageBox(0, PChar(E.Message), nil, MB_OK or MB_ICONERROR);
          edit9.SetFocus;
          edit9.SelectAll;
        end;
    end;
  except
    on E: Exception do
      begin
        MessageBox(0, PChar(E.Message), nil, MB_OK or MB_ICONERROR);
        edit3.SetFocus;
        edit3.SelectAll;
      end;
  end;

  end;

procedure TForm7.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  if ModalResult <> mrOK then
    FreeAndNil(FIrgendwas);
end;

procedure TForm7.FormDestroy(Sender: TObject);
begin
  if ModalResult <> mrOK then
    FreeAndNil(FIrgendwas);
end;

procedure TForm7.Button3Click(Sender: TObject);
begin
  form1.eltreestringgrid1.cells[0,form1.ElTreeStringGrid1.Row]:=edit5.text;
  try
    FIrgendwas1.ErsteZahl1AsString := edit7.Text;
      try
        FIrgendwas1.ZweiteZahl1AsString := edit9.text;
        ModalResult := mrOK;
    except
      on E: Exception do
        begin
          MessageBox(0, PChar(E.Message), nil, MB_OK or MB_ICONERROR);
          edit9.SetFocus;
          edit9.SelectAll;
        end;
    end;
  except
    on E: Exception do
      begin
        MessageBox(0, PChar(E.Message), nil, MB_OK or MB_ICONERROR);
        edit7.SetFocus;
        edit7.SelectAll;
      end;
  end;

  end;

end.
  Mit Zitat antworten Zitat