stepmain.~pas

Delphi图像盖章程序源码,供大家参考。

unit StepMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls, Buttons,mainwork_II, ShellCtrls,
  ExtDlgs, CheckLst,JPeg, ColorGrd, ToolWin;



type
  TmainF = class(TForm)
    GroupBox1: TGroupBox;
    Panel1: TPanel;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Panel2: TPanel;
    Label10: TLabel;
    Label11: TLabel;
    Image100: TImage;
    Panel3: TPanel;
    ShellTreeView1: TShellTreeView;
    ListBox1: TListBox;
    Splitter1: TSplitter;
    Panel3_1: TPanel;
    OpenDialog1: TOpenDialog;
    OpenPictureDialog1: TOpenPictureDialog;
    SaveDialog1: TSaveDialog;
    LabelTop: TPanel;
    RadioGroup1: TRadioGroup;
    Panel4: TPanel;
    CheckListBox1: TCheckListBox;
    Button5: TButton;
    Image2: TImage;
    Panel5: TPanel;
    RadioGroup2: TRadioGroup;
    Panel5_1: TPanel;
    Panel5_2: TPanel;
    Edit1: TEdit;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    SpeedButton4: TSpeedButton;
    SpeedButton5: TSpeedButton;
    SpeedButton6: TSpeedButton;
    SpeedButton7: TSpeedButton;
    Panel6: TPanel;
    RadioGroup3: TRadioGroup;
    Panel6_1: TPanel;
    ScrollBox1: TScrollBox;
    Image1: TImage;
    SpeedButton8: TSpeedButton;
    edit2: TEdit;
    Panel6_2: TPanel;
    Edit3: TEdit;
    SpeedButton9: TSpeedButton;
    Image3: TImage;
    ComboBox1: TComboBox;
    Label1: TLabel;
    Panel6_3: TPanel;
    Edit4: TEdit;
    Label2: TLabel;
    ComboBox2: TComboBox;
    Label3: TLabel;
    Label4: TLabel;
    ComboBox3: TComboBox;
    Label5: TLabel;
    Edit5: TEdit;
    UpDown1: TUpDown;
    ColorGrid1: TColorGrid;
    ColorDialog1: TColorDialog;
    Image4: TImage;
    Panel6_4: TPanel;
    ComboBox4: TComboBox;
    Edit6: TEdit;
    UpDown2: TUpDown;
    ComboBox5: TComboBox;
    ColorGrid2: TColorGrid;
    Image5: TImage;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Edit7: TEdit;
    CheckBox1: TCheckBox;
    CheckBox2: TCheckBox;
    ComboBox6: TComboBox;
    CheckBox3: TCheckBox;
    CheckBox4: TCheckBox;
    Panel7: TPanel;
    ScrollBox2: TScrollBox;
    Image6: TImage;
    ListBox2: TListBox;
    Splitter2: TSplitter;
    Panel7_1: TPanel;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    SpeedButton10: TSpeedButton;
    SpeedButton11: TSpeedButton;
    Panel8: TPanel;
    ScrollBox3: TScrollBox;
    ListBox3: TListBox;
    Splitter3: TSplitter;
    Image7: TImage;
    Panel6_Top: TPanel;
    ListBox4: TListBox;
    Splitter4: TSplitter;
    DateTimePicker1: TDateTimePicker;
    Image8: TImage;
    Panel9: TPanel;
    RadioGroup4: TRadioGroup;
    Image9: TImage;
    TrackBar1: TTrackBar;
    Panel9_1: TPanel;
    Label12: TLabel;
    SpeedButton12: TSpeedButton;
    CheckBox5: TCheckBox;
    Edit8: TEdit;
    labelend: TPanel;
    ProgressBar1: TProgressBar;
    Label13: TLabel;
    Button4: TButton;
    ComboBox7: TComboBox;
    Bevel1: TBevel;
    Label14: TLabel;
    Button6: TButton;
    CheckBox6: TCheckBox;
    CheckBox7: TCheckBox;
    procedure FormShow(Sender: TObject);
    procedure Button1Click(Sender: TObject);

    procedure Button3Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure ShellTreeView1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ListBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure ListBox1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ShellTreeView1MouseMove(Sender: TObject; Shift: TShiftState;
      X, Y: Integer);
    procedure CheckListBox1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button5Click(Sender: TObject);
    procedure RadioGroup2Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure RadioGroup3Click(Sender: TObject);
    procedure SpeedButton8Click(Sender: TObject);
    procedure SpeedButton9Click(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    procedure ComboBox2Change(Sender: TObject);
    procedure Edit5Change(Sender: TObject);
    procedure ComboBox3Change(Sender: TObject);
    procedure Image4MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ColorGrid1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image4MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure CheckBox2Click(Sender: TObject);
    procedure Edit4Change(Sender: TObject);
    procedure CheckBox3Click(Sender: TObject);
    procedure CheckBox4Click(Sender: TObject);
    procedure Edit7Change(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure ListBox2MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image6MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image6MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Image6MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure SpeedButton10Click(Sender: TObject);
    procedure ListBox3MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ComboBox4Change(Sender: TObject);
    procedure Edit6Change(Sender: TObject);
    procedure ComboBox5Change(Sender: TObject);
    procedure Image5MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ColorGrid2MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ListBox4MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image7MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image7MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure SpeedButton10MouseMove(Sender: TObject; Shift: TShiftState;
      X, Y: Integer);
    procedure SpeedButton9MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Image9MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image100MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure TrackBar1Change(Sender: TObject);
    procedure RadioGroup4Click(Sender: TObject);
    procedure CheckBox5Click(Sender: TObject);
    procedure Edit8KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Edit8MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure DateTimePicker1Change(Sender: TObject);
    procedure ComboBox6Change(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure CheckBox7Click(Sender: TObject);
  private
//文件列，查找目录，显示文件类型列，fintli:0本目录查找1包括本目录一下全部目录，li:0清空listbox
Function MCreateListfile(listbox:Tlistbox;path,filetype:string;fintli,li:integer):boolean;
  public
      Procedure StepProcedure;
      Procedure ClearAllObject;
      Procedure MReadPoint(Num:string);
  end;

var
  mainF: TmainF;
  MStep:integer;
  Gindex_filename:string;
  GProOption:TM_type;
  M_address:array of TM_InsterAdd;

  G_draw,rightup,leftup:boolean;
  G_BeginPoint,G_EndPoint:Tpoint;
implementation
USES T_Course,T_File, aboutF, ProOption,DateCn_;
{$R *.dfm}


Procedure TmainF.MReadPoint(Num:string);
var tmp:string;
begin
GProOption.Point_top:=point(0,0);
GProOption.Point_bott:=Point(80,80);
{***************************************************}
tmp:=trim(G_Read_IndexINI(Gindex_filename,Num,'top',0));
if tmp <> ''
   then begin
         GProOption.Point_top.x:=strtoint(GShow_title(tmp,',',3));
         GProOption.Point_top.y:=strtoint(GShow_title(tmp,',',4));
        end;
tmp:=trim(G_Read_IndexINI(Gindex_filename,Num,'bott',0));
if tmp <> ''
   then begin
         GProOption.Point_bott.x:=strtoint(GShow_title(tmp,',',3));
         GProOption.Point_bott.y:=strtoint(GShow_title(tmp,',',4));
        end;
{***************************************************}
end;

function MDraw_(im:Timage;li:integer;PhoType:TM_InsterAdd):boolean;
var tmp:string;
    TxtRect: TRect;
begin
//根据类型(0,1,2,3)绘制
case li of
0:;
1:if PhoType.Ifilename<>''
      then GDraw_spis_(im,PhoType.Ifilename,PhoType.IvfdID,GFileClass(PhoType.Ifilename),nil,nil,3,PhoType.IAddpoint_top,PhoType.IAddpoint_bott);
2:begin
  im.Canvas.Brush.Color:=PhoType.mIstrBrushColor;
  im.Canvas.Brush.Style:=PhoType.mIstrBrushStyle;
  im.Canvas.Font.Name:=PhoType.mIstrFontName;
  im.Canvas.Font.Size:=PhoType.mIstrFontSize;
  im.Canvas.Font.Color:=PhoType.mIstrFontColor;
//  im.Canvas.Font.Style[PhoType.mIstrFontStyle];
//  im.Canvas.TextOut(PhoType.IAddpoint_top.x,PhoType.IAddpoint_top.Y,PhoType.Istr);
 TxtRect := Rect(PhoType.IAddpoint_top.x,
                 PhoType.IAddpoint_top.y,
                 PhoType.IAddpoint_bott.x,
                 PhoType.IAddpoint_bott.y
                );

  im.Canvas.TextRect(TxtRect,PhoType.IAddpoint_top.x,PhoType.IAddpoint_top.y,PhoType.Istr);
  end;
3:begin
//CnDateOfDateStr(now)
//strtoDate(datestr)
tmp:=DateformatToStr(PhoType.mIdateformat+'\'+inttostr(PhoType.mIdateType),datetostr(PhoType.mIdatestr));
  im.Canvas.Brush.Color:=PhoType.mIstrBrushColor;
  im.Canvas.Brush.Style:=PhoType.mIstrBrushStyle;
  im.Canvas.Font.Name:=PhoType.mIstrFontName;
  im.Canvas.Font.Size:=PhoType.mIstrFontSize;
  im.Canvas.Font.Color:=PhoType.mIstrFontColor;
//  im.Canvas.Font.Style[PhoType.mIstrFontStyle];
//  im.Canvas.TextOut(PhoType.IAddpoint_top.x,PhoType.IAddpoint_top.Y,PhoType.Istr);
 TxtRect := Rect(PhoType.IAddpoint_top.x,
                 PhoType.IAddpoint_top.y,
//                 PhoType.IAddpoint_bott.x*PhoType.mIstrFontSize,
//                 PhoType.IAddpoint_bott.y*PhoType.mIstrFontSize
                 PhoType.IAddpoint_bott.x,
                 PhoType.IAddpoint_bott.y
                );
  im.Canvas.TextRect(TxtRect,PhoType.IAddpoint_top.x,PhoType.IAddpoint_top.y,tmp);


//       mIdateformat:string;//日期格式
  end;
end;//case
end;

procedure GPoint_show(ScrollBox:TScrollBox;bx,by,li:integer);
begin
with ScrollBox do begin
case li of
1:begin
    HorzScrollBar.Position:=bx-ScrollBox.width div 2;
    VertScrollBar.Position:=by-ScrollBox.height div 2;
  end;
end;//case
                  end;
end;


Function MListfilename(listbox:Tlistbox;path,filetype:string;fintli:integer):boolean;
var GBeginDir,FPath,FFileName:string;
    i:integer;
//*************************************************//
        procedure FindFiles(APath,FFiletype:String;li:integer);
        var
          FSearchRec,
          DSearchRec: TSearchRec;
          FindResult: integer;
                function IsDirNotation(ADirName: String): Boolean;
                begin
                  Result := (ADirName = '.') or (ADirName = '..');
                end;

                function GetDirectoryName(Dir: String): String;
                begin
                  if Dir[Length(Dir)]<> '\'
                     then Result := Dir+'\'
                     else Result := Dir;
                end;
        begin
          APath := GetDirectoryName(APath);
          FindResult := FindFirst(APath+FFiletype,faAnyFile+faHidden+faSysFile+faReadOnly,FSearchRec);
          try
          while FindResult = 0 do begin
              listbox.Items.Add(LowerCase(APath+FSearchRec.Name));
              FindResult := FindNext(FSearchRec);
                                  end;

            FindResult := FindFirst(APath+'*.*', faDirectory, DSearchRec);
        case li of
        1:while FindResult = 0 do begin
              if ((DSearchRec.Attr and faDirectory) = faDirectory) and not IsDirNotation(DSearchRec.Name)
                then FindFiles(APath+DSearchRec.Name,FFiletype,li);
              FindResult := FindNext(DSearchRec);
                                  end;
        end;//case
          finally
            FindClose(FSearchRec);
          end;
        end;
//*************************************************//
begin
    result:=true;
  Screen.Cursor := crHourGlass;
  try
    FFileName := '*.'+filetype;
GBeginDir:=path;
//    FindFiles(ShellTreeView1.Path,FFileName,fintli);
    FindFiles(Path,FFileName,fintli);


  finally
    Screen.Cursor := crDefault;
    result:=false;
  end;

for i:=0 to listbox.Items.Count - 1 do
   listbox.Items[i]:=GShow_title(listbox.Items[i],'\',1);
end;

//文件列，查找目录，显示文件类型列，fintli:0本目录查找1包括本目录一下全部目录，li:0清空listbox
Function TmainF.MCreateListfile(listbox:Tlistbox;path,filetype:string;fintli,li:integer):boolean;
var tmp:string;
    i:integer;
begin
tmp:=filetype;
case li of
 0:listbox.Items.Clear;